バイナリーデータを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;

バイナリーデータをMySQLに入れる

さて。ヘビメタ普及委員会のコミュをMixiで始めまして遊びすぎました
Mixiって　Perl　と MySQL　で動いているんですよ。ご存知でしたか?

久し振りのブログの更新になってしまいました。

フォームは　いつものです　マルチパートですから添付ファイル対応です
'form.css'も　いつも　使いまわしているヤツです

newmime64tomakedb.cgi

#!D:/xampp/perl/bin/perl
use utf8;
use CGI;
$q = new CGI;
print $q->header(-charset => 'utf-8'),
$q->start_html(-title=>"Example CGI.pm Form", -style=>{'src'=>'form.css'}),
$q->h1(' Example CGI.pm Form'),
$q->start_div({-class=>"aaa"}),
$q->p('これは class="aaa" の部分です'),
$q->start_multipart_form(-action=>"newmime64makedb.cgi"),
$q->em("What's your name?"),
$q->br,
$q->br,
$q->textfield(-name=>'name'),
$q->checkbox('Not my real name'),
$q->br,
$q->em("What's your e-mail?"),
$q->br,
$q->br,
$q->textfield(-name=>'email'),
$q->br,
$q->em("What's your subject?"),
$q->br,
$q->br,
$q->textfield(-name=>'subject'),
$q->br,
$q->em('Any parting comments?'),
$q->br,
$q->br,
$q->textarea(-name=>'comments',-rows=>3,-columns=>50),
$q->br,
$q->br,
$q->filefield(-name=>'uploaded_file',
                -default=>'starting value',
                -size=>50,
                -maxlength=>80),
$q->reset,
$q->submit(-name =>'Action', -value =>'送信'),
$q->submit(-name =>'Action', -value =>'Scream'),
$q->end_multipart_form,
$q->end_div,
$q->start_div({-id=>"bbb"}), 
$q->h3('これは id="bbb" の部分です'),
$q->end_div,
$q->start_div({-class=>"ccc"}),
$q->h3('これは class="ccc" の部分です'),
$q->end_div,
$q->end_html;

form.css
/* --基本部分の設定-- */ 
body{background-color:#66ffcc;font-size:20px;line-height:20px}
h1{text-align:center;margin:0 15%;
background-color:#eea8aa;
font-size:20px;
color:#ffffff;
font-style:italic;}
em{font-size:20px;
border-bottom:dashed;
color:#808000;}
#bbb {color:#ff1493;margin:0 15%;line-height:12px;}
.ccc {color:#008000;margin:0 15%;line-height:15px;}
.aaa{border:solid 20px red;margin:2px 15%;padding:0px;line-height:20px;}

それで　重要なのは

$tbname = "trinity999";　となっている部分です
以前作成した　trinity888というテーブルを複製して
trinity999　を作成し　id 主キーに設定　AI にチェックして　オートインクリメント
Field typeのfilename　の次に　挿入で　
Field　に　type　を追加　varchar　20　とします
Field　uploaded_file　は　Type に　mediumblob としてください
そうしないと　バイナリーデータを入れることができません

newmime64makedb.cgi

#!D:/xampp/perl/bin/perl -w
use CGI;
use Jcode;
use MIME::Base64;
use File::Basename;
use DBI;
use utf8;
$dbname = "trinity777";
$user = "root";
$passwd = "あなたのパスワードにしてね";
$tbname = "trinity999";
$host = "localhost";
$q = new CGI;
my $localtime = localtime();
$myname=$q->param('name');
$myemail=$q->param('email');
$mysubject=$q->param('subject');
$mycomments=$q->param('comments');
$myuploaded_file=$q->param('uploaded_file');
$type = $q->uploadInfo($myuploaded_file)->{'Content-Type'}; 
# ファイルシステムの設定（デフォルト:Unix）
fileparse_set_fstype('MSWin32');
my $basename= basename($myuploaded_file,"");
# ファイルハンドル取得
my $fh = $q->upload('uploaded_file');
# バイナリデータとして読み込む
binmode $fh;
my $data ='';
while (read $fh,$buf,60*57){$data.=$buf;}
close $fh;
#バイナリデータをBASE64することでASCIIテキストにする
$base64filebody= encode_base64($data,'');
print $q->header(-type =>'text/html', -charset =>'utf-8');
print $q->start_html;
# DBに接続
$dbh=DBI->connect("DBI:mysql:$dbname;host=$host", $user, $passwd,
                 {RaiseError => 0, PrintError => 1});
if(!$dbh){print "接続失敗\n";  exit;}
$dbh->do("SET NAMES utf8"); 
# INSERT文作成
$sql="insert into $tbname(mtime,name,email,subject,comments,filename,type,uploaded_file)
values('$localtime','$myname','$myemail','$mysubject','$mycomments','$basename',
'$type','$base64filebody')";
# SQL実行
$sth = $dbh->prepare($sql);
if(!$sth->execute){
    print "SQL失敗\n";
    exit;
}
# ステートメントハンドルクリア
$sth->finish;
# DB切断
$dbh->disconnect;
print "登録完了\n";
print $q->end_html;