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 | ||
899dc88a | 13 | $VERSION = 0.65; |
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 { | |
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 JH |
42 | # if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { |
43 | # return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); | |
44 | # } | |
a0cb3900 JH |
45 | return $old_date ge $cur_date; |
46 | } | |
47 | ||
48 | 1; |