Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package Memoize::ExpireFile; |
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 | ||
13 | $VERSION = 1.01; | |
14 | use Carp; | |
15 | ||
16 | my $Zero = pack("N", 0); | |
17 | ||
18 | sub TIEHASH { | |
19 | my ($package, %args) = @_; | |
20 | my $cache = $args{HASH} || {}; | |
21 | bless {ARGS => \%args, C => $cache} => $package; | |
22 | } | |
23 | ||
24 | ||
25 | sub STORE { | |
26 | # print "Expiry manager STORE handler\n"; | |
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 { | |
40 | # print "Expiry manager EXISTS handler\n"; | |
41 | my ($self, $key) = @_; | |
42 | my $cache_date = $self->{C}{"T$key"} || $Zero; | |
43 | my $file_date = pack("N", (stat($key))[9]);# | |
44 | # if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { | |
45 | # return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); | |
46 | # } | |
47 | my $res = $cache_date ge $file_date; | |
48 | # print $res ? "... still good\n" : "... expired\n"; | |
49 | $res; | |
50 | } | |
51 | ||
52 | 1; |