lib/Yuki/YukiWikiDBNS.pm



###
### $Id: YukiWikiDBNS.pm,v 1.5 2003/07/17 23:57:19 w Exp $
###

# Yuki::YukiWikiDB2.pm - Pure Perl database module, esp. for YukiWiki.
#
# Copyright (C) 2002 by Gokuaku.
# <FZH01112@nifty.ne.jp>, http://homepage1.nifty.com/dune/

# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

require 5.004_71;
package Yuki::YukiWikiDBNS;
($VERSION) = q($Revision: 1.5 $) =~ m/\x20([\d.]+)\x20/;
use strict;


#
# _die  - $BCWL?E*$J%(%i!<H/@8;~$K8F$S=P$94X?t!#(B
# _warn - $B7Y9pH/@8;~$K8F$S=P$94X?t!#(B
#
sub _die{
        my $self        = shift;
        my $file        = $self->{-logfile};
        my $dir         = $self->{-dir};
        my $caller      = join(" ",(caller 1)[1,2]);
        my $msg         = qq/ERR (@{[scalar localtime]}) $dir @_ $caller/;
        push(@{$self->{-error}},$msg);
        if($file){
                # $file $B$O2u$l$F$b5$$K$7$J$$(B
                # $B%5%$%:$,5$$K$J$k$H$-$O(B >> $B$r(B > $B$KJQ$($k!#(B
                open(FILE,">>$file")            or die qq(_die : $! "$file");
                print FILE $msg,"\n";
                close FILE;
        }
        die "$msg\n";
}
sub _warn{
        my $self        = shift;
        my $file        = $self->{-logfile};
        my $dir         = $self->{-dir};
        my $caller      = join(" ",(caller 1)[1,2]);
        my $msg         = qq/WRN (@{[scalar localtime]}) $dir @_ $caller/;
        push(@{$self->{-error}},$msg);
        if($file){
                # $file $B$O2u$l$F$b5$$K$7$J$$(B
                # $B%5%$%:$,5$$K$J$k$H$-$O(B >> $B$r(B > $B$KJQ$($k!#(B
                open(FILE,">>$file")            or die qq(_warn : $! "$file");
                print FILE $msg,"\n";
                close FILE;
        }
        return $msg;
}


#
# $B%(%i!<%a%C%;!<%8$N=hM}(B
#
# errmsg        - $B%(%i!<%a%C%;!<%8!JJ8;zNs!K$r<hF@$7$^$9!#(B
#                               $B%(%i!<$,$J$$>l9g$O(B undef $B$rJV$7$^$9!#(B
# clr_errmsg    - $B%(%i!<%a%C%;!<%8$r>C5n$7$^$9!#(B
#               $BLa$jCM$O>o$K(B undef $B$G$9!#(B
#
# errlog        - $B%(%i!<%m%0!J%U%!%$%k!K$rFI$_=P$7$^$9!#(B
#                               $B%(%i!<$,$J$$>l9g$O(B undef $B$rJV$7$^$9!#(B
# clr_errlog    - $B%(%i!<%m%0!J%U%!%$%k!K$r>C5n$7$^$9!#(B
#               $BLa$jCM$O>o$K(B undef $B$G$9!#(B
#
sub errmsg{
        my $self        = shift                         or die qq(errmsg : usage error.);
        my @log = @{$self->{-error}};
        if(wantarray){
                return @log;
        }else{
                return @log ? join("",@log) : undef;
        }
}
sub errlog{
        my $self        = shift                         or die qq(errlog : usage error.);
        my $file        = $self->{-logfile}     or return;
        open(FILE,$file)                                or return;
        my @log = <FILE>;
        close FILE;
        if(wantarray){
                return @log;
        }else{
                return @log ? join("",@log) : undef;
        }
}
sub clr_errmsg{
        my $self        = shift                 or die qq(clr_errmsg : usage error.);
        $self->{-error} = [];
        return undef;
}
sub clr_errlog{
        my $self        = shift                 or die qq(clr_errlog : usage error.);
        my $file        = $self->{-logfile};
        -e $file and unlink $file;
        return undef;
}


#
# $B@8$N%U%!%$%kL>$rF@$k(B
#
# $B%O%C%7%e$NFbMF$O!"Nc$($P(B $hash{foo} = 'bar' $B$r<B9T$9$k$H(B  
# foo.txt $B$H$$$&%U%!%$%k$K(B bar $B$H=q$-9~$^$l$^$9!J#17o$K$D$-(B
# $B#1%U%!%$%k$,:n@.$5$l$k!K!#(B
# filename $B$G!"$=$N%U%!%$%kL>!J(Bfoo$B!K$rF@$k$3$H$,$G$-$^$9!#(B
# bkupname $B$O%P%C%/%"%C%W%U%!%$%kL>$rF@$^$9!#(B
# $B3:Ev%U%!%$%k$NM-L5$K4X78$J$/!"7A<0E*$K%U%!%$%kL>$rJV$7$^$9!#(B
#
# 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';
}

sub dig_directory ($$) {
  my ($self, $dir) = @_;
  my $path = '';
  $dir =~ s#[/\\][^/\\]+$##;
  return if -d $dir;
        foreach(split(m/[\/\\]/,$dir)){
                if(not -d ($path .= "$_/")){
                        mkdir($path,0777)       or $self->_die(qq{_init : $! "$path"});
                }
        }
}

sub _get_lock_file_name ($%) {
    my ($self, %o) = @_;
    return sprintf '%s.%d.%d.lock%s', $o{prefix}, $o{seq}, $o{time}, $o{suffix};
}

sub _match_lock_file_name ($$%) {
    my ($self, $fname, %o) = @_;
    if ($fname =~ /\Q$o{prefix}\E\.([0-9]+)\.([0-9]+)\.lock\Q$o{suffix}\E$/) {
        return {seq => $1, time => $2};
    }
    return undef;
}

sub _s_lock_file_name ($$$$) {
  my ($self, $fname, $p, $o) = @_;
  return ($$fname =~ s/\Q$p->{prefix}\E\.([0-9]+)\.([0-9]+)\.lock\Q$p->{suffix}\E$/sprintf '%s.%d.%d.lock%s', $o->{prefix}, $1*$o->{seq_z}+$o->{seq_p}, $2*$o->{time_x}+$o->{time_p}, $o->{suffix}/);
}

#
# $B%m%C%/(B
# $B%m%C%/$7$?$$%b!<%I!J(B0:$B%m%C%/$7$J$$(B 1:$B6&M-(B 2:$BGSB>!K$H!"(B
# $B%m%C%/%U%!%$%kL>!J%m%C%/$5$l$kA0$N$b$N!K$rEO$7$^$9!#(B
# $B%m%C%/$K@.8y$9$k$H!"?7$7$$%m%C%/%U%!%$%kL>$rJV$7$^$9!#(B
# $B<:GT$9$k$H(B undef $B$rJV$7$^$9!#(B
# $BDL>o!"$3$N4X?t$r%f!<%6$,8F$S=P$9$3$H$O$"$j$^$;$s!#(B
#
sub _lock{
        my($self,$mode,$from)   = @_;
        my $to          = $from;
        if($mode == 0){
                # $B2?$b$;$:$KLa$k(B
                return($self->{-lock} = $to);
        }elsif($mode == 1){
                # $B6&M-%m%C%/(B
                #$to    =~ s/\.\.\.lock\Q$self->{-extension}\E$/.1.@{[time]}.lock$self->{-extension}/x
                #               or
                #$to    =~ s/\.(\d+)\.(\d+)\.lock\Q$self->{-extension}\E$/.@{[$1+1]}.@{[time]}.lock$self->{-extension}/x
                #               or
                #return;        # $B$?$V$s!"GSB>%m%C%/$5$l$F$$$k!#(B
          $self->_s_lock_file_name (\$to,
               {suffix => $self->{-extension}}
            => {seq_x => 1, seq_p => 1, time_x => 0, time_p => time,
                suffix => $self->{-extension}})
            or
          return;
        }else{
                # $BGSB>%m%C%/(B
                #$to    =~ s/\.\.\.lock\Q$self->{-extension}\E$/..@{[time]}.lock$self->{-extension}/x
                #               or
                #return;        # $B$?$V$s!"6&M-%m%C%/$5$l$F$$$k!#(B
          my $lock_name = $self->_match_lock_file_name
            ($to, suffix => $self->{-extension});
          if ($lock_name && $lock_name->{seq} == 0
                         && $lock_name->{time} == 0) {
            $self->_get_lock_file_name (\$to,
                 {suffix => $self->{-extension}}
              => {seq_x => 0, seq_p => 0, time_x => 0, time_p => time,
                  suffix => $self->{-extension}})
          } else {
            return;
          }
        }
        if(rename($from => $to)){
                # $B%m%C%/@.8y(B
                $self->{-mode}  = $mode;
                return($self->{-lock} = $to);
        }else{
                # $B%m%C%/$G$-$J$+$C$?$i(B undef $B$rJV$9(B
                return;
        }
}


#
# $B6/@)%m%C%/(B
# $B%m%C%/$7$?$$%b!<%I!J(B0:$B%m%C%/$7$J$$(B 1:$B6&M-(B 2:$BGSB>!K$H!"(B
# $B%m%C%/%U%!%$%kL>$rEO$7$^$9!#(B
# $B$3$N4X?t$O8=:_$N%m%C%/>uBV$rL5;k$9$k$N$G!"!J$*$=$i$/!K>o$K(B
# $B%m%C%/$K@.8y$7$^$9!#(B
# $B%m%C%/$K@.8y$9$k$H!"?7$7$$%m%C%/%U%!%$%kL>$rJV$7$^$9!#(B
# $B<:GT$9$k$H(B undef $B$rJV$7$^$9!#(B
# $BDL>o!"$3$N4X?t$r%f!<%6$,8F$S=P$9$3$H$O$"$j$^$;$s!#(B
#
sub _force_lock{
        my($self,$mode,$from)   = @_;
        my $to          = $from;
        if($mode == 0){
                # $B2?$b$;$:$KLa$k(B
                return($self->{-lock} = $to);
        }elsif($mode == 1){
                # $B6/@)6&M-%m%C%/(B
                #$to    =~ s/\.(\d*)\.(\d*)\.lock\Q$self->{-extension}\E$/.1.@{[time]}.lock$self->{-extension}/x
                #                                                       or return;
          my $lock_name = $self->_match_lock_file_name
            ($to, suffix => $self->{-extension});
          if ($lock_name) {
            $self->_get_lock_file_name (\$to,
                 {suffix => $self->{-extension}}
              => {seq_x => 0, seq_p => 1, time_x => 0, time_p => time,
                  suffix => $self->{-extension}})
          } else {
            return;
          }
        }else{
                # $B6/@)GSB>%m%C%/(B
                #$to    =~ s/\.(\d*)\.(\d*)\.lock\Q$self->{-extension}\E$/..@{[time]}.lock$self->{-extension}/x
                #                                                       or return;
          my $lock_name = $self->_match_lock_file_name
            ($to, suffix => $self->{-extension});
          if ($lock_name) {
            $self->_get_lock_file_name (\$to,
                 {suffix => $self->{-extension}}
              => {seq_x => 0, seq_p => 0, time_x => 0, time_p => time,
                  suffix => $self->{-extension}})
          } else {
            return;
          }
        }
        if(rename($from => $to)){
                $self->{-mode}  = $mode;
                return($self->{-lock} = $to);
        }
        # $B%m%C%/$G$-$J$+$C$?$i(B undef $B$rJV$9(B
        return;
}


#
# $B%m%C%/2r=|(B
# $B%m%C%/%U%!%$%kL>$rEO$7$^$9!#(B
# $B%"%s%m%C%/$K@.8y$9$k$H!"?7$7$$%m%C%/%U%!%$%kL>$rJV$7$^$9!#(B
# $B<:GT$9$k$H(B undef $B$rJV$7$^$9!#(B
# $BDL>o!"$3$N4X?t$r%f!<%6$,8F$S=P$9$3$H$O$"$j$^$;$s!#(B
#
sub _unlock{
        my($self,$from) = @_;
        my $mode        = $self->{-mode};
        my $to          = $from;
        if($mode == 0){
                # $B2?$b$7$J$$(B
                return($self->{-lock} = $to);
        }elsif($mode == 1){
                # $B6&M-%m%C%/2r=|(B
                #$to    =~ s/\.(\d+)\.(\d+)\.lock\Q$self->{-extension}\E$
                #               /.@{[$1 == 1 ? "." : ($1-1).".".$2]}.lock$self->{-extension}/x
                #                                                       or return;
          my $lock_name = $self->_match_lock_file_name ($to,
            suffix => $self->{-extension});
          if ($lock_name && $lock_name->{seq}
                         && $lock_name->{time}) {
            if ($lock_name->{seq} == 1) {
              $self->_s_lock_file_name (\$to,
                   {suffix => $self->{-extension}}
                => {seq_x => 0, seq_p => 0,
                    time_x => 0, time_p => 0,
                    suffix => $self->{-extension}});
            } else {
              $self->_s_lock_file_name (\$to,
                   {suffix => $self->{-extension}}
                => {seq_x => 1, seq_p => -1,
                    time_x => 0, time_p => time,
                    suffix => $self->{-extension}});
            }
          } else {
            return;
          }
        }else{
                # $BGSB>%m%C%/2r=|(B
                #$to    =~ s/\.\.(\d+)\.lock\Q$self->{-extension}\E$/...lock$self->{-extension}/x
                #                                                       or return;
          my $lock_name = $self->_match_lock_file_name ($to,
            suffix => $self->{-extension});
          if ($lock_name && !$lock_name->{seq}
                         && $lock_name->{time}) {
            $self->_s_lock_file_name (\$to,
                 {suffix => $self->{-extension}}
              => {seq_x => 0, seq_p => 0,
                  time_x => 0, time_p => 0,
                  suffix => $self->{-extension}});
          } else {
            return;
          }
        }
        if(rename($from => $to)){
                # $B%"%s%m%C%/@.8y(B
                $self->{-mode}  = 0;
                return($self->{-lock} = $to);
        }else{
                # $B%"%s%m%C%/$G$-$J$+$C$?$i(B undef $B$rJV$9(B
                return;
        }
}


#
# $B%3%s%9%H%i%/%?(B
#
sub new{        shift->TIEHASH(@_)      }


#
# $B0z?t$N8!::(B
#
sub _check_opt{
        my($dbname,$opt) = @_;

        $dbname ||=     q(YukiWikiDBNS);
        (my $dir        = $dbname) =~ s/[\\\/]/\//g;
        $dir    =~ s/[\/]*$/\//;

        my $self = {
                -dir            => $dir,                # $B%G!<%?%Y!<%9L>!J%G%#%l%/%H%j!K(B
                -mode           => 0,                   # $B%m%C%/$7$?$i(B 0 $B0J30$NCM$K$J$k(B
                -lock           => undef,               # $B%m%C%/%U%!%$%kL>(B
                -keys           => [],                  # $B%-!<%j%9%H(B
                -error          => [],                  # $B%(%i!<%a%C%;!<%8(B
                -bkup           => $opt->{-backup},                     # 1:$B%P%C%/%"%C%W$r<h$k(B
                -bkup_next      => $opt->{-backup},                     # 1:$B<!2s%P%C%/%"%C%W$r<h$k(B
                -trytime        => $opt->{-trytime}     || 8,   # $B%j%H%i%$2s?t(B [$B#1IC(B/$B2s(B]
                -timeout        => $opt->{-timeout}     || 20,  # $B:GD9%m%C%/;~4V(B [$BIC(B]
                -logfile        => $opt->{-logfile},            # $B%m%0%U%!%$%k(B
                
                -extension      => (exists $opt->{-extension} ?
                                                 $opt->{-extension} : '.txt'),  # $B3HD%;R(B

                -cache          => {},
                -headline       => {},
        };


        # $B%b!<%I$N%A%'%C%/(B
        my $mode        = $opt->{-lock};
        if($mode == 0){
                ;;;
        }elsif($mode == 1 or $mode == 2 or $mode == 5 or $mode == 6){
                ;;;
        }else{
                _die($self,qq{_check_opt : unknown lock mode "$mode"});
        }

        # $B%-!<$N%(%s%3!<%I%a%=%C%I(B
        ## ENCODE: perl hash key name ->-> file system name
        ## DECODE: file system name ->-> perl hash key name
        my $method      = $opt->{-encode};
        if("\U$method" eq 'HEXNS' or not defined $method){
                # HEX + NS
                $self->{-encode}        = sub{  $_[0] = uc unpack("H*",$_[0]); $_[0] =~ s#2F2F#.ns/#g; $_[0]    };
                $self->{-decode}        = sub{  $_[0] =~ s#\.ns/#2F2F#g; $_[0] = pack("H*",$_[0]); $_[0]                };
        } elsif("\U$method" eq 'YUKIWIKI'){
                # YukiWiki $B8_49(B
                $self->{-encode}        = sub{  $_[0] = uc unpack("H*",$_[0])   };
                $self->{-decode}        = sub{  $_[0] = pack("H*",$_[0])                };
        }elsif("\U$method" eq 'NONE'){
                # dune/wiki $B8_49!J%(%s%3!<%I$7$J$$!K(B
                $self->{-encode}        = sub{  $_[0]   };
                $self->{-decode}        = sub{  $_[0]   };
        }elsif($method eq 'RFC'){
                # RFC2396/2732  [^A-Za-z0-9\-_.!~*'()]
                $self->{-encode}        = sub{
                        $_[0] =~ s/([^\w\-.!~()])/
                                sprintf('%%%02X',ord $1)/eg
                        };
                $self->{-decode}        = sub{
                                $_[0] =~ s/%([0-9A-Fa-f]{2})/chr(hex $1)/eg;
                        };
        }elsif($method eq 'rfc'){
                $self->{-encode}        = sub{
                        $_[0] =~ s/([^\w\_!~()])/
                                sprintf('%%%02x',ord $1)/eg
                        };
                $self->{-decode}        = sub{
                                $_[0] =~ s/%([0-9A-Fa-f]{2})/chr(hex $1)/eg;
                        };
        }else{
                _die($self,qq{_check_opt : unkown encode method "$method"});
        }

        # $B4J0W%A%'%C%/(B
        foreach(keys %{$opt}){
                next if m/^-\w+$/;
                _die($self,qq{_check_opt : unknown option "$_"});
        }

        return $self;
}


#
# $B%G%#%l%/%H%j$r7!$k!#(B
# $B%m%C%/%U%!%$%k$r:n$k!#(B
#
sub _init{
        my($self)       = @_;
        chop(my $dbname = $self->{-dir});       # $B:G8e$N(B / $B$r:o=|(B
        my $path;
        foreach(split(m/[\/\\]/,$dbname)){
                if(not -d ($path .= "$_/")){
                        mkdir($path,0777)       or $self->_die(qq{_init : $! "$path"});
                }
        }
        opendir(DIR,"$dbname/..")               or $self->_die(qq{_init : $! "$dbname/.."});
        my @lockfile    = readdir DIR;
        closedir DIR;
        my($lockfile);
        foreach(@lockfile){
                #if(m/^\Q$dbname\E\.(\d*)\.(\d*)\.lock\Q$self->{-extension}\E$/){
                #       last;
                #}
          if ($self->_match_lock_file_name ($_,
                suffix => $self->{-extension})) {
            last;
          }
        }
        if(not defined $lockfile){
          $lockfile = $self->_get_lock_file_name (prefix => $dbname,
                                                  seq => 0, time => 0,
                                                  suffix => $self->{-extension});
                #$lockfile      = "$dbname...lock$self->{-extension}";
                open(FILE,">", $lockfile)               or $self->_die(qq{_init : $! "$lockfile"});
#               print FILE scalar localtime,"\n";
                close FILE;
        }else{
                $self->_die(qq{_init : lockfile already exists. "$lockfile"});
        };
}


#
# $B%O%C%7%e(B %db $B$r%U%!%$%k$K7k$S$D$1$k!#(B
# tie(%db,"Yuki::YukiWikiDBNS",$dbname,%opt)
# 
# $B:G=i$N0z?t(B $dbname $B$O%G!<%?!J%U%!%$%k!K$rJ]B8$9$k%G%#%l%/%H%jL>(B
#
# $B$=$l0J9_$O%*%W%7%g%J%k$N0z?t$G!"%O%C%7%e(B %opt $B$N7A$G;XDj$9$k!#(B
#
# -lock => $B%m%C%/%b!<%I(B
#               0 : $B%m%C%/$7$J$$!#>JN,;~$N%G%U%)%k%H(B
#               1 : (LOCK_SH) $B6&M-%m%C%/!$%j%H%i%$$"$j(B
#               2 : (LOCK_EX) $BGSB>%m%C%/!$%j%H%i%$$"$j(B
#               5 : (LOCK_SH|LOCK_NB) $B6&M-%m%C%/!$%j%H%i%$$J$7(B
#               6 : (LOCK_EX|LOCK_NB) $BGSB>%m%C%/!$%j%H%i%$$J$7(B
#               8 : (LOCK_UN) $B;H$o$J$$$3$H!#(B
#       $B%m%C%/%b!<%I(B 0 $B$O!"8=:_$N%m%C%/>uBV$K4X78$J$/%G!<%?%Y!<%9$K@\B3(B
#       $B$7$^$9!#$=$N$?$a6&M-%m%C%/Cf$N%G!<%?%Y!<%9$K%m%C%/%b!<%I(B 0 $B$G(B
#       $B@\B3$7$F%G!<%?$r=q$-9~$`!"$H$$$C$?$3$H$,$G$-$F$7$^$$$^$9!J;EMM!K!#(B
#       $BEvA3!"%m%C%/%b!<%I(B 0 $B$OB>$N%m%C%/%b!<%I$N%V%m%C%/$b$7$^$;$s!#(B
#
# -trytime => $B%m%C%/%S%8!<;~$K%j%H%i%$$9$k2s?t!J(B[$B#1IC(B/$B2s(B]$B!K$r;XDj(B
#             $B$7$^$9!##12s%j%H%i%$$9$kKh$K#1IC5Y;_$7$^$9!#(B
# -timeout => $B%m%C%/$r$+$1$F$$$i$l$k:GD9;~4V!JC10L(B [$BIC(B]$B!K$r;XDj$7$^(B
#             $B$9!#%W%m%;%9$,%m%C%/$r2r=|$;$:$K0[>o=*N;$7$?>l(B
#             $B9g$NBP:vMQ$G$9!#(B
#               -trytime < -timeout : $B%m%C%/%j%H%i%$$G<:GT$9$k2DG=@-$"$j(B
#               -trytime = -timeout : $B%j%H%i%$<:GT8e$O>o$K6/@)%m%C%/(B
#
# -logfile => $B%m%0%U%!%$%kL>(B
#       $B%(%i!<$d%o!<%K%s%0$,H/@8$7$?$H$-$K!"$=$NFbMF$,=q$-9~$^$l(B
#       $B$k%U%!%$%k$G$9!#(BCGI $B$,F0$+$J$$$H$-$N%R%s%H$K$J$j$^$9!#%m(B
#       $B%C%/%j%H%i%$;~$b%o!<%K%s%0$,=q$-9~$^$l$k$N$G!"%"%/%;%9>u(B
#       $B67$N;29M$K$J$j$^$9!#(B
#
# -extension => $B%U%!%$%k$K$D$1$k3HD%;R(B
#
sub TIEHASH{
        my($class,$dbname,%opt) = @_;
        my $self        = bless(_check_opt($dbname,\%opt) => $class);
        my $mode        = $opt{-lock} & ~4;
        my $block       = $opt{-lock} & 4;

        # $B=i4|2=(B
        # rename $B$G%G%#%l%/%H%jL>$NJQ99$,$G$-$k$+$I$&$+$O<BAu0MB8$J$N$G!"(B
        # $B%m%C%/%U%!%$%k$r:n$C$F(B rename $B$9$k!#(B
        if(not -d $self->{-dir}){
                $self->_init();
        }

        # $B$3$3$+$i%m%C%/=hM}(B
        chop($dbname    = $self->{-dir});
        #my $lock       = "$dbname...lock$self->{-extension}";
        my $lock = $self->_get_lock_file_name (prefix => $dbname,
                       seq => 0, time => 0,
                       suffix => $self->{-extension});
        if($self->_lock($mode,$lock)){
                # $B%m%C%/@.8y!J$?$$$F$$!"$3$3$G40N;$9$k!K(B
                ;;;
        }elsif($block){
                # $B%m%C%/<:GT!J%&%'%$%H$J$7!K(B
                $self->_warn(qq{TIEHASH : lock blocked. "$lock"});
        }else{
                # $B%m%C%/<:GT!J%&%'%$%H!K(B
                my $trytime     = $self->{-trytime};
                TRY:foreach(my $try = 0;$try < $trytime;++$try){

                        # $B%m%C%/%U%!%$%k$rC5$9(B
                        opendir(DIR,"$dbname/..")
                                                                or $self->_die(qq{TIEHASH : $! "$dbname/.."});
                        my @nglock      = readdir DIR;
                        closedir DIR;

                        my($nglock,$duration);
                        foreach(@nglock){
                        #       if(m/^\Q$dbname\E\.(\d*)\.(\d*)\.lock\Q$self->{-extension}\E$/){
                        #               $nglock         = qq($dbname.$1.$2.lock$self->{-extension});
                        #               $duration       = time - $2     if $2;
                        #               last;
                        #       }
                          if ($self->_match_lock_file_name ($_,
                                prefix => $dbname,
                                suffix => $self->{-extension})) {
                            #$nglock = $self->_get_lock_file_name (
                            #  prefix => $dbname,
                            #  suffix => $self->{-extension});
                            $nglock = $_;
                            $duration = time - $2;
                            last;
                          }
                        }

                        # $B%m%C%/%U%!%$%k$,8+$D$+$i$J$$(B?
                        if(not defined $nglock){
                                ## Maybe it is the first time to use this DB
                                open NEWLOCK, ">", $lock or $self->_die(qq{TIEHASH : lockfile not found. "$lock"});
                                close NEWLOCK;
                                return TIEHASH (@_);
                        }

                        # $B4{B8%m%C%/$r99?7$7$F%m%C%/(B
                        if($self->{-timeout} < $duration){
                                # $B0[>o$J%m%C%/(B
                                $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{
                                # $B@5>o$J%m%C%/(B
                                last TRY        if $self->_lock($mode,$nglock);
                        }

                        # $B%&%'%$%H(B
                        $self->_warn(qq{TIEHASH : retry lock ($try/$trytime). "$nglock"});
                        sleep 1;
                }
        }

        if(not $self->{-lock}){
                # $B%m%C%/<:GT(B
                $self->_warn(qq{TIEHASH : lock failure. "$lock"});
                return;
        }else{
                return $self;
        }
}


#
# UNTIE
# $B%9%/%j%W%H$r=*N;$;$:$K%G!<%?%Y!<%9$rJD$8$k>l9g$O(B
# untie %db; $B$J$I$H$9$k!#(B
# UNTIE $B$O(B untie $B$7K:$l$k$H8F$P$l$J$$!J%m%C%/$,2r=|$5$l$J(B
# $B$$!K$N$G!"%*%V%8%'%/%H$N%G%9%H%i%/%?$+$i$b<+F0E*$K8F$S=P$5(B
# $B$l$k$h$&$K$7$?!#(B
#
sub UNTIE{
        my($self) = @_;
        my $mode        = $self->{-mode};
        my $lock        = $self->{-lock};

        if(!$mode or $self->_unlock($lock)){
                # $B%"%s%m%C%/@.8y!J$?$$$F$$!"$3$3$G40N;$9$k!K(B
                ;;;
        }else{
                # $B%"%s%m%C%/<:GT!"%m%C%/%U%!%$%k$rC5$9!J6&M-%m%C%/;~!K(B
                chop(my $dbname = $self->{-dir});
                my $trytime     = $self->{-trytime};
                TRY:foreach(my $try = 0;$try < $trytime;++$try){
                        opendir(DIR,"$dbname/..")       or $self->_die(qq{UNTIE : $! "$dbname/.."});
                        my @nglock      = readdir DIR;
                        closedir DIR;

                        my($nglock,$duration);
                        foreach(@nglock){
                                #if(m/^\Q$dbname\E\.(\d*)\.(\d*)\.lock\.\Q$self->{-extension}\E$/){
                                #       $nglock         = qq($dbname.$1.$2.lock$self->{-extension});
                                #       $duration       = time - $2     if $2;
                                #       last;
                                #}
                          if ($self->_match_lock_file_name ($_,
                                prefix => $dbname,
                                suffix => $self->{-extension})) {
                            $nglock = $_;
                            $duration = time - $2;
                            last;
                          }
                        }
                        last TRY if $self->_unlock($nglock);
                        
                        #if($nglock eq "$dbname...lock$self->{-extension}"){
                        if ($nglock eq $self->_get_lock_file_name (prefix => $dbname, seq => 0, time => 0, prefix => $self->{-extension})) {
                                # $B$"$j$($J$$$O$:$@$,!"$J$<$+$H$-$I$-$/$k!#(B
                                $self->_warn(qq{UNTIE : not locked. "$nglock"});
                                last TRY;
                        }

                        # $B%&%'%$%H(B(sleep $B$J$7(B)
                        $self->_warn(qq{UNTIE : retry unlock ($try/@{[$trytime-1]}). "$nglock"});
                }
                
                if($self->{-lock} eq $lock){
                        $self->_warn(qq{UNTIE : unlock failure. "$lock"});
                }
        }
        return;
}


#
# $B%G%9%H%i%/%?(B
#
# DESTROY $B$O(B untie $B$7K:$l$F$b8F$P$l$k!#(B
# new $B$^$?$O(B tie $B$N%9%3!<%W$N30$K=P$?$H$-!J(Bperl $B=*N;;~$H$+!K(B
# $B$K8F$P$l$k$+!"$"$k$$$OLa$jCM$r;H$C$F$$$k>l9g!"%*%V%8%'%/%H(B
# $B$,;2>H$5$l$J$/$J$C$?$H$-!"$^$?$OL@<(E*$K(B untie $B$KB3$1$F(B undef
# $B$7$?$H$-$K8F$P$l$k!#$H$K$+$/!"$$$D$+$OI,$:8F$P$l$k$_$?$$$@!#(B 
#
sub DESTROY{
        my($self) = @_;
        if($self->{-mode}){
                # untie $BK:$l$N?,?!$$(B
                $self->_warn(qq{DESTROY : invoke untie method.}) if 0;
                $self->UNTIE();
        }
        return;
}


#
# $B=q$-9~$_(B
#
sub STORE{
        my($self,$key,$val)     = @_;
        my $mode        = $self->{-mode};
        $self->_die(qq{STORE : method not allowd, mode="$mode"})        if $mode == 1;
        my $file        = $self->filename($key);
        my $temp        = "$file.".time;
        my $bkup        = $self->bkupname($key);
        $self->dig_directory ($file);
        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;
        delete $self->{-headline}->{$key};
        return $val;
}


#
# $BFI$_=P$7(B
#
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;
        }
}


#
# $B:o=|(B
#
sub DELETE{
        my($self,$key) = @_;
        my $file        = $self->filename($key);
        my $bkup        = $self->bkupname($key);
        my $mode        = $self->{-mode};
        $self->_die(qq{DELETE : method not allowd, mode="$mode"})       if $mode == 1;
        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}->{-key} = undef;
        $self->{-cache}->{-val} = undef;
        delete $self->{-headline}->{$key};
        return;
}


#
# $BB8:_%A%'%C%/(B
#
sub EXISTS{
        my($self,$key) = @_;
        my $file        = $self->filename($key);
        return -e $file;
}


#
# $B%$%F%l!<%?(B
#
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;
}


#
# $B%O%C%7%eA4BN$N:o=|(B
#
# $B%U%)%k%@$NCf?H$r6u$K$9$k!J6u%O%C%7%e$K$9$k!K$@$1$G!"%G%#%l(B
# $B%/%H%j$d%m%C%/%U%!%$%k!"%"!<%+%$%V$O;D$9!J;EMM!*!K!#(B
#
sub CLEAR{
        my($self)       = @_;
        my $mode        = $self->{-mode};
        $self->_die(qq{CLEAR : method not allowd, mode="$mode"})        if $mode == 1;
        my $dbname      = $self->{-dir};
        my @key         = $self->_list_all();
        foreach(@key){
                my $file        = $dbname.$_.$self->{-extension};
                unlink $file                    or $self->_die(qq{CLEAR : $! "$file".});
        }
        if(0){
                my $file        = $self->{-logfile};
                if(-e $file){
                        unlink $file            or $self->_die(qq{CLEAR : $! "$file".});
                }
        }
        if(0){
                my $lock        = $self->{-lock};
                rmdir $dbname                           or $self->_die(qq{CLEAR : $! "$dbname".});
                unlink $lock                    or $self->_die(qq{CLEAR : $! "$lock".});
                $self->{-mode}  = 0;
        }
        $self->{-cache}->{-key} = undef;
        $self->{-cache}->{-val} = undef;
        $self->{-headline}              = {};
        return;
}


#
# $B;XDj$7$?%-!<$N%G!<%?%5%$%:$r(B [byte] $B$GJV$7$^$9!#(B
# $B%-!<$r;XDj$7$J$$$H!"A4$F$N%G!<%?$N9g7W%5%$%:$rJV$7$^$9(B
# $B!J$?$@$7%P%C%/%"%C%WMQ$N%G!<%?$d!"(B-extension $B$G3HD%;R$r(B
# $BJQ$($?%G!<%?$O7W>e$7$^$;$s!K!#(B
#
sub size{
        my $self        = shift                         or die qq(size : usage error.);
        my $dbname              = $self->{-dir};
        my @key         = @_;
        if(not @key){
                @key    = $self->_list_all();
        }else{
                foreach(@key){
                        &{$self->{-encode}}($_);
                }
        }
        my $size;
        foreach(@key){
                $size   += -s $dbname.$_.$self->{-extension};
        }
        return $size;
}


#
# $B$$$o$f$k(B ListAll
#
sub list_all{
        my $self        = shift                         or die qq(list_all : usage error.);
        my @key         = $self->_list_all();
        foreach(@key){
                &{$self->{-decode}}($_);
        }
        return @key;
}

# $self->_list_all
# - Returns all items (including NS'ed items) in encoded (file system) form

sub _list_all ($) {
  my $self = shift or die q(_list_all: $self is not specified);
  $self->_list_all_NS ('');
}

sub _list_all_NS ($$) {
  my ($self, $NS) = @_;
  my @items = $self->_list_items_by_suffix_NS ($NS, $self->{-extension});
  for my $ns ($self->_list_nss_by_suffix_NS ($NS, '.ns')) {
    push @items, $self->_list_all_NS ($ns.'.ns/', $self->{-extension});
  }
  @items;
}

sub _list_nss_NS ($$) {
  my ($self, $NS) = @_;
  my @items;
  for my $ns ($self->_list_nss_by_suffix_NS ($NS, '.ns')) {
    push @items, $self->_list_nss_NS ($ns.'.ns/', $self->{-extension});
  }
  @items;
}

# $self->_list_items_by_suffix_NS ($encoded_ns, $suffix)
# - Returns all items within the NS that have given suffix, in encoded (file system) form

sub _list_items_by_suffix_NS ($$$) {
  my ($self, $ns, $suffix) = @_;
  my $dbname    = $self->{-dir} . $ns;
  opendir(DIR,$dbname)  or return ();
    my @key     = grep(-f $dbname.$_,readdir DIR);
  closedir DIR;
  @key = grep {s/\Q$suffix\E$//} @key if length $suffix;
  return map {$ns.$_} @key;
}
sub _list_nss_by_suffix_NS ($$$) {
  my ($self, $ns, $suffix) = @_;
  my $dbname    = $self->{-dir} . $ns;
  opendir(DIR,$dbname)  or return ();
    my @key     = grep(-d $dbname.$_,readdir DIR);
  closedir DIR;
  @key = grep {s/\Q$suffix\E$//} @key if length $suffix;
  return map {$ns.$_} @key;
}

sub list_items ($$) {
  my ($self, $option) = @_;
  $option->{ns} = &{$self->{-encode}} ($option->{ns});
  my @items;
  if ($option->{type} ne 'key') {       # ns or both
    $option->{recursive} = 1 unless defined $option->{recursive};
    if ($option->{recursive}) {
      push @items, map {&{$self->{-decode}} ($_).'//'} $self->_list_nss_NS ($option->{ns}, '.ns');
    } else {
      push @items, map {&{$self->{-decode}} ($_).'//'} $self->_list_nss_by_suffix_NS ($option->{ns}, '.ns');
    }
  }
  if ($option->{type} ne 'ns') {        # key or both
    push @items, map {&{$self->{-decode}} ($_)} $self->_list_items ($option);
  }
  @items;
}
sub _list_items ($$) {
  my ($self, $option) = @_;
  #$option->{ns} = &{$self->{-encode}} ($option->{ns});
  my @items;
  #if ($option{type} ne 'ns') { # key or both
    $option->{recursive} = 1 unless defined $option->{recursive};
    if ($option->{recursive}) {
      push @items, $self->_list_all_NS ($option->{ns}, '.ns');
    } else {
      push @items, $self->_list_items_by_suffix_NS ($option->{ns}, $self->{-extension});
    }
  #}
  (@items);
}

#
# $B%-!<$NL>A0$rJQ$($k(B
# $B@.8y$7$?$i(B 1 $B$rJV$9!#(B
#
sub rename{
        my $self                = shift                         or die qq(rename : usage error.);
        my($from,$to)   = @_;
        my $mode        = $self->{-mode};
        $self->_die(qq{rename : method not allowd, mode="$mode"})       if $mode == 1;
        if(rename($self->filename($from) => $self->filename($to))){
                if($self->{-cache}->{-key} eq $from
                or $self->{-cache}->{-key} eq $to){
                        $self->{-cache}->{-key} = undef;
                        $self->{-cache}->{-val} = undef;
                }
                delete $self->{-headline}->{$from};
                delete $self->{-headline}->{$to};
                return 1;
        }else{
                $self->_warn(qq{rename : $! "$from" => "$to"});
                return 0;
        }
}


#
# $B%-!<$N%j%9%H$r!"99?7F|=g$KJB$Y$FJV$9!J:G6a$N$b$N$,@hF,!K!#(B
#
sub sort_by_mtime{
        my ($self, $option) = (shift, shift||{});
        my $dbname              = $self->{-dir};
        my @key         = @_;
        if(not @key){
                @key    = $self->_list_items ({%$option, type => 'key'});
        }else{
                foreach(@key){
                        &{$self->{-encode}}($_);
                }
        }
        return map(&{$self->{-decode}}($_->[1]),
                                sort({$a->[0] <=> $b->[0] or $a->[1] cmp $b->[1]}
                                        map([-M $dbname.$_.$self->{-extension},$_],@key)));
}


#
# $B%-!<$N%j%9%H$r!"%G!<%?%5%$%:=g$KJB$Y$FJV$9!J>.$5$$$b$N$,@hF,!K!#(B
#
sub sort_by_size{
        my ($self, $option)     = (shift, shift||{});
        my $dbname              = $self->{-dir};
        my @key         = @_;
        if(not @key){
                @key    = $self->_list_items ({%$option, type => 'key'});
        }else{
                foreach(@key){
                        &{$self->{-encode}}($_);
                }
        }
        return map(&{$self->{-decode}}($_->[1]),
                                sort({$a->[0] <=> $b->[0] or $a->[1] cmp $b->[1]}
                                        map([-s $dbname.$_.$self->{-extension},$_],@key)));
}


#
# $BK\BN$N$J$$%P%C%/%"%C%W%U%!%$%k$N:o=|(B
#
sub clean{
        my $self        = shift                         or die qq(clean : usage error.);
        my $mode        = $self->{-mode};
        $self->_die(qq{clean : method not allowd, mode="$mode"})        if $mode == 1;
        my $dbname              = $self->{-dir};
        my @key         = @_;
        if(not @key){
                @key    = $self->_list_all();
        }else{
                foreach(@key){
                        &{$self->{-encode}}($_);
                        
                }
        }
        my $err;
        foreach(@key){
                if(-e $dbname.$_.".bak"){
                        unlink $dbname.$_.".bak"        || ++$err;
                }
        }
        return $err;
}


#
# $B%G!<%?$r%"!<%+%$%V$9$k!#(B
# $B@.8y$9$k$H%"!<%+%$%V$N%5%$%:(B [byte] $B$rJV$7$^$9!#(B
# $B<:GT$9$k$H(B undef $B$rJV$7$^$9!#(B
#
sub archive{
        my $self        = shift                         or die qq(archive : usage error.);
        my $mode        = $self->{-mode};
        $self->_die(qq{archive : method not allowd, mode="$mode"})      if $mode == 1;
        my(@key)        = @_;
        my $dir = $self->{-dir};
        (my $archive    = $dir) =~ s/\/$/.zip/;
        eval <<'        ###__CODE__###';
        use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
        use Archive::Zip::Tree;
        my $zip = Archive::Zip->new();
        if(@key){
                foreach(@key){
                        my $member      = $zip->addFile($self->filename($_),$dir.$_);
                        $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
                        $member->desiredCompressionLevel(COMPRESSION_LEVEL_BEST_COMPRESSION);
                }
        }else{
                $zip->addTreeMatching($dir,$dir,$self->{-extension}.'$');
                foreach my $member ($zip->members()){
                        $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
                        $member->desiredCompressionLevel(COMPRESSION_LEVEL_BEST_COMPRESSION);
                }
        }
        $zip->zipfileComment(
                "created by Yuki::YukiWikiDBNS $Yuki::YukiWikiDBNS::VERSION"
                ." with Archive::Zip $Archive::Zip::VERSION");
        die(qq{write error "$archive"})
                if $zip->writeToFileNamed("$archive") != AZ_OK;
        ###__CODE__###
        if($@){
                $self->_warn(qq{archive : $@});
                return undef;
        }else{
                return -s "$archive";
        }
}


#
# $B$$$o$f$k(B RecentChanges(WhatsNew)
# $db->recent_changes() - sort_by_mtime() $B$HF1$8$GA4$F$N%-!<$rJV$9!#(B
# $db->recent_changes(+n) - $B:G?7$N(B n $B7o$rJV$9!#(B
# $db->recent_changes(-n) - $B:G8E$N(B n $B7o$rJV$9!#(B
#
sub recent_changes{
        my $self        = shift                         or die qq(recent_changes : usage error.);
        my($n,$m,$option)       = @_;
        my @key         = $self->sort_by_mtime($option);
        if($m){
                return @key[$n..$m];
        }elsif($n == 0){
                return @key;
        }elsif($n < 0){
                $n              = -$n - 1;
                @key    = reverse @key;
        }else{
                --$n;
        }
        return @key[0..$n];
}


#
# $B%P%C%/%"%C%W%U%i%0$N0l;~%;%C%H(B
#
# $B%;%C%H$9$k$H<!$N%G!<%?99?7;~$K%P%C%/%"%C%W$r$H$k!#(B
# $B%P%C%/%"%C%W$r$H$C$?$i%U%i%0$O%j%;%C%H$5$l$k!#(B
#
# ex. $DB->bkup_next(1);        # $B<!2s%P%C%/%"%C%W$r$H$k!#(B
# ex. $DB->bkup_next(0);        # $B<!2s%P%C%/%"%C%W$r$H$i$J$$!#(B
#
sub bkup_next{
        my $self        = shift                         or die qq(bkup_next : usage error.);
        my($flag) = @_;
        return defined $flag ?
                        ($self->{-bkup_next} = $flag) :
                        $self->{-bkup_next};
#       $self->{-bkup_next}     = $flag || 1
}


#
# $B8=:_$N%G!<%?$H%P%C%/%"%C%W%G!<%?$H$N4V$N:9J,$r5a$a$k!#(B
# ex. $diff = $DB->diff('foo');
# ex. @diff = $DB->diff('foo');
#
sub diff{
        my $self        = shift                         or die qq(diff : usage error.);
        my($key) = @_;
        my $diff;
        eval <<'        ###__CODE__###';
        use Algorithm::Diff;
        my $file        = $self->filename($key);
        my $bkup        = $self->bkupname($key);
        my(@old,@new);
        local $/        = undef;

        if(-e $bkup){
                open(FILE,$bkup)                or die(qq{$! "$bkup"});
                binmode FILE;
                @old    = split(m/[\x0D\x0A\x00]+/,<FILE>);
                close FILE;
        }
        if(-e $file){
                open(FILE,$file)                or die(qq{$! "$file"});
                binmode FILE;
                @new    = split(m/[\x0D\x0A\x00]+/,<FILE>);
                close FILE;
        }

        foreach(Algorithm::Diff::diff(\@old,\@new)){
                foreach(@{$_}){
                        my($sign,$lineno,$text) = @{$_};
                        $diff   .= qq($sign$text\n);
                }
                $diff   .= "\n";
        }
        $diff   =~ s/\n+$/\n/;
        return $diff;
        ###__CODE__###
        if($@){
                $self->_warn(qq{diff : $@});
                return undef;
        }else{
                return $diff;
        }
}
sub traverse_diff{
        my $self        = shift                         or die qq(traverse_diff : usage error.);
        my($key) = @_;
        my $diff;
        eval <<'        ###__CODE__###';
        # http://www.stonehenge.com/merlyn/UnixReview/col35.html
        use Algorithm::Diff;
        my $file        = $self->filename($key);
        my $bkup        = $self->bkupname($key);
        my(@old,@new);
        local $/        = undef;

        if(-e $bkup){
                open(FILE,$bkup)        or die(qq{$! "$bkup"});
                binmode FILE;
                @old    = split(m/[\x0D\x0A\x00]+/,<FILE>);
                close FILE;
        }
        if(-e $file){
                open(FILE,$file)        or die(qq{$! "$file"});
                binmode FILE;
                @new    = split(m/[\x0D\x0A\x00]+/,<FILE>);
                close FILE;
        }

        Algorithm::Diff::traverse_sequences(\@old,\@new,{
                MATCH           => sub{ $diff .= qq/=$new[$_[1]]\n/     },
                DISCARD_A       => sub{ $diff .= qq/-$old[$_[0]]\n/     },
                DISCARD_B       => sub{ $diff .= qq/+$new[$_[1]]\n/     },
        });
        return $diff;
        ###__CODE__###
        if($@){
                $self->_warn(qq{traverse_diff : $@});
                return undef;
        }else{
                return $diff;
        }
}


#
# $B%G!<%?$N:G=*99?7F|;~$r(B localtime $B$G5a$a$k!#(B
#
sub stat{
        my $self        = shift                         or die qq(stat : usage error.);
        my($key) = @_;
        my $file        = $self->filename($key);
        return CORE::stat($file);
}
sub mtime{
        my $self        = shift                         or die qq(mtime : usage error.);
        my($key) = @_;
        my $file        = $self->filename($key);
        return ( (CORE::stat($file))[9] );
}
sub localtime{
        my $self        = shift                         or die qq(localtime : usage error.);
        my($key) = @_;
        my $file        = $self->filename($key);
        return localtime( (CORE::stat($file))[9] );
}


#
# $B>pJs$NFI$_=P$7(B
#
sub info{
        my $self        = shift                         or die qq(info : usage error.);
        my $info;
        $info   .= qq(Yuki::YukiWikiDBNS\t: $Yuki::YukiWikiDBNS::VERSION\n);
        $info   .= qq(Algorithm::Diff\t: )
                        .eval('use Algorithm::Diff; $Algorithm::Diff::VERSION')."\n";
        $info   .= qq(Archive::Zip\t: )
                        .eval('use Archive::Zip; $Archive::Zip::VERSION')."\n";
        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;
}


#
# $B%X%C%I%i%$%sFI$_=P$7(B
# $B:G=i$N9T$rJV$7$^$9!#9TKv$N2~9T$O(B chomp $B$5$l$^$9!#(B
#
sub headline{
        my $self        = shift                         or die qq(headline : usage error.);
        my($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__