Commit | Line | Data |
---|---|---|
a0cb3900 | 1 | package Memoize::ExpireFile; |
9038e305 JH |
2 | |
3 | =head1 NAME | |
4 | ||
5 | Memoize::ExpireFile - test for Memoize expiration semantics | |
6 | ||
7 | =head1 DESCRIPTION | |
8 | ||
9 | See L<Memoize::Expire>. | |
10 | ||
11 | =cut | |
12 | ||
8114efa0 | 13 | $VERSION = '1.03'; |
a0cb3900 JH |
14 | use Carp; |
15 | ||
899dc88a JH |
16 | my $Zero = pack("N", 0); |
17 | ||
a0cb3900 JH |
18 | sub TIEHASH { |
19 | my ($package, %args) = @_; | |
899dc88a JH |
20 | my $cache = $args{HASH} || {}; |
21 | bless {ARGS => \%args, C => $cache} => $package; | |
a0cb3900 JH |
22 | } |
23 | ||
24 | ||
25 | sub 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 | ||
34 | sub FETCH { | |
35 | my ($self, $key) = @_; | |
36 | $self->{C}{"C$key"}; | |
37 | } | |
38 | ||
39 | sub 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 | ||
52 | 1; |