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