こんにちは，五十嵐です．サービスを閉塞した後にデータベースのバックアップを行えるようにします．今のところ Linux/PostgreSQL のみ対応しています．
sub makebackup : Local {
my ( $self, $c ) = @_;
$_ = $c->config->{'Model::SecureSBMDB'}->{connect_info}[0];
my ( $dbi, $dbd, $dbparams ) = split( ':' );
my ( @dbparams ) = split( ';', $dbparams );
my %dbparams;
foreach my $d (@dbparams){
my ( $name, $data ) = split( '=', $d );
$dbparams{$name} = $data;
}
my $dbname = (defined $dbparams{dbname})?$dbparams{dbname}:'';
my $dbuser = $c->config->{'Model::SecureSBMDB'}->{connect_info}[1];
my $dbpwd = $c->config->{'Model::SecureSBMDB'}->{connect_info}[2];
初期設定の config から dbname などを切り出します．connect_info 配列の 0 番目は dbname など，1 番目はデータベースのユーザ名，2 番目はパスワードになります．
if( $dbd eq 'Pg' ){
my $dbhostopt = (defined $dbparams{host})?
"-h $dbparams{host}":'';
my $dbportopt = (defined $dbparams{port})?
"-p $dbparams{port}":'';
my $dbfileopt = "-f $backuppath";
system( "pg_dump -U $dbuser -F t $dbhostopt $dbportopt
$dbfileopt $dbname" );
my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks )
= stat($backuppath);
my ( $sec, $min, $hour, $mday, $mon,
$year, $wday, $yday, $isdst )
= localtime($mtime);
my $filestat
= sprintf( '%s <br />owner:%s group:%s size:%s
<br />mtime: %4d/%02d/%02d %02d:%02d:%02d',
$backupfilename, $uid, $gid, $size,
$year + 1900, $mon + 1, $mday, $hour, $min, $sec
);
$c->stash->{backupfileinfo} = $filestat;
$c->stash->{backupfilename} = $backupfilename;
}else{
# Not implimented
$c->stash->{resultmessage} = 'Not implimented yet';
}
$c->forward('index');
} # end of makebackup()
dbname が "Pg" かどうかを判断していますが，PostgreSQL の場合に "Pg" を設定していますので，この場合にのみ "pg_dump" を利用してバックアップファイルを作成します．他のデータベースの場合には対応していません．それから，このままだと Windows でも動きません．これは今後の課題．
ファイルを作成したら，ダウンロードできるようにします．
sub getbackup : Local {
my ( $self, $c, $bfname ) = @_;
if( $bfname ne $backupfilename ){
$c->forward('index');
return 0;
}
my $backupfilepath = $backupdir . '/' . $bfname;
my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks ) = stat($backupfilepath);
my $bfcontents = '';
if( open( BFH, $backupfilepath ) ){
my $rsize = 1;
while( $rsize && $size > 0){
my $tmp;
$rsize = read( BFH, $tmp, $size );
$bfcontents .= $tmp;
$size -= $rsize;
}
close( BFH );
}
$c->res->headers->header(
'Content-Type' => 'application/x-tar;'
. 'name="' . $bfname . '";' );
$c->res->body( $bfcontents );
$c->forward('index');
} # end of getbackup()
ファイルを読み込んで， body に格納するだけです．ポイントは HTML ヘッダで "Content-Type" を設定することです．
2007/07/14 記
参考：
Keyword: Perl Catalyst Secure-SBM SSBM セキュア・ソーシャル・ブックマーク オープンソース
ikarashiさんのエントリ配信
Re: [Secure-SBM:027] データベースのバックアップ
Rinza
開発日記