Commit | Line | Data |
a0cb3900 |
1 | |
2 | package Memoize::ExpireFile; |
3 | use Carp; |
4 | |
5 | sub TIEHASH { |
6 | my ($package, %args) = @_; |
7 | my %cache; |
8 | if ($args{TIE}) { |
9 | my ($module, @opts) = @{$args{TIE}}; |
10 | my $modulefile = $module . '.pm'; |
11 | $modulefile =~ s{::}{/}g; |
12 | eval { require $modulefile }; |
13 | if ($@) { |
14 | croak "Memoize::ExpireFile: Couldn't load hash tie module `$module': $@; aborting"; |
15 | } |
16 | my $rc = (tie %cache => $module, @opts); |
17 | unless ($rc) { |
18 | croak "Memoize::ExpireFile: Couldn't tie hash to `$module': $@; aborting"; |
19 | } |
20 | } |
21 | bless {ARGS => \%args, C => \%cache} => $package; |
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) = @_; |
40 | my $old_date = $self->{C}{"T$key"} || "0"; |
41 | my $cur_date = pack("N", (stat($key))[9]); |
42 | if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { |
43 | return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); |
44 | } |
45 | return $old_date ge $cur_date; |
46 | } |
47 | |
48 | 1; |