This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Fix warning category and subcategory conflicts
[perl5.git] / cpan / Memoize / Memoize / ExpireFile.pm
CommitLineData
a0cb3900 1package Memoize::ExpireFile;
9038e305
JH
2
3=head1 NAME
4
5Memoize::ExpireFile - test for Memoize expiration semantics
6
7=head1 DESCRIPTION
8
9See L<Memoize::Expire>.
10
11=cut
12
8114efa0 13$VERSION = '1.03';
a0cb3900
JH
14use Carp;
15
899dc88a
JH
16my $Zero = pack("N", 0);
17
a0cb3900
JH
18sub TIEHASH {
19 my ($package, %args) = @_;
899dc88a
JH
20 my $cache = $args{HASH} || {};
21 bless {ARGS => \%args, C => $cache} => $package;
a0cb3900
JH
22}
23
24
25sub STORE {
484fdf61 26# print "Expiry manager STORE handler\n";
a0cb3900
JH
27 my ($self, $key, $data) = @_;
28 my $cache = $self->{C};
29 my $cur_date = pack("N", (stat($key))[9]);
30 $cache->{"C$key"} = $data;
31 $cache->{"T$key"} = $cur_date;
32}
33
34sub FETCH {
35 my ($self, $key) = @_;
36 $self->{C}{"C$key"};
37}
38
39sub EXISTS {
484fdf61 40# print "Expiry manager EXISTS handler\n";
a0cb3900 41 my ($self, $key) = @_;
484fdf61
JH
42 my $cache_date = $self->{C}{"T$key"} || $Zero;
43 my $file_date = pack("N", (stat($key))[9]);#
899dc88a
JH
44# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
45# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
46# }
484fdf61
JH
47 my $res = $cache_date ge $file_date;
48# print $res ? "... still good\n" : "... expired\n";
49 $res;
a0cb3900
JH
50}
51
521;