Current Path : /usr/local/lib/perl5/5.8.9/Memoize/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/5.8.9/Memoize/ExpireFile.pm |
package Memoize::ExpireFile; =head1 NAME Memoize::ExpireFile - test for Memoize expiration semantics =head1 DESCRIPTION See L<Memoize::Expire>. =cut $VERSION = 1.01; use Carp; my $Zero = pack("N", 0); sub TIEHASH { my ($package, %args) = @_; my $cache = $args{HASH} || {}; bless {ARGS => \%args, C => $cache} => $package; } sub STORE { # print "Expiry manager STORE handler\n"; my ($self, $key, $data) = @_; my $cache = $self->{C}; my $cur_date = pack("N", (stat($key))[9]); $cache->{"C$key"} = $data; $cache->{"T$key"} = $cur_date; } sub FETCH { my ($self, $key) = @_; $self->{C}{"C$key"}; } sub EXISTS { # print "Expiry manager EXISTS handler\n"; my ($self, $key) = @_; my $cache_date = $self->{C}{"T$key"} || $Zero; my $file_date = pack("N", (stat($key))[9]);# # if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { # return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); # } my $res = $cache_date ge $file_date; # print $res ? "... still good\n" : "... expired\n"; $res; } 1;