lib/Memoize/ExpireFile.pm

   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;