lib/Memoize/ExpireFile.pm

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