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 | |
899dc88a |
13 | $VERSION = 0.65; |
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 { |
26 | my ($self, $key, $data) = @_; |
27 | my $cache = $self->{C}; |
28 | my $cur_date = pack("N", (stat($key))[9]); |
29 | $cache->{"C$key"} = $data; |
30 | $cache->{"T$key"} = $cur_date; |
31 | } |
32 | |
33 | sub FETCH { |
34 | my ($self, $key) = @_; |
35 | $self->{C}{"C$key"}; |
36 | } |
37 | |
38 | sub EXISTS { |
39 | my ($self, $key) = @_; |
899dc88a |
40 | my $old_date = $self->{C}{"T$key"} || $Zero; |
a0cb3900 |
41 | my $cur_date = pack("N", (stat($key))[9]); |
899dc88a |
42 | # if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { |
43 | # return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); |
44 | # } |
a0cb3900 |
45 | return $old_date ge $cur_date; |
46 | } |
47 | |
48 | 1; |