Perl DBIでバイナリデータ

（2006/04/04 mixiの日記より転載）
Windows上のCygwinにDBIとDBD::ODBCを使ってSQL Serverにローカルファイルを入れたり、ファイルデータを取り出したりするサンプル。
DBIとDBD::ODBCは、CPANからソースを持ってきてインストール。
入れるときは

$sth->bind_param(4,$buff,DBI::SQL_LONGVARBINARY);

取り出すときは

$dbh->{LongReadLen} = 10 * 1024 * 1024;
$dbh->{LongTruncOk} = 1;

あたりがミソかも。

---（ここから）---

#!/usr/bin/perl -w

use strict;
use DBI;

my $site_id = $ARGV[0]; # サイトID
my $item_id = $ARGV[1]; # 項目ID
my $extension = $ARGV[2]; # ファイル拡張子
my $dir_path = $ARGV[3]; # ディレクトリパス
my %CONTENT_TYPE = (
"jpg" => "image/jpeg",
"jpeg" => "image/jpeg",
"gif" => "image/gif",
"bmp" => "image/bmp",
"png" => "image/png",
"js" => "text/plain",
"css" => "text/css",
"pdf" => "application/pdf",
"rdf" => "application/rtf",
"doc" => "application/msword",
"xls" => "application/vnd.ms-excel",
"swf" => "application/x-shockwave-flash",
"xml" => "text/xml",
"txt" => "text/plain",
"ico" => "image/x-icon",
"flv" => "application/octet-stream",
"php" => "text/plain",
"htm" => "text/html",
"html" => "text/html",
"csv" => "application/octet-stream"
); # ファイル拡張子とコンテンツタイプ
my %CONTENT_TYPE_2 = (
"image/jpeg" => "jpg",
"image/pjpeg" => "jpg",
"image/gif" => "gif",
"image/bmp" => "bmp",
"image/x-bmp" => "bmp",
"image/png" => "png",
"text/css" => "css",
"application/pdf" => "pdf",
"application/x-pdf" => "pdf",
"application/rtf" => "rtf",
"text/richtext" => "rtf",
"application/msword" => "doc",
"application/vnd.ms-excel" => "xls",
"application/x-shockwave-flash" => "swf",
"text/xml" => "xml",
"text/plain" => "txt",
"image/x-icon" => "ico",
"text/html" => "html"
); # ファイル拡張子とコンテンツタイプ2
my $dataSource = "dbi:ODBC:" .
"driver={SQL Server};" .
"Server=(local);database=db;" .
"Trusted_Connection=no;" .
"AutoTranslate=no;";
my $user = "user";
my $passwd = passwd"";

# DB接続
my $dbh = DBI->connect($dataSource,$user,$passwd) or die $DBI::errstr;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
$dbh->{LongReadLen} = 10 * 1024 * 1024; # 10MB
$dbh->{LongTruncOk} = 1;

# テーブルにデータを入れる
my $sth = $dbh->prepare("INSERT INTO personal_file (user_id,item_id,content_type,content) VALUES (?,?,?,?)") or die $dbh->errstr;

foreach my $file (@files) {

my $buff = "";
my $file_path = $dir_path . '/' . $file;
my $user_id = (split(/\./, $file))[0];

eval {

# ファイルデータを取得
open IN, "< $file_path"; binmode IN; $buff = do { local $/; }; close IN;

};

if ($@) {

print "$@" . "($user_id)" . "\n";
next;

}

eval {

# データ格納
$sth->bind_param(1,$user_id);
$sth->bind_param(2,$item_id);
$sth->bind_param(3,$CONTENT_TYPE{$extension});
$sth->bind_param(4,$buff,DBI::SQL_LONGVARBINARY);
$sth->execute or die $dbh->errstr;
$dbh->commit or die $dbh->errstr;

};

if ($@) {

print "$@" . "($user_id)" . "\n";
$dbh->rollback or die $dbh->errstr;

}

}

# データの取り出し
$sth = $dbh->prepare("SELECT user_id,content_type,content FROM personal_file WHERE item_id=$item_id") or die $dbh->errstr;
$sth->execute or die $dbh->errstr;

while (my $row = $sth->fetchrow_arrayref) {

my($user_id,$content_type,$content) = @$row;

# 拡張子
my $ext = "";
foreach my $type (keys %CONTENT_TYPE_2) {

if ($content_type eq $type) {

$ext = '.' . $CONTENT_TYPE_2{$type};

}

}

# ファイル出力
my $file_path = $dir_path . '/' . $user_id . $ext;
open OUT, ">> $file_path";
binmode OUT;
print OUT $content;
close OUT;
print $file_path . "\n";

}

# DB切断
$sth->finish;
$dbh->disconnect;

exit;

__END__

---（ここまで）---