home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _cf3eec72b7b45f2012075c71728b549b < prev    next >
Text File  |  2004-06-01  |  1KB  |  53 lines
  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;
  53.