summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm')
-rwxr-xr-xMaster/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm52
1 files changed, 52 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm b/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm
new file mode 100755
index 00000000000..e52c09a3bf3
--- /dev/null
+++ b/Master/tlpkg/tlperl.straw/lib/Memoize/ExpireFile.pm
@@ -0,0 +1,52 @@
+package Memoize::ExpireFile;
+
+=head1 NAME
+
+Memoize::ExpireFile - test for Memoize expiration semantics
+
+=head1 DESCRIPTION
+
+See L<Memoize::Expire>.
+
+=cut
+
+$VERSION = 1.01;
+use Carp;
+
+my $Zero = pack("N", 0);
+
+sub TIEHASH {
+ my ($package, %args) = @_;
+ my $cache = $args{HASH} || {};
+ bless {ARGS => \%args, C => $cache} => $package;
+}
+
+
+sub STORE {
+# print "Expiry manager STORE handler\n";
+ my ($self, $key, $data) = @_;
+ my $cache = $self->{C};
+ my $cur_date = pack("N", (stat($key))[9]);
+ $cache->{"C$key"} = $data;
+ $cache->{"T$key"} = $cur_date;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+ $self->{C}{"C$key"};
+}
+
+sub EXISTS {
+# print "Expiry manager EXISTS handler\n";
+ my ($self, $key) = @_;
+ my $cache_date = $self->{C}{"T$key"} || $Zero;
+ my $file_date = pack("N", (stat($key))[9]);#
+# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
+# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
+# }
+ my $res = $cache_date ge $file_date;
+# print $res ? "... still good\n" : "... expired\n";
+ $res;
+}
+
+1;