2009年10月アーカイブ

とあるplファイルの一部で、

-------------------------------------------------------------------------
$mod->VERSION;　###　$modにはモジュール名が入る
-------------------------------------------------------------------------

としたときに、$modが「CGI」のときだけ以下のエラーが発生する。

------------------------------------------------------------------------
Software Error

Cannot find version of an unblessed reference....
------------------------------------------------------------------------

確かにCGI.pmをuseしただけでオブジェクトは作って無いけど、VERSIONメソッドはオブジェクト要らねーだろぉ？？？


さっぱりわけがわからなかったので、その部分のサブルーチンだけ抜き出して別ファイルを作って実行してみたらなぜか問題無し。

どうやらサブルーチンの外に問題があるらしい・・・


消去法でたどり着いたのが以下の部分。

---------------------------------------------------------
（中略）

open(CGI,$scgi) || &ends("※$scgiがオープンできません。");

my $sheb = <CGI>;
close(CGI);
　　・
　　・
　　・
（中略）
-----------------------------------------------------------


ここら辺のファイルハンドルを「CGI」にしてる部分だけコメントアウトしたらエラーが出なくなった・・・

おいおい、ファイルハンドルに「CGI」を使っちゃいけないなんて聞いたこと無いぞ的な・・・
（もちろん「CGI」を「THIS_CGI」とかにしたらOK）


もしかして、useしてるモジュール名をファイルハンドルに指定するとダメなの？？？
とか思って、上記の「CGI」を「DBI」とかにしてみた。

しかし、$mod->VERSION（DBI->VERSION）は正常に表示される・・・
意味不明。


ちなみに$modは、たくさんのモジュール名やそのヴァージョンが入ったリファレンスの配列（＠REQ）をループさせてるうちのモジュール名がセットされる変数なのだが、
------------------------------------------------------------------------------------------------
my @REQ = (
　['CGI', 0, 1, 'パラメータの受け渡し等に必須です。' ],
　['CGI::Cookie', 0, 1, 'セッション管理等に必須です。' ],
　　　　・
　　　　・
　　　　・
)

for(@REQ){
　my $mod = $$_[0];
　　　　・
　　　　・
　　　　・
　eval("use $mod;");
　if(!$@){
　　my $m_ver = $mod->VERSION;
　　　　　　・
　　　　　　・
　}
　　　・
　　　・
　　　・
}
------------------------------------------------------------------------------------------------
↑の場合は「my $m_ver = $mod->VERSION;」の部分でエラーで、

------------------------------------------------------------------------------------------------
my @REQ = (
　['CGI::Cookie', 0, 1, 'セッション管理等に必須です。' ],
　['CGI', 0, 1, 'パラメータの受け渡し等に必須です。' ],
　　　　・
　　　　・
　　　　・
)
------------------------------------------------------------------------------------------------
↑の場合（CGIの直前にCGI::Cookie）の順番だとなぜかエラーが出ない・・・


まあ、結果的に「CGI」というファイルハンドルをやめたら解決したわけだが、これ以上モジュールの中身まで詮索すると確実にハマるのでやめておく。

crypt関数を使ってランダム文字列をつくるモジュールなどもあるが、なにもそこまで・・・と思ったので、どこぞのサイトにあったものをほぼ転用。


--------------------------------------------------------------------------------------------------
（中略）

######　第一引数に文字数、第二引数に文字種を指定
my $rand_str = &rand_str(8,"a-zA-Z0-9");

######　サブルーチン
sub rand_str{
　my ($str_len,$char_type) = @_;
　my @chars;

　#####　各文字種の指定あれば配列に追加
　push @chars, ('a'..'z') if $char_type =~ /a-z/;
　push @chars, ('A'..'Z') if $char_type =~ /A-Z/;
　push @chars, (0..9) if $char_type =~ /0-9/;
　my $total = @chars;

　my $rand_str = "";
　#####　randとintを用いて生成
　$rand_str .= $chars[int(rand($total))] for (1..$str_len);

　return $rand_str;
}
--------------------------------------------------------------------------------------------------


こんなんで十分実用に耐えうると思う。

前回（http://www.igreks.jp/dev/2009/10/perlmysql2.html）の続きで今度はバックアップファイルのリストア。

MilkyStepでは、サーバにファイルを残さずにローカルからアップロードしてリストアさせるので、今回はその流れで。

まず事前に・・・
use CGI;
my $F = CGI->new();


------アップロード処理用ルーチン---------------------------------------------------------------------

sub upload{
　my $fH = $F->upload('filename');　### この辺でファイルチェック処理など適宜行う
　### アップロードされたファイルを書き込み
　my ($buffer);
　open (OUT, ">./backup/$fH") || &show::error("ファイル（$fH）が書き込みできません。");
　binmode (OUT);
　while(read($fH, $buffer, 1024)){
　　print OUT $buffer;
　}
　close (OUT);
　close ($fH) if ($CGI::OS ne 'UNIX'); # for Windows
　chmod (0644, "./backup/$fH");
}


----リストア用ルーチン---------------------------------------------------------------------------------

sub restore{
　my $filename = $F->upload('filename');
　### 圧縮ファイルを展開（今回の場合はgzip）tarだったら"tar -zxvf ファイル名"とか・・
　my $rec1 = system "gzip -d ./backup/$filename";

　##### DBのテーブルをすべて消去しておく
　my @e_tables = $dbh->tables();　### $dbhはデータベースハンドル（詳細割愛）
　foreach(@e_tables){
　　&query("DROP TABLE IF EXISTS $_");　### SQL発行＆処理実行（詳細割愛）
　}

　#### リストア実行
　my $rec2 = system "mysql --user=$dbuser --password=$dbpass dbname < ./backup/展開されたファイル名";

　#### バックアップファイルは削除
　my $rec3 = system "rm ./backup/展開されたファイル名";

　#### エラー出力
　&show::error("圧縮ファイルの展開に失敗しました。") if $rec1 != 0;
　&show::error("DBの復元に失敗しました（mysql失敗）") if $rec2 != 0;
　&show::error("バックアップファイルの削除に失敗しました") if $rec3 != 0;
}


もちろんこれも前回同様Webサーバからmysqlコマンドが発行できなきゃダメなんだけど、レンタルサーバの場合どうなんだろ？
まあ、多分大丈夫だべ！


私の場合は、
"mysql --user=$dbuser --password=$dbpass dbname < ./backup/展開されたファイル名"
をしたときに、

unknown option '--skip-character-set-client-handshake'
（そんなオプションはねーよ！）

とエラーが出た。

何じゃこりゃと思ったら、以前（http://www.igreks.jp/dev/2008/11/movabletype422.html）に設定したmy.cnfの最後の一行だった。

この部分をコメントアウトしたら成功した。

前回の記事（http://www.igreks.jp/dev/2009/10/perlmysql.html）のちょい発展型

前回の場合だと、処理直後は圧縮したtar.gzファイルがサーバに残ってしまうので、標準出力後にファイルを削除するように改良。

サーバにバックアップファイルを残しておきたくない場合は便利かな？


sub backup{
　#### 念のためファイルが残ってたら削除
　system "rm ./backup/backup_*.tar.gz";
　#### 現在日時取得（詳細は割愛）
　my @cur = &get::current();　
　my $datetime = "$cur[5]$cur[4]$cur[3]-$cur[2]$cur[1]$cur[0]";

　#### ダンプと圧縮
　system "mysqldump -a --opt --user=dbuser --password=$dbpass --default-character-set=binary dbname > ./backup/backup.mysql";
　system "tar -czPf ./backup/backup_$datetime.tar.gz ./backup/backup.mysql";

　#### ここで、Locationで飛ばさずに標準出力
　print "Content-Type: application/octet-stream\n";
　print "Content-Type: application/download; name=backup_$datetime.tar.gz\n";
　print "Content-Disposition: attachment; filename=backup_$datetime.tar.gz\n";
　print "\n";
　#### 圧縮ファイルの中身書き出し
　system "cat ./backup/backup_$datetime.tar.gz";

　#### サーバに残らぬよう削除
　system "rm ./backup/backup.mysql";
　system "rm ./backup/backup_$datetime.tar.gz";
　exit;
}


※catコマンド使用後は、ブラウザに出力が完了してるので削除が可能
※ヘッダー出力を system "echo ...." でやったらなぜか失敗したので、ヘッダー出力だけ普通にprintしたら成功した。失敗した理由わかるひと教えてください。

リストア方法→http://www.igreks.jp/dev/2009/10/perlmysql-1.html

PerlでMySQLのバックアップを行うサブルーチン。
※mysqldump使用


sub backup{
　　#### 古いバックアップファイルを削除
　　system "rm ./backup/backup_*.tar.gz";

　　#### 現在日時取得
　　my @cur = &get::current();　#詳細は省略
　　my $datetime = "$cur[5]$cur[4]$cur[3]-$cur[2]$cur[1]$cur[0]";

　　#### MySQLデータの取得と圧縮
　　system "mysqldump -a --opt --user=$dbuser --password=$dbpass --default-character-set=binary $dbname > ./backup/backup.mysql";
　　system "tar -czPf ./backup/backup_$datetime.tar.gz ./backup/backup.mysql";
　　#### 一時ファイル消去
　　system "rm ./backup/backup.mysql";

　　#### ダウンロード実行
　　print "Location: ./backup/backup_$datetime.tar.gz\n\n";

　　exit;
}


※gzファイルが勝手に展開されてしまう場合はapacheの設定を変えてください。
※systemを使ってるので別にperlにこだわる必要なし。
※mysqldumpコマンドが使えなきゃ意味ない。

サーバにファイルを残したく無い場合→http://www.igreks.jp/dev/2009/10/perlmysql2.html