"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Memoize/ExpireFile.pm" (23 Apr 2014, 1050 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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.03';
   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;