diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm b/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm new file mode 100755 index 00000000000..e52c09a3bf3 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm @@ -0,0 +1,52 @@ +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; |