Server IP : 49.212.180.16 / Your IP : 3.137.208.89 Web Server : Apache System : FreeBSD www2606.sakura.ne.jp 13.0-RELEASE-p14 FreeBSD 13.0-RELEASE-p14 #2: Mon Dec 9 13:54:55 JST 2024 root@www5301.sakura.ne.jp:/usr/obj/usr/src/amd64.amd64/sys/GENERIC amd64 User : utannto ( 1076) PHP Version : 7.4.33 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : OFF | Perl : ON | Python : OFF | Sudo : OFF | Pkexec : OFF Directory : /home/rs/perl/5.10/lib/perl5/5.10/Memoize/ |
Upload File : |
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;