【しばらく編集不可モードで運営します】 編集(管理者用) | 差分 | 新規作成 | 一覧 | RSS | FrontPage | 検索 | 更新履歴

YukiWikiDB2 - *Yuki::YukiWikiDB2

目次

Yuki::YukiWikiDB2

YukiWikiDB2.pm です。YukiWikiLock という名前はヤメ。最新版は 下のページからダウンロードできます(今のところ、どちらも同じ内容): http://homepage1.nifty.com/dune/YukiWikiDB.html?


 ###
 ### $Id: YukiWikiDB2.pm,v 1.27 2002/11/17 21:41:04 dune Exp dune $
 ###
 require 5.004_71;
 package Yuki::YukiWikiDB2;
 ($VERSION) = q($Revision: 1.27 $) =~ m/\x20([\d.]+)\x20/;
 use strict;
 
 
 
 #
 # 致命的なエラー発生時に呼び出す関数。
 #
 sub _die{
     my $self    = shift             or die qq(_die : usage error.);
     my $file    = $self->{-logfile};
     my $msg     = qq/ERR (@{[scalar localtime]}) $self->{-dir} : @_/;
     push(@{$self->{-error}},$msg);
     if($file){
         # $file は壊れても気にしない
         # サイズが気になるときは >> を > に変える。
         open(FILE,">>$file")        or die qq($! "$file");
         print FILE $msg,"\n";
         close FILE;
     }
     die $msg;
 }
 
 
 
 #
 # 警告発生時に呼び出す関数。
 #
 sub _warn{
     my $self    = shift             or die qq(_warn : usage error.);
     my $file    = $self->{-logfile};
     my $msg     = qq/WRN (@{[scalar localtime]}) $self->{-dir} : @_/;
     push(@{$self->{-error}},$msg);
     if($file){
         # $file は壊れても気にしない
         # サイズが気になるときは >> を > に変える。
         open(FILE,">>$file")        or die qq($! "$file");
         print FILE $msg,"\n";
         close FILE;
     }
     return $msg;
 }
 
 
 
 #
 # エラーメッセージの処理
 # 発生したエラーメッセージは全て保持されています。
 #
 # get_errmsg => エラーメッセージ(文字列)を取得します。
 # clr_errmsg => エラーメッセージを消去します。
 # errlog => エラーログ(<font style="color:black;background-color:A0ffff">ファイル</font>)を読み出します。
 #
 sub get_errmsg{ join("\n",@{$_[0]->{-error}})   }
 sub clr_errmsg{     $_[0]->{-error} = []            }
 sub errlog{
     my $self    = shift             or die qq(_warn : usage error.);
     my $file    = $self->{-logfile} or return;
     open(FILE,$file)                or return;
     local $/    = undef;
     my @log = <FILE>;
     close FILE;
     return wantarray ? @log : join("\n",@log);
 }
 
 
 
 #
 # 生の<font style="color:black;background-color:A0ffff">ファイル</font>名を得る
 # ハッシュの内容は、例えば $hash{foo} = 'bar' を実行すると  
 # foo.txt という<font style="color:black;background-color:A0ffff">ファイル</font>に bar と書き込まれます(1件につき
 # 1<font style="color:black;background-color:A0ffff">ファイル</font>が作成される)。
 # filename で、その<font style="color:black;background-color:A0ffff">ファイル</font>名(foo)を得ることができます。
 # bkupname はバックアップ<font style="color:black;background-color:A0ffff">ファイル</font>名を得ます。
 #
 # ex. $filename = $DB->filename('foo');
 # ex. $filename = $DB->bkupname('foo');
 #
 sub filename{
     my($self,$key) = @_;
     &{$self->{-encode}}($key);
     return $self->{-dir}.$key.$self->{-extension};
 }
 sub bkupname{
     my($self,$key) = @_;
     &{$self->{-encode}}($key);
     return $self->{-dir}.$key.'.bak';
 }
 
 
 
 #
 # ロック
 # ロックしたいモード(0:ロックしない 1:共有 2:排他)と、
 # ロック<font style="color:black;background-color:A0ffff">ファイル</font>名(ロックされる前のもの)を渡します。
 # ロックに成功すると、新しいロック<font style="color:black;background-color:A0ffff">ファイル</font>名を返します。
 # 失敗すると undef を返します。
 # 通常、この関数をユーザが呼び出すことはありません。
 #
 sub _lock{
     my $self    = shift             or die qq(_lock usage error.);
     my($mode,$from) = @_;
     my $to      = $from;
     if($mode == 0){
         # 何もせずに戻る
         return($self->{-lock} = $to);
     }elsif($mode == 1){
         # 共有ロック
         $to =~ s/\.\.\.lock$/.1.@{[time]}.lock/x
                 or
         $to =~ s/\.(\d+)\.(\d+)\.lock$/.@{[$1+1]}.@{[time]}.lock/x
                 or
         return; # たぶん、排他ロックされている。
     }else{
         # 排他ロック
         $to =~ s/\.\.\.lock$/..@{[time]}.lock/x
                 or
         return; # たぶん、共有ロックされている。
     }
     if(rename($from => $to)){
         # ロック成功
         $self->{-mode}  = $mode;
         return($self->{-lock} = $to);
     }else{
         # ロックできなかったら undef を返す
         return;
     }
 }
 
 
 
 #
 # 強制ロック
 # ロックしたいモード(0:ロックしない 1:共有 2:排他)と、
 # ロック<font style="color:black;background-color:A0ffff">ファイル</font>名を渡します。
 # この関数は現在のロック状態を無視するので、(おそらく)常に
 # ロックに成功します。
 # ロックに成功すると、新しいロック<font style="color:black;background-color:A0ffff">ファイル</font>名を返します。
 # 失敗すると undef を返します。
 # 通常、この関数をユーザが呼び出すことはありません。
 #
 sub _force_lock{
     my $self    = shift             or die qq(_force_lock usage error.);
     my($mode,$from) = @_;
     my $to      = $from;
     if($mode == 0){
         # 何もせずに戻る
         return($self->{-lock} = $to);
     }elsif($mode == 1){
         # 強制共有ロック
         $to =~ s/\.(\d*)\.(\d*)\.lock$/.1.@{[time]}.lock/x
                                     or return;
     }else{
         # 強制排他ロック
         $to =~ s/\.(\d*)\.(\d*)\.lock$/..@{[time]}.lock/x
                                     or return;
     }
     if(rename($from => $to)){
         $self->{-mode}  = $mode;
         return($self->{-lock} = $to);
     }
     # ロックできなかったら undef を返す
     return;
 }
 
 
 
 #
 # ロック解除
 # ロック<font style="color:black;background-color:A0ffff">ファイル</font>名を渡します。
 # アンロックに成功すると、新しいロック<font style="color:black;background-color:A0ffff">ファイル</font>名を返します。
 # 失敗すると undef を返します。
 # 通常、この関数をユーザが呼び出すことはありません。
 #
 sub _unlock{
     my $self    = shift             or die qq(_unlock usage error.);
     my $mode    = $self->{-mode};
     my($from)   = @_;
     my $to      = $from;
     if($mode == 0){
         # 何もしない
         return($self->{-lock} = $to);
     }elsif($mode == 1){
         # 共有ロック解除
         $to =~ s/\.(\d+)\.(\d+)\.lock$
                 /.@{[$1 == 1 ? "." : ($1-1).".".$2]}.lock/x
                                     or return;
     }else{
         # 排他ロック解除
         $to =~ s/\.\.(\d+)\.lock$/...lock/x
                                     or return;
     }
     if(rename($from => $to)){
         # アンロック成功
         $self->{-mode}  = 0;
         return($self->{-lock} = $to);
     }else{
         # アンロックできなかったら undef を返す
         return;
     }
 }
 
 
 
 #
 # コンストラクタ
 #
 sub new{    shift->TIEHASH(@_)  }
 
 
 
 #
 # 引数の検査
 #
 sub _check_opt{
     my($self,$opt) = @_;
     
     # モード
     my $mode    = $opt->{-lock};
     if($mode == 0){
         ;;;
     }elsif($mode == 1 or $mode == 2 or $mode == 5 or $mode == 6){
         ;;;
     }else{
         $self->_die(qq{_check_opt unknown lock mode "$mode"});
     }
     
     # その他、簡易チェック
     foreach(keys %{$opt}){
         print $_;
         next if m/^-\w+$/;
         $self->_die(qq{_check_opt unknown option "$_"});
     }
     return;
 }
 
 
 
 #
 # ハッシュ %db を<font style="color:black;background-color:A0ffff">ファイル</font>に結びつける。
 # tie(%db,"Yuki::YukiWikiDB2",$dbname,%opt)
 # 
 # 最初の引数 $dbname はデータ(<font style="color:black;background-color:A0ffff">ファイル</font>)を保存するディレクトリ名
 #
 # それ以降はオプショナルの引数で、ハッシュ %opt の形で指定する。
 #
 # -lock => ロックモード
 #       0 : ロックしない。省略時のデフォルト
 #       1 : (LOCK_SH) 共有ロック,リトライあり
 #       2 : (LOCK_EX) 排他ロック,リトライあり
 #       5 : (LOCK_SH|LOCK_NB) 共有ロック,リトライなし
 #       6 : (LOCK_EX|LOCK_NB) 排他ロック,リトライなし
 #       8 : (LOCK_UN) 使わないこと。
 #
 # -trytime => ロックビジー時にリトライする回数を指定します。
 #             1回リトライする毎に1秒休止します。
 # -timeout => ロックをかけていられる最長時間(秒)を指定しま
 #             す。プロセスがロックを解除せずに異常終了した場
 #             合の対策用です。
 #       -trytime < -timeout : ロックリトライで失敗する可能性あり
 #       -trytime = -timeout : リトライ失敗後は常に強制ロック
 #
 # -logfile => ログ<font style="color:black;background-color:A0ffff">ファイル</font>名
 #   エラーやワーニングが発生したときに、その内容が書き込まれ
 #   る<font style="color:black;background-color:A0ffff">ファイル</font>です。CGI が動かないときのヒントになります。ロ
 #   ックリトライ時もワーニングが書き込まれるので、アクセス状
 #   況の参考になります。
 #
 # -extension => <font style="color:black;background-color:A0ffff">ファイル</font>につける<font style="color:black;background-color:ffff66">拡張子
 #
 sub</font> TIEHASH{
     my($class,$dbname,%opt) = @_;
     $dbname =~ s{[\\\/]?$}{};
 
     my $self = {
         -dir        => "$dbname/",  # データを保存するディレクトリ
         -mode       => 0,           # ロックしたら 0 以外の値になる
         -lock       => undef,       # ロック<font style="color:black;background-color:A0ffff">ファイル</font>名
         -keys       => [],          # キーリスト
         -error      => [],          # エラーメッセージ
         -bkup       => $opt{-backup},           # 1:バックアップを取る
         -bkup_next  => $opt{-backup},           # 1:次回バックアップを取る
         -trytime    => $opt{-trytime}   || 8,   # リトライ回数
         -timeout    => $opt{-timeout}   || 20,  # 最長ロック時間
         -logfile    => $opt{-logfile},          # ログファイル
         -encode     => undef,                   # キーのエンコードメソッド
         -decode     => undef,                   # キーのデコードメソッド
         -extension  => $opt{-extension} || '.txt',  # 拡張子
     };
     $self   = bless($self => $class);
     _check_opt(\%opt);
     my $mode    = $opt{-lock} & ~4;
     my $block   = $opt{-lock} & 4;
 
     # 初期化
     # rename でディレクトリ名の変更ができるかどうかは実装依存なので、
     # ロックファイルを作って rename する。
     my $unlock  = "$dbname...lock";
     if(not -d $dbname){
         my $path;
         foreach(split(m/[\/\\]/,$dbname)){
             if(not -d ($path .= "$_/")){
                 mkdir($path,0777)   or $self->_die(qq{TIEHASH $! "$dbname"});
             }
         }
         open(FILE,">$unlock")       or $self->_die(qq{TIEHASH $! "$unlock"});
         close FILE;
     }
 
     # キーのエンコードメソッド
     if("\U$opt{-encode}" eq 'YUKIWIKI'){
         # YukiWiki 互換
         $self->{-encode}    = sub{  $_[0]   = unpack("H*",$_[0])    };
         $self->{-decode}    = sub{  $_[0]   = pack("H*",$_[0])      };
     }elsif("\U$opt{-encode}" eq 'NONE' or not defined $opt{-encode}){
         # dune/wiki 互換(エンコードしない)
         $self->{-encode}    = sub{  $_[0]   };
         $self->{-decode}    = sub{  $_[0]   };
     }else{
         $self->_die(qq{TIEHASH unkown encode method. "$opt{-encode}"});
     }
 
     # ここからロック処理
     if($self->_lock($mode,$unlock)){
         # ロック成功(たいてい、ここで完了する)
         ;;;
     }elsif($block){
         # ロック失敗(ウェイトなし)
         $self->_warn(qq{TIEHASH lock blocked. "$unlock"});
     }else{
         # ロック失敗(ウェイト)
         TRY:foreach(my $try = 0;$try < $self->{-trytime};++$try){
 
             # ロックファイルを探す
             opendir(DIR,"$dbname/..")
                                 or $self->_die(qq{TIEHASH $! "$dbname/.."});
             my @nglock  = readdir DIR;
             closedir DIR;
 
             my($nglock,$duration);
             (my $name   = $dbname)  =~ s/^.+\///;
             foreach(@nglock){
                 if(m/^\Q$name\E\.(\d*)\.(\d*)\.lock$/){
                     $nglock     = qq($dbname.$1.$2.lock);
                     $duration   = time - $2 if $2;
                     last;
                 }
             }
 
             # ロックファイルが見つからない?
             if(not defined $nglock){
                 $self->_die(qq{TIEHASH lockfile not found. "$unlock"});
             }
 
             # 既存ロックを更新してロック
             if($self->{-timeout} < $duration){
                 # 異常なロック
                 $self->_warn(qq{TIEHASH dated lock found ($duration). "$nglock"});
                 last TRY    if $self->_force_lock($mode,$nglock);
                 $self->_warn(qq{TIEHASH force lock failure. "$nglock"});
             }else{
                 # 正常なロック
                 last TRY    if $self->_lock($mode,$nglock);
             }
 
             # ウェイト
             $self->_warn(qq{TIEHASH retry lock ($try/$self->{-trytime}). "$nglock"});
             sleep 1;
         }
     }
 
     my $lock    = $self->{-lock};
     if(not $lock){
         # ロック失敗
         $self->_warn(qq{TIEHASH lock failure. "$unlock"})   unless $lock;
         return;
     }else{
         return $self;
     }
 }
 
 
 
 #
 # UNTIE - untie し忘れると呼ばれないので、これに頼るとロック
 # が解除されずに残ったりする。 
 #
 sub UNTIE{
     my($self) = @_;
     my $mode    = $self->{-mode};
     my $lock    = $self->{-lock};
 
     if(!$mode or $self->_unlock($lock)){
         # アンロック成功(たいてい、ここで完了する)
         ;;;
     }else{
         # アンロック失敗、ロックファイルを探す(共有ロック時)
         chop(my $dbname = $self->{-dir});
         TRY:foreach(my $try = 0;$try < $self->{-trytime};++$try){
             opendir(DIR,"$dbname/..")   or $self->_die(qq{UNTIE $! "$dbname/.."});
             my @nglock  = readdir DIR;
             closedir DIR;
 
             my($nglock,$duration);
             (my $name   = $dbname)  =~ s/^.+\///;
             foreach(@nglock){
                 if(m/^\Q$name\E\.(\d*)\.(\d*)\.lock$/){
                     $nglock     = qq($dbname.$1.$2.lock);
                     $duration   = time - $2 if $2;
                     last;
                 }
             }
             last TRY if $self->_unlock($nglock);
             
             if($nglock eq "$dbname...lock"){
                 # ありえないはずだが、なぜかときどきくる。
                 $self->_warn(qq{UNTIE not locked. "$nglock"});
                 last TRY;
             }
 
             # ウェイト(sleep なし)
             $self->_warn(qq{UNTIE retry unlock ($try/$self->{-trytime}). "$nglock"});
         }
         
         if($self->{-lock} eq $lock){
             $self->_warn(qq{UNTIE unlock failure. "$lock"});
         }
     }
     return;
 }
 
 
 
 #
 # デストラクタ
 #
 # DESTROY は untie し忘れても呼ばれる。
 # new または tie のスコープの外に出たとき(perl 終了時とか)
 # に呼ばれるか、あるいは戻り値を使っている場合、オブジェクト
 # が参照されなくなったとき、または明示的に undef したときに
 # 呼ばれる。とにかく必ず呼ばれるみたいだ。 
 #
 sub DESTROY{
     my($self) = @_;
     if($self->{-mode}){
         # untie 忘れの尻拭い
         $self->_warn(qq{DESTROY invoke untie method.}) if 0;
         $self->UNTIE();
     }
     return;
 }
 
 
 
 #
 # 書き込み
 #
 sub STORE{
     my($self,$key,$val) = @_;
     my $mode    = $self->{-mode};
     if($mode == 1){
         # 共有ロックで STORE しようとした。
         chop(my $dbname = $self->{-dir});
         $self->_die(qq{STORE method not allowd. key="$key"});
     }
     my $file    = $self->filename($key);
     my $temp    = "$file.".time;
     my $bkup    = $self->bkupname($key);
     open(FILE,">$temp")             or $self->_die(qq{STORE $! "$temp"});
     binmode FILE;
     print FILE $val;
     close FILE;
     if($self->{-bkup_next}){
         if(-e $bkup){
             unlink $bkup            or $self->_die(qq{STORE $! "$bkup"});
         }
         if(-e $file){
             rename($file => $bkup)  or $self->_die(qq{STORE $! "$file" => "$bkup"});
         }
     }else{
         if(-e $file){
             unlink $file            or $self->_die(qq{STORE $! "$file"});
         }
     }
     rename($temp => $file)          or $self->_die(qq{STORE $! "$temp" => "$file"});
     $self->{-bkup_next} = $self->{-bkup};
     $self->{-cache}->{-key} = $key;
     $self->{-cache}->{-val} = $val;
     return $val;
 }
 
 
 
 #
 # 読み出し
 #
 sub FETCH{
     my($self,$key) = @_;
     if($self->{-cache}->{-key} eq $key){
         return $self->{-cache}->{-val};
     }
     my $file    = $self->filename($key);
     if(-e $file){
         open(FILE,$file)            or $self->_die(qq{FETCH $! "$file"});
         binmode FILE;
         local $/    = undef;
         my $val = <FILE>;
         close FILE;
         $self->{-cache}->{-key} = $key;
         $self->{-cache}->{-val} = $val;
         return $val;
     }else{
         return;
     }
 }
 
 
 
 #
 # 削除
 #
 sub DELETE{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     my $bkup    = $self->bkupname($key);
     my $mode    = $self->{-mode};
     if($mode == 1){
         # 共有ロックで DELETE しようとした。
         chop(my $dbname = $self->{-dir});
         $self->_die(qq{DELETE method not allowd. key="$key"});
     }
     if($self->{-bkup_next}){
         if(-e $bkup){
             unlink $bkup            or $self->_die(qq{DELETE $! "$bkup"});
         }
         if(-e $file){
             rename($file => $bkup)  or $self->_die(qq{DELETE $! "$file" => "$bkup"});
         }
     }else{
         if(-e $file){
             unlink $file            or $self->_die(qq{DELETE $! "$file"});
         }
     }
     $self->{-bkup_next} = $self->{-bkup};
     $self->{-cache} = undef;
     return;
 }
 
 
 
 #
 # 存在チェック
 #
 sub EXISTS{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     return -e $file;
 }
 
 
 
 #
 # イテレータ
 #
 sub FIRSTKEY{
     my($self)   = @_;
     @{$self->{-keys}}   = $self->_list_all();
     my $tmp = shift @{$self->{-keys}};
     return defined $tmp ? &{$self->{-decode}}($tmp) : undef;
 }
 sub NEXTKEY{
     my($self)   = @_;
     my $tmp = shift @{$self->{-keys}};
     return defined $tmp ? &{$self->{-decode}}($tmp) : undef;
 }
 
 
 
 #
 # ハッシュ全体の削除
 #
 # フォルダの中身を空にする(空ハッシュにする)だけで、ディレ
 # クトリやロックファイルは残す(仕様!)。
 #
 sub CLEAR{
     my($self)   = @_;
     my $mode    = $self->{-mode};
     if($mode == 1){
         # 共有ロックで CLEAR しようとした。
         chop(my $dbname = $self->{-dir});
         $self->_die(qq{CLEAR method not allowd.});
     }
     my $dir     = $self->{-dir};
     opendir(DIR,$dir)               or $self->_die(qq{CLEAR $! "$dir".});
     foreach(readdir DIR){
         if(-f $dir.$_){
             unlink $dir.$_          or $self->_die(qq{CLEAR $! "$dir$_".});
         }
     }
     closedir DIR;
     if(1){
         my $file    = $self->{-logfile};
         if(-e $file){
             unlink $file            or $self->_die(qq{CLEAR $! "$file".});
         }
     }
     if(0){
         my $lock    = $self->{-lock};
         rmdir $dir                  or $self->_die(qq{CLEAR $! "$dir".});
         unlink $lock                or $self->_die(qq{CLEAR $! "$lock".});
         $self->{-mode}  = 0;
     }
     $self->{-cache} = undef;
     return;
 }
 
 
 
 #
 # いわゆる ListAll
 #
 sub _list_all{
     my $self    = shift;
     my $dir     = $self->{-dir};
     my $extlen  = -length $self->{-extension};
     opendir(DIR,$dir)           or $self->_die(qq{_list_all $! "$dir".});
     my @key = grep((0 <= index($_,$self->{-extension}) and $_),readdir DIR);
     foreach(@key){
         substr($_,$extlen)  = '';
     }
     return @key;
 }
 sub list_all{
     my $self    = shift;
     my @key     = $self->_list_all();
     foreach(@key){
         &{$self->{-decode}}($_);
     }
     return @key;
 }
 
 
 
 #
 # キーのリストを、更新日順に並べて返す(最近のものが先頭)。
 #
 sub sort_by_mtime{
     my $self    = shift;
     my $dir     = $self->{-dir};
     my @key     = @_;
     if(not @key){
         @key    = $self->_list_all();
     }else{
         foreach(@key){
             &{$self->{-encode}}($_);
         }
     }
     return map(&{$self->{-decode}}($_->[1]),
                 sort({$a->[0] <=> $b->[0] or $a->[1] cmp $b->[1]}
                     map([-M $dir.$_.$self->{-extension},$_],@key)));
 }
 
 
 
 #
 # いわゆる RecentChanges(WhatsNew)
 #
 sub recent_changes{
     my $self    = shift;
     my $n       = shift;
     my @key     = $self->sort_by_mtime();
     if($n == 0){
         return @key;
     }elsif($n < 0){
         return (reverse @key)[0..-$n-1];
     }else{
         return @key[0..($n-1)];
     } 
 }
 
 
 
 #
 # バックアップフラグの一時セット
 #
 # セットすると次のデータ更新時にバックアップをとる。
 # バックアップをとったらフラグはリセットされる。
 #
 # ex. $DB->bkup_next(1);    # 次回バックアップをとる。
 # ex. $DB->bkup_next(0);    # 次回バックアップをとらない。
 #
 sub bkup_next{
     my($self,$flag) = @_;
     return defined $flag ?
             ($self->{-bkup_next} = $flag) :
             $self->{-bkup_next};
 #   $self->{-bkup_next} = $flag || 1
 }
 
 
 
 #
 # 現在のデータとバックアップデータとの間の差分を求める。
 # ex. $diff = $DB->diff('foo');
 # ex. @diff = $DB->diff('foo');
 #
 sub diff{
     eval <<'    ###__CODE__###';
     use Algorithm::Diff;
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     my $bkup    = $self->bkupname($key);
     my(@old,@new);
     local $/    = undef;
 
     if(-e $bkup){
         open(FILE,$bkup)            or $self->_die(qq{diff $! "$bkup"});
         binmode FILE;
         @old    = split(m/[\x0D\x0A\x00]+/,<FILE>);
         close FILE;
     }
     if(-e $file){
         open(FILE,$file)            or $self->_die(qq{diff $! "$file"});
         binmode FILE;
         @new    = split(m/[\x0D\x0A\x00]+/,<FILE>);
         close FILE;
     }
 
     my $diff    = Algorithm::Diff::diff(\@old,\@new);
     my @diff;
     foreach(@{$diff}){
         my $diff;
         foreach(@{$_}){
             my($sign,$lineno,$text) = @{$_};
             $diff   .= qq($sign"$text"\n);
         }
         push(@diff,$diff);
     }
     return join("----\n",@diff);
     ###__CODE__###
 }
 
 
 
 #
 # データの最終更新日時を localtime で求める。
 #
 sub stat{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     return CORE::stat($file);
 }
 sub mtime{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     return ( (CORE::stat($file))[9] );
 }
 sub localtime{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     return localtime( (CORE::stat($file))[9] );
 }
 
 
 
 #
 # 情報の読み出し
 #
 sub info{
     my $self    = shift             or die qq(_warn : usage error.);
     my $info;
     foreach my $key (sort keys %{$self}){
         my $val = $self->{$key};
         $info   .= qq($key\t: $val\n);
         if(ref($val) eq 'ARRAY' and @{$val}){
             $info   .= join("\n",@{$val})."\n"
         }
     }
     return $info;
 }
 
 
 
 #
 # ヘッドライン読み出し
 #
 sub headline{
     my($self,$key) = @_;
     my $file    = $self->filename($key);
     if(exists $self->{-headline}->{$key}){
         ;;;
     }elsif(-e $file){
         open(FILE,$file)            or $self->_die(qq{headline $! "$file"});
         binmode FILE;
         local $/    = "\n";
         while(<FILE>){
             s/^[\s\t]+//;
             s/[\s\t]+$//;
             next unless length;
             $self->{-headline}->{$key}  = $_;
             last;
         }
         close FILE;
     }else{
         $self->{-headline}->{$key}  = undef;
     }
     return $self->{-headline}->{$key};
 }
 
 1;;;
 
 __END__

意見

(Too many spams ... embedded comments are not allowed now, sorry.)