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 use Carp;
  14
  15 sub TIEHASH {
  16   my ($package, %args) = @_;
  17   my %cache;
  18   if ($args{TIE}) {
  19     my ($module, @opts) = @{$args{TIE}};
  20     my $modulefile = $module . '.pm';
  21     $modulefile =~ s{::}{/}g;
  22     eval { require $modulefile };
  23     if ($@) {
  24       croak "Memoize::ExpireFile: Couldn't load hash tie module `$module': $@; aborting";
  25     }
  26     my $rc = (tie %cache => $module, @opts);
  27     unless ($rc) {
  28       croak "Memoize::ExpireFile: Couldn't tie hash to `$module': $@; aborting";
  29     }
  30   }
  31   bless {ARGS => \%args, C => \%cache} => $package;
  32 }
  33
  34
  35 sub STORE {
  36   my ($self, $key, $data) = @_;
  37   my $cache = $self->{C};
  38   my $cur_date = pack("N", (stat($key))[9]);
  39   $cache->{"C$key"} = $data;
  40   $cache->{"T$key"} = $cur_date;
  41 }
  42
  43 sub FETCH {
  44   my ($self, $key) = @_;
  45   $self->{C}{"C$key"};
  46 }
  47
  48 sub EXISTS {
  49   my ($self, $key) = @_;
  50   my $old_date = $self->{C}{"T$key"} || "0";
  51   my $cur_date = pack("N", (stat($key))[9]);
  52   if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
  53     return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
  54   }
  55   return $old_date ge $cur_date;
  56 }
  57
  58 1;