b374k
m1n1 1.01
Apache/2.2.15 (CentOS)
Linux obd60-6c49958d75-2q7cw 5.4.0-174-generic #193-Ubuntu SMP Thu Mar 7 14:29:28 UTC 2024 x86_64
uid=48(apache) gid=48(apache) groups=48(apache)
server ip : 172.67.192.52 | your ip : 10.244.126.0
safemode OFF
 >  / usr / share / perl5 / Memoize /
Filename/usr/share/perl5/Memoize/ExpireFile.pm
Size1.02 kb
Permissionrw-r--r--
Ownerapache
Create time23-Dec-2025 17:41
Last modified22-Mar-2017 16:32
Last accessed22-Apr-2026 00:47
Actionsedit | rename | delete | download (gzip)
Viewtext | code | image
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;