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 = 0.65;
  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   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"} || $Zero;
  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;