1use strict; use warnings;
2
3package Memoize::Expire;
4our $VERSION = '1.16';
5
6use Carp;
7our $DEBUG;
8
9# The format of the metadata is:
10# (4-byte number of last-access-time)  (For LRU when I implement it)
11# (4-byte expiration time: unsigned seconds-since-unix-epoch)
12# (2-byte number-of-uses-before-expire)
13
14BEGIN {
15  eval {require Time::HiRes};
16  unless ($@) {
17    Time::HiRes->import('time');
18  }
19}
20
21sub TIEHASH {
22  my ($package, %args) = @_;
23  my %cache;
24  if ($args{TIE}) {
25    my ($module, @opts) = @{$args{TIE}};
26    my $modulefile = $module . '.pm';
27    $modulefile =~ s{::}{/}g;
28    eval { require $modulefile };
29    if ($@) {
30      croak "Memoize::Expire: Couldn't load hash tie module `$module': $@; aborting";
31    }
32    my $rc = (tie %cache => $module, @opts);
33    unless ($rc) {
34      croak "Memoize::Expire: Couldn't tie hash to `$module': $@; aborting";
35    }
36  }
37  $args{LIFETIME} ||= 0;
38  $args{NUM_USES} ||= 0;
39  $args{C} = delete $args{HASH} || \%cache;
40  bless \%args => $package;
41}
42
43sub STORE {
44  $DEBUG and print STDERR " >> Store $_[1] $_[2]\n";
45  my ($self, $key, $value) = @_;
46  my $expire_time = $self->{LIFETIME} > 0 ? $self->{LIFETIME} + time : 0;
47  # The call that results in a value to store into the cache is the
48  # first of the NUM_USES allowed calls.
49  my $header = _make_header(time, $expire_time, $self->{NUM_USES}-1);
50  @{$self->{C}}{"H$key", "V$key"} = ($header, $value);
51  $value;
52}
53
54sub FETCH {
55  $DEBUG and print STDERR " >> Fetch cached value for $_[1]\n";
56  my ($last_access, $expire_time, $num_uses_left) = _get_header($_[0]{C}{"H$_[1]"});
57  $DEBUG and print STDERR " >>   (ttl: ", ($expire_time-time()), ", nuses: $num_uses_left)\n";
58  $_[0]{C}{"H$_[1]"} = _make_header(time, $expire_time, --$num_uses_left);
59  $_[0]{C}{"V$_[1]"};
60}
61
62sub EXISTS {
63  $DEBUG and print STDERR " >> Exists $_[1]\n";
64  unless (exists $_[0]{C}{"V$_[1]"}) {
65    $DEBUG and print STDERR "    Not in underlying hash at all.\n";
66    return 0;
67  }
68  my $item = $_[0]{C}{"H$_[1]"};
69  my ($last_access, $expire_time, $num_uses_left) = _get_header($item);
70  my $ttl = $expire_time - time;
71  if ($DEBUG) {
72    $_[0]{LIFETIME} and print STDERR "    Time to live for this item: $ttl\n";
73    $_[0]{NUM_USES} and print STDERR "    Uses remaining: $num_uses_left\n";
74  }
75  if (   (! $_[0]{LIFETIME} || $expire_time > time)
76      && (! $_[0]{NUM_USES} || $num_uses_left > 0 )) {
77	    $DEBUG and print STDERR "    (Still good)\n";
78    return 1;
79  } else {
80    $DEBUG and print STDERR "    (Expired)\n";
81    return 0;
82  }
83}
84
85sub FIRSTKEY {
86  scalar keys %{$_[0]{C}};
87  &NEXTKEY;
88}
89
90sub NEXTKEY {
91  while (defined(my $key = each %{$_[0]{C}})) {
92    return substr $key, 1 if 'V' eq substr $key, 0, 1;
93  }
94  undef;
95}
96
97# Arguments: last access time, expire time, number of uses remaining
98sub _make_header {
99  pack "N N n", @_;
100}
101
102# Return last access time, expire time, number of uses remaining
103sub _get_header  {
104  unpack "N N n", substr($_[0], 0, 10);
105}
106
1071;
108
109__END__
110
111=pod
112
113=head1 NAME
114
115Memoize::Expire - Plug-in module for automatic expiration of memoized values
116
117=head1 SYNOPSIS
118
119  use Memoize;
120  use Memoize::Expire;
121  tie my %cache => 'Memoize::Expire',
122	  	     LIFETIME => $lifetime,    # In seconds
123		     NUM_USES => $n_uses;
124
125  memoize 'function', SCALAR_CACHE => [HASH => \%cache ];
126
127=head1 DESCRIPTION
128
129Memoize::Expire is a plug-in module for Memoize.  It allows the cached
130values for memoized functions to expire automatically.  This manual
131assumes you are already familiar with the Memoize module.  If not, you
132should study that manual carefully first, paying particular attention
133to the HASH feature.
134
135Memoize::Expire is a layer of software that you can insert in between
136Memoize itself and whatever underlying package implements the cache.
137The layer presents a hash variable whose values expire whenever they
138get too old, have been used too often, or both. You tell C<Memoize> to
139use this forgetful hash as its cache instead of the default, which is
140an ordinary hash.
141
142To specify a real-time timeout, supply the C<LIFETIME> option with a
143numeric value.  Cached data will expire after this many seconds, and
144will be looked up afresh when it expires.  When a data item is looked
145up afresh, its lifetime is reset.
146
147If you specify C<NUM_USES> with an argument of I<n>, then each cached
148data item will be discarded and looked up afresh after the I<n>th time
149you access it.  When a data item is looked up afresh, its number of
150uses is reset.
151
152If you specify both arguments, data will be discarded from the cache
153when either expiration condition holds.
154
155Memoize::Expire uses a real hash internally to store the cached data.
156You can use the C<HASH> option to Memoize::Expire to supply a tied
157hash in place of the ordinary hash that Memoize::Expire will normally
158use.  You can use this feature to add Memoize::Expire as a layer in
159between a persistent disk hash and Memoize.  If you do this, you get a
160persistent disk cache whose entries expire automatically.  For
161example:
162
163  #   Memoize
164  #      |
165  #   Memoize::Expire  enforces data expiration policy
166  #      |
167  #   DB_File  implements persistence of data in a disk file
168  #      |
169  #   Disk file
170
171  use Memoize;
172  use Memoize::Expire;
173  use DB_File;
174
175  # Set up persistence
176  tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666];
177
178  # Set up expiration policy, supplying persistent hash as a target
179  tie my %cache => 'Memoize::Expire',
180	  	     LIFETIME => $lifetime,    # In seconds
181		     NUM_USES => $n_uses,
182                     HASH => \%disk_cache;
183
184  # Set up memoization, supplying expiring persistent hash for cache
185  memoize 'function', SCALAR_CACHE => [ HASH => \%cache ];
186
187=head1 INTERFACE
188
189There is nothing special about Memoize::Expire.  It is just an
190example.  If you don't like the policy that it implements, you are
191free to write your own expiration policy module that implements
192whatever policy you desire.  Here is how to do that.  Let us suppose
193that your module will be named MyExpirePolicy.
194
195Short summary: You need to create a package that defines four methods:
196
197=over 4
198
199=item
200TIEHASH
201
202Construct and return cache object.
203
204=item
205EXISTS
206
207Given a function argument, is the corresponding function value in the
208cache, and if so, is it fresh enough to use?
209
210=item
211FETCH
212
213Given a function argument, look up the corresponding function value in
214the cache and return it.
215
216=item
217STORE
218
219Given a function argument and the corresponding function value, store
220them into the cache.
221
222=item
223CLEAR
224
225(Optional.)  Flush the cache completely.
226
227=back
228
229The user who wants the memoization cache to be expired according to
230your policy will say so by writing
231
232  tie my %cache => 'MyExpirePolicy', args...;
233  memoize 'function', SCALAR_CACHE => [HASH => \%cache];
234
235This will invoke C<< MyExpirePolicy->TIEHASH(args) >>.
236MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
237the cache, and it should return the cache object to the caller.
238
239For example, MyExpirePolicy::TIEHASH might create an object that
240contains a regular Perl hash (which it will to store the cached
241values) and some extra information about the arguments and how old the
242data is and things like that. Let us call this object I<C<C>>.
243
244When Memoize needs to check to see if an entry is in the cache
245already, it will invoke C<< C->EXISTS(key) >>.  C<key> is the normalized
246function argument.  MyExpirePolicy::EXISTS should return 0 if the key
247is not in the cache, or if it has expired, and 1 if an unexpired value
248is in the cache.  It should I<not> return C<undef>, because there is a
249bug in some versions of Perl that will cause a spurious FETCH if the
250EXISTS method returns C<undef>.
251
252If your EXISTS function returns true, Memoize will try to fetch the
253cached value by invoking C<< C->FETCH(key) >>.  MyExpirePolicy::FETCH should
254return the cached value.  Otherwise, Memoize will call the memoized
255function to compute the appropriate value, and will store it into the
256cache by calling C<< C->STORE(key, value) >>.
257
258Here is a very brief example of a policy module that expires each
259cache item after ten seconds.
260
261	package Memoize::TenSecondExpire;
262
263	sub TIEHASH {
264	  my ($package, %args) = @_;
265          my $cache = $args{HASH} || {};
266	  bless $cache => $package;
267	}
268
269	sub EXISTS {
270	  my ($cache, $key) = @_;
271	  if (exists $cache->{$key} &&
272              $cache->{$key}{EXPIRE_TIME} > time) {
273	    return 1
274	  } else {
275	    return 0;  # Do NOT return undef here
276	  }
277	}
278
279	sub FETCH {
280	  my ($cache, $key) = @_;
281	  return $cache->{$key}{VALUE};
282	}
283
284	sub STORE {
285	  my ($cache, $key, $newvalue) = @_;
286	  $cache->{$key}{VALUE} = $newvalue;
287	  $cache->{$key}{EXPIRE_TIME} = time + 10;
288	}
289
290To use this expiration policy, the user would say
291
292	use Memoize;
293        tie my %cache10sec => 'Memoize::TenSecondExpire';
294	memoize 'function', SCALAR_CACHE => [HASH => \%cache10sec];
295
296Memoize would then call C<function> whenever a cached value was
297entirely absent or was older than ten seconds.
298
299You should always support a C<HASH> argument to C<TIEHASH> that ties
300the underlying cache so that the user can specify that the cache is
301also persistent or that it has some other interesting semantics.  The
302example above demonstrates how to do this, as does C<Memoize::Expire>.
303
304Another sample module, L<Memoize::Saves>, is available in a separate
305distribution on CPAN.  It implements a policy that allows you to
306specify that certain function values would always be looked up afresh.
307See the documentation for details.
308
309=head1 ALTERNATIVES
310
311Brent Powers has a L<Memoize::ExpireLRU> module that was designed to
312work with Memoize and provides expiration of least-recently-used data.
313The cache is held at a fixed number of entries, and when new data
314comes in, the least-recently used data is expired.
315
316Joshua Chamas's Tie::Cache module may be useful as an expiration
317manager.  (If you try this, let me know how it works out.)
318
319If you develop any useful expiration managers that you think should be
320distributed with Memoize, please let me know.
321
322=head1 CAVEATS
323
324This module is experimental, and may contain bugs.  Please report bugs
325to the address below.
326
327Number-of-uses is stored as a 16-bit unsigned integer, so can't exceed
32865535.
329
330Because of clock granularity, expiration times may occur up to one
331second sooner than you expect.  For example, suppose you store a value
332with a lifetime of ten seconds, and you store it at 12:00:00.998 on a
333certain day.  Memoize will look at the clock and see 12:00:00.  Then
3349.01 seconds later, at 12:00:10.008 you try to read it back.  Memoize
335will look at the clock and see 12:00:10 and conclude that the value
336has expired.  This will probably not occur if you have
337C<Time::HiRes> installed.
338
339=head1 AUTHOR
340
341Mark-Jason Dominus
342
343Mike Cariaso provided valuable insight into the best way to solve this
344problem.
345
346=head1 SEE ALSO
347
348perl(1)
349
350The Memoize man page.
351
352=cut
353