[Summary view] [Print] [Text view]

   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;