バイナリーデータをMySQLから出す

newmime64db.cgi

#!D:/xampp/perl/bin/perl
use CGI;
use MIME::Base64;
use DBI;
use utf8;
$q = new CGI;
$dbname = "trinity777";
$user = "root";
$passwd = "あなたのパスワードにしてね";
$tbname = "trinity999";
$host = "localhost";
$myname=$q ->param('name');
$mode = $q->param( 'mode' );
# リンクURLからidのパラメーターが作られました(フォームからのではありません)
$id = $q->param( 'id' );
# ファイルネームにファイルのポップアップのリンクが貼られたら起動
if($mode eq 'view' && $id){
# DBに接続
$dbh=DBI->connect("DBI:mysql:$dbname; host=$host", $user, $passwd) 
or die $DBI::errstr;
$dbh->do("SET NAMES utf8");
# ファイルタイプとファイルの中味を呼び出すSQL実行
$sth = $dbh->prepare(" SELECT type, uploaded_file  FROM  $tbname WHERE id =$id ");
if(!$sth->execute){print "SQL失敗\n";exit;}
@rec = $sth->fetchrow_array();
# ファイルの内容をポップアップで'utf-8'で呼び出します
# Shft-JISで作られたtxtファイルは文字化けするけど
# ブラウザの文字コードをShft-JISにすればきれいに表示されます
print $q->header(-type =>$rec[0],-charset => 'utf-8'),
$decode=decode_base64($rec[1]);
binmode($decode);
print $decode;
$sth->finish;
$dbh->disconnect;
exit;
}
# 名前で検索をするフォームの提示
print $q->header(-type =>'text/html',-charset => 'utf-8'),
$q->start_html(-title=>"Database Form"),
$q->h1(' 名前で検索してみましょう'),
$q->start_form,
$q->textfield(-name=>'name'),
$q->reset,
# mode　と　viewがあれば　リンクを作るのが楽チンになります
$q->hidden(-name =>'mode', -value =>'view'),
$q->submit(-name =>'Action', -value =>'送信'),
$q->end_form;
if($q ->param('name')){searchform();}
# 名前があればDBに接続
sub searchform{
$dbh=DBI->connect("DBI:mysql:$dbname; host=$host", $user, $passwd) 
or die $DBI::errstr;
$dbh->do("SET NAMES utf8");
# データを検索して提示するSQL実行
$sth = $dbh->prepare(" SELECT * FROM  $tbname WHERE name = '$myname' ");
if(!$sth->execute){print "SQL失敗\n";exit;}
print $q->start_table({-border=>1}),
$q->start_Tr,
$q->th(['id', 'mtime','name','email','subject', 'comments','filename','type']);
while (@rec = $sth->fetchrow_array())
{
print $q->start_Tr,
$q->td([$rec[0],$rec[1],$rec[2],$rec[3],$rec[4],$rec[5],$rec[7]]),
$q->td,
# ファイルネームにファイルのポップアップのリンクを貼ります
$q->a({href=>$q->url()."?mode"."="."view&id"."="."$rec[0]",target=>"_blank"}, "$rec[6]"),
$q->end_td;}
# ステートメントハンドルクリア
$sth->finish;
# DB切断
$dbh->disconnect;}
print $q->end_html;