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 | |
a0cb3900 |
13 | use Carp; |
14 | |
15 | sub TIEHASH { |
16 | my ($package, %args) = @_; |
17 | my %cache; |
18 | if ($args{TIE}) { |
19 | my ($module, @opts) = @{$args{TIE}}; |
20 | my $modulefile = $module . '.pm'; |
21 | $modulefile =~ s{::}{/}g; |
22 | eval { require $modulefile }; |
23 | if ($@) { |
24 | croak "Memoize::ExpireFile: Couldn't load hash tie module `$module': $@; aborting"; |
25 | } |
26 | my $rc = (tie %cache => $module, @opts); |
27 | unless ($rc) { |
28 | croak "Memoize::ExpireFile: Couldn't tie hash to `$module': $@; aborting"; |
29 | } |
30 | } |
31 | bless {ARGS => \%args, C => \%cache} => $package; |
32 | } |
33 | |
34 | |
35 | sub STORE { |
36 | my ($self, $key, $data) = @_; |
37 | my $cache = $self->{C}; |
38 | my $cur_date = pack("N", (stat($key))[9]); |
39 | $cache->{"C$key"} = $data; |
40 | $cache->{"T$key"} = $cur_date; |
41 | } |
42 | |
43 | sub FETCH { |
44 | my ($self, $key) = @_; |
45 | $self->{C}{"C$key"}; |
46 | } |
47 | |
48 | sub EXISTS { |
49 | my ($self, $key) = @_; |
50 | my $old_date = $self->{C}{"T$key"} || "0"; |
51 | my $cur_date = pack("N", (stat($key))[9]); |
52 | if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { |
53 | return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); |
54 | } |
55 | return $old_date ge $cur_date; |
56 | } |
57 | |
58 | 1; |