1*0Sstevel@tonic-gatepackage Memoize::ExpireFile;
2*0Sstevel@tonic-gate
3*0Sstevel@tonic-gate=head1 NAME
4*0Sstevel@tonic-gate
5*0Sstevel@tonic-gateMemoize::ExpireFile - test for Memoize expiration semantics
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gate=head1 DESCRIPTION
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gateSee L<Memoize::Expire>.
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gate=cut
12*0Sstevel@tonic-gate
13*0Sstevel@tonic-gate$VERSION = 1.01;
14*0Sstevel@tonic-gateuse Carp;
15*0Sstevel@tonic-gate
16*0Sstevel@tonic-gatemy $Zero = pack("N", 0);
17*0Sstevel@tonic-gate
18*0Sstevel@tonic-gatesub TIEHASH {
19*0Sstevel@tonic-gate  my ($package, %args) = @_;
20*0Sstevel@tonic-gate  my $cache = $args{HASH} || {};
21*0Sstevel@tonic-gate  bless {ARGS => \%args, C => $cache} => $package;
22*0Sstevel@tonic-gate}
23*0Sstevel@tonic-gate
24*0Sstevel@tonic-gate
25*0Sstevel@tonic-gatesub STORE {
26*0Sstevel@tonic-gate#  print "Expiry manager STORE handler\n";
27*0Sstevel@tonic-gate  my ($self, $key, $data) = @_;
28*0Sstevel@tonic-gate  my $cache = $self->{C};
29*0Sstevel@tonic-gate  my $cur_date = pack("N", (stat($key))[9]);
30*0Sstevel@tonic-gate  $cache->{"C$key"} = $data;
31*0Sstevel@tonic-gate  $cache->{"T$key"} = $cur_date;
32*0Sstevel@tonic-gate}
33*0Sstevel@tonic-gate
34*0Sstevel@tonic-gatesub FETCH {
35*0Sstevel@tonic-gate  my ($self, $key) = @_;
36*0Sstevel@tonic-gate  $self->{C}{"C$key"};
37*0Sstevel@tonic-gate}
38*0Sstevel@tonic-gate
39*0Sstevel@tonic-gatesub EXISTS {
40*0Sstevel@tonic-gate#  print "Expiry manager EXISTS handler\n";
41*0Sstevel@tonic-gate  my ($self, $key) = @_;
42*0Sstevel@tonic-gate  my $cache_date = $self->{C}{"T$key"} || $Zero;
43*0Sstevel@tonic-gate  my $file_date = pack("N", (stat($key))[9]);#
44*0Sstevel@tonic-gate#  if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
45*0Sstevel@tonic-gate#    return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
46*0Sstevel@tonic-gate#  }
47*0Sstevel@tonic-gate  my $res = $cache_date ge $file_date;
48*0Sstevel@tonic-gate#  print $res ? "... still good\n" : "... expired\n";
49*0Sstevel@tonic-gate  $res;
50*0Sstevel@tonic-gate}
51*0Sstevel@tonic-gate
52*0Sstevel@tonic-gate1;
53