This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Réf. : Re: PATCH proposal for ext/Safe/safe2.t
[perl5.git] / lib / Memoize / ExpireFile.pm
CommitLineData
a0cb3900 1package Memoize::ExpireFile;
9038e305
JH
2
3=head1 NAME
4
5Memoize::ExpireFile - test for Memoize expiration semantics
6
7=head1 DESCRIPTION
8
9See L<Memoize::Expire>.
10
11=cut
12
899dc88a 13$VERSION = 0.65;
a0cb3900
JH
14use Carp;
15
899dc88a
JH
16my $Zero = pack("N", 0);
17
a0cb3900
JH
18sub TIEHASH {
19 my ($package, %args) = @_;
899dc88a
JH
20 my $cache = $args{HASH} || {};
21 bless {ARGS => \%args, C => $cache} => $package;
a0cb3900
JH
22}
23
24
25sub 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
33sub FETCH {
34 my ($self, $key) = @_;
35 $self->{C}{"C$key"};
36}
37
38sub EXISTS {
39 my ($self, $key) = @_;
899dc88a 40 my $old_date = $self->{C}{"T$key"} || $Zero;
a0cb3900 41 my $cur_date = pack("N", (stat($key))[9]);
899dc88a
JH
42# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
43# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
44# }
a0cb3900
JH
45 return $old_date ge $cur_date;
46}
47
481;