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