371 lines
11 KiB
Perl
371 lines
11 KiB
Perl
|
|
package Memoize::Expire;
|
|
# require 5.00556;
|
|
use Carp;
|
|
$DEBUG = 0;
|
|
$VERSION = '1.03';
|
|
|
|
# This package will implement expiration by prepending a fixed-length header
|
|
# to the font of the cached data. The format of the header will be:
|
|
# (4-byte number of last-access-time) (For LRU when I implement it)
|
|
# (4-byte expiration time: unsigned seconds-since-unix-epoch)
|
|
# (2-byte number-of-uses-before-expire)
|
|
|
|
sub _header_fmt () { "N N n" }
|
|
sub _header_size () { length(_header_fmt) }
|
|
|
|
# Usage: memoize func
|
|
# TIE => [Memoize::Expire, LIFETIME => sec, NUM_USES => n,
|
|
# TIE => [...] ]
|
|
|
|
BEGIN {
|
|
eval {require Time::HiRes};
|
|
unless ($@) {
|
|
Time::HiRes->import('time');
|
|
}
|
|
}
|
|
|
|
sub TIEHASH {
|
|
my ($package, %args) = @_;
|
|
my %cache;
|
|
if ($args{TIE}) {
|
|
my ($module, @opts) = @{$args{TIE}};
|
|
my $modulefile = $module . '.pm';
|
|
$modulefile =~ s{::}{/}g;
|
|
eval { require $modulefile };
|
|
if ($@) {
|
|
croak "Memoize::Expire: Couldn't load hash tie module `$module': $@; aborting";
|
|
}
|
|
my $rc = (tie %cache => $module, @opts);
|
|
unless ($rc) {
|
|
croak "Memoize::Expire: Couldn't tie hash to `$module': $@; aborting";
|
|
}
|
|
}
|
|
$args{LIFETIME} ||= 0;
|
|
$args{NUM_USES} ||= 0;
|
|
$args{C} = \%cache;
|
|
bless \%args => $package;
|
|
}
|
|
|
|
sub STORE {
|
|
$DEBUG and print STDERR " >> Store $_[1] $_[2]\n";
|
|
my ($self, $key, $value) = @_;
|
|
my $expire_time = $self->{LIFETIME} > 0 ? $self->{LIFETIME} + time : 0;
|
|
# The call that results in a value to store into the cache is the
|
|
# first of the NUM_USES allowed calls.
|
|
my $header = _make_header(time, $expire_time, $self->{NUM_USES}-1);
|
|
$self->{C}{$key} = $header . $value;
|
|
$value;
|
|
}
|
|
|
|
sub FETCH {
|
|
$DEBUG and print STDERR " >> Fetch cached value for $_[1]\n";
|
|
my ($data, $last_access, $expire_time, $num_uses_left) = _get_item($_[0]{C}{$_[1]});
|
|
$DEBUG and print STDERR " >> (ttl: ", ($expire_time-time()), ", nuses: $num_uses_left)\n";
|
|
$num_uses_left--;
|
|
$last_access = time;
|
|
_set_header(@_, $data, $last_access, $expire_time, $num_uses_left);
|
|
$data;
|
|
}
|
|
|
|
sub EXISTS {
|
|
$DEBUG and print STDERR " >> Exists $_[1]\n";
|
|
unless (exists $_[0]{C}{$_[1]}) {
|
|
$DEBUG and print STDERR " Not in underlying hash at all.\n";
|
|
return 0;
|
|
}
|
|
my $item = $_[0]{C}{$_[1]};
|
|
my ($last_access, $expire_time, $num_uses_left) = _get_header($item);
|
|
my $ttl = $expire_time - time;
|
|
if ($DEBUG) {
|
|
$_[0]{LIFETIME} and print STDERR " Time to live for this item: $ttl\n";
|
|
$_[0]{NUM_USES} and print STDERR " Uses remaining: $num_uses_left\n";
|
|
}
|
|
if ( (! $_[0]{LIFETIME} || $expire_time > time)
|
|
&& (! $_[0]{NUM_USES} || $num_uses_left > 0 )) {
|
|
$DEBUG and print STDERR " (Still good)\n";
|
|
return 1;
|
|
} else {
|
|
$DEBUG and print STDERR " (Expired)\n";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Arguments: last access time, expire time, number of uses remaining
|
|
sub _make_header {
|
|
pack "N N n", @_;
|
|
}
|
|
|
|
sub _strip_header {
|
|
substr($_[0], 10);
|
|
}
|
|
|
|
# Arguments: last access time, expire time, number of uses remaining
|
|
sub _set_header {
|
|
my ($self, $key, $data, @header) = @_;
|
|
$self->{C}{$key} = _make_header(@header) . $data;
|
|
}
|
|
|
|
sub _get_item {
|
|
my $data = substr($_[0], 10);
|
|
my @header = unpack "N N n", substr($_[0], 0, 10);
|
|
# print STDERR " >> _get_item: $data => $data @header\n";
|
|
($data, @header);
|
|
}
|
|
|
|
# Return last access time, expire time, number of uses remaining
|
|
sub _get_header {
|
|
unpack "N N n", substr($_[0], 0, 10);
|
|
}
|
|
|
|
1;
|
|
|
|
=head1 NAME
|
|
|
|
Memoize::Expire - Plug-in module for automatic expiration of memoized values
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Memoize;
|
|
use Memoize::Expire;
|
|
tie my %cache => 'Memoize::Expire',
|
|
LIFETIME => $lifetime, # In seconds
|
|
NUM_USES => $n_uses;
|
|
|
|
memoize 'function', SCALAR_CACHE => [HASH => \%cache ];
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Memoize::Expire is a plug-in module for Memoize. It allows the cached
|
|
values for memoized functions to expire automatically. This manual
|
|
assumes you are already familiar with the Memoize module. If not, you
|
|
should study that manual carefully first, paying particular attention
|
|
to the HASH feature.
|
|
|
|
Memoize::Expire is a layer of software that you can insert in between
|
|
Memoize itself and whatever underlying package implements the cache.
|
|
The layer presents a hash variable whose values expire whenever they
|
|
get too old, have been used too often, or both. You tell C<Memoize> to
|
|
use this forgetful hash as its cache instead of the default, which is
|
|
an ordinary hash.
|
|
|
|
To specify a real-time timeout, supply the C<LIFETIME> option with a
|
|
numeric value. Cached data will expire after this many seconds, and
|
|
will be looked up afresh when it expires. When a data item is looked
|
|
up afresh, its lifetime is reset.
|
|
|
|
If you specify C<NUM_USES> with an argument of I<n>, then each cached
|
|
data item will be discarded and looked up afresh after the I<n>th time
|
|
you access it. When a data item is looked up afresh, its number of
|
|
uses is reset.
|
|
|
|
If you specify both arguments, data will be discarded from the cache
|
|
when either expiration condition holds.
|
|
|
|
Memoize::Expire uses a real hash internally to store the cached data.
|
|
You can use the C<HASH> option to Memoize::Expire to supply a tied
|
|
hash in place of the ordinary hash that Memoize::Expire will normally
|
|
use. You can use this feature to add Memoize::Expire as a layer in
|
|
between a persistent disk hash and Memoize. If you do this, you get a
|
|
persistent disk cache whose entries expire automatically. For
|
|
example:
|
|
|
|
# Memoize
|
|
# |
|
|
# Memoize::Expire enforces data expiration policy
|
|
# |
|
|
# DB_File implements persistence of data in a disk file
|
|
# |
|
|
# Disk file
|
|
|
|
use Memoize;
|
|
use Memoize::Expire;
|
|
use DB_File;
|
|
|
|
# Set up persistence
|
|
tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666];
|
|
|
|
# Set up expiration policy, supplying persistent hash as a target
|
|
tie my %cache => 'Memoize::Expire',
|
|
LIFETIME => $lifetime, # In seconds
|
|
NUM_USES => $n_uses,
|
|
HASH => \%disk_cache;
|
|
|
|
# Set up memoization, supplying expiring persistent hash for cache
|
|
memoize 'function', SCALAR_CACHE => [ HASH => \%cache ];
|
|
|
|
=head1 INTERFACE
|
|
|
|
There is nothing special about Memoize::Expire. It is just an
|
|
example. If you don't like the policy that it implements, you are
|
|
free to write your own expiration policy module that implements
|
|
whatever policy you desire. Here is how to do that. Let us suppose
|
|
that your module will be named MyExpirePolicy.
|
|
|
|
Short summary: You need to create a package that defines four methods:
|
|
|
|
=over 4
|
|
|
|
=item
|
|
TIEHASH
|
|
|
|
Construct and return cache object.
|
|
|
|
=item
|
|
EXISTS
|
|
|
|
Given a function argument, is the corresponding function value in the
|
|
cache, and if so, is it fresh enough to use?
|
|
|
|
=item
|
|
FETCH
|
|
|
|
Given a function argument, look up the corresponding function value in
|
|
the cache and return it.
|
|
|
|
=item
|
|
STORE
|
|
|
|
Given a function argument and the corresponding function value, store
|
|
them into the cache.
|
|
|
|
=item
|
|
CLEAR
|
|
|
|
(Optional.) Flush the cache completely.
|
|
|
|
=back
|
|
|
|
The user who wants the memoization cache to be expired according to
|
|
your policy will say so by writing
|
|
|
|
tie my %cache => 'MyExpirePolicy', args...;
|
|
memoize 'function', SCALAR_CACHE => [HASH => \%cache];
|
|
|
|
This will invoke C<< MyExpirePolicy->TIEHASH(args) >>.
|
|
MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
|
|
the cache, and it should return the cache object to the caller.
|
|
|
|
For example, MyExpirePolicy::TIEHASH might create an object that
|
|
contains a regular Perl hash (which it will to store the cached
|
|
values) and some extra information about the arguments and how old the
|
|
data is and things like that. Let us call this object `C'.
|
|
|
|
When Memoize needs to check to see if an entry is in the cache
|
|
already, it will invoke C<< C->EXISTS(key) >>. C<key> is the normalized
|
|
function argument. MyExpirePolicy::EXISTS should return 0 if the key
|
|
is not in the cache, or if it has expired, and 1 if an unexpired value
|
|
is in the cache. It should I<not> return C<undef>, because there is a
|
|
bug in some versions of Perl that will cause a spurious FETCH if the
|
|
EXISTS method returns C<undef>.
|
|
|
|
If your EXISTS function returns true, Memoize will try to fetch the
|
|
cached value by invoking C<< C->FETCH(key) >>. MyExpirePolicy::FETCH should
|
|
return the cached value. Otherwise, Memoize will call the memoized
|
|
function to compute the appropriate value, and will store it into the
|
|
cache by calling C<< C->STORE(key, value) >>.
|
|
|
|
Here is a very brief example of a policy module that expires each
|
|
cache item after ten seconds.
|
|
|
|
package Memoize::TenSecondExpire;
|
|
|
|
sub TIEHASH {
|
|
my ($package, %args) = @_;
|
|
my $cache = $args{HASH} || {};
|
|
bless $cache => $package;
|
|
}
|
|
|
|
sub EXISTS {
|
|
my ($cache, $key) = @_;
|
|
if (exists $cache->{$key} &&
|
|
$cache->{$key}{EXPIRE_TIME} > time) {
|
|
return 1
|
|
} else {
|
|
return 0; # Do NOT return `undef' here.
|
|
}
|
|
}
|
|
|
|
sub FETCH {
|
|
my ($cache, $key) = @_;
|
|
return $cache->{$key}{VALUE};
|
|
}
|
|
|
|
sub STORE {
|
|
my ($cache, $key, $newvalue) = @_;
|
|
$cache->{$key}{VALUE} = $newvalue;
|
|
$cache->{$key}{EXPIRE_TIME} = time + 10;
|
|
}
|
|
|
|
To use this expiration policy, the user would say
|
|
|
|
use Memoize;
|
|
tie my %cache10sec => 'Memoize::TenSecondExpire';
|
|
memoize 'function', SCALAR_CACHE => [HASH => \%cache10sec];
|
|
|
|
Memoize would then call C<function> whenever a cached value was
|
|
entirely absent or was older than ten seconds.
|
|
|
|
You should always support a C<HASH> argument to C<TIEHASH> that ties
|
|
the underlying cache so that the user can specify that the cache is
|
|
also persistent or that it has some other interesting semantics. The
|
|
example above demonstrates how to do this, as does C<Memoize::Expire>.
|
|
|
|
Another sample module, L<Memoize::Saves>, is available in a separate
|
|
distribution on CPAN. It implements a policy that allows you to
|
|
specify that certain function values would always be looked up afresh.
|
|
See the documentation for details.
|
|
|
|
=head1 ALTERNATIVES
|
|
|
|
Brent Powers has a C<Memoize::ExpireLRU> module that was designed to
|
|
work with Memoize and provides expiration of least-recently-used data.
|
|
The cache is held at a fixed number of entries, and when new data
|
|
comes in, the least-recently used data is expired. See
|
|
L<http://search.cpan.org/search?mode=module&query=ExpireLRU>.
|
|
|
|
Joshua Chamas's Tie::Cache module may be useful as an expiration
|
|
manager. (If you try this, let me know how it works out.)
|
|
|
|
If you develop any useful expiration managers that you think should be
|
|
distributed with Memoize, please let me know.
|
|
|
|
=head1 CAVEATS
|
|
|
|
This module is experimental, and may contain bugs. Please report bugs
|
|
to the address below.
|
|
|
|
Number-of-uses is stored as a 16-bit unsigned integer, so can't exceed
|
|
65535.
|
|
|
|
Because of clock granularity, expiration times may occur up to one
|
|
second sooner than you expect. For example, suppose you store a value
|
|
with a lifetime of ten seconds, and you store it at 12:00:00.998 on a
|
|
certain day. Memoize will look at the clock and see 12:00:00. Then
|
|
9.01 seconds later, at 12:00:10.008 you try to read it back. Memoize
|
|
will look at the clock and see 12:00:10 and conclude that the value
|
|
has expired. This will probably not occur if you have
|
|
C<Time::HiRes> installed.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Mark-Jason Dominus (mjd-perl-memoize+@plover.com)
|
|
|
|
Mike Cariaso provided valuable insight into the best way to solve this
|
|
problem.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
perl(1)
|
|
|
|
The Memoize man page.
|
|
|
|
http://www.plover.com/~mjd/perl/Memoize/ (for news and updates)
|
|
|
|
I maintain a mailing list on which I occasionally announce new
|
|
versions of Memoize. The list is for announcements only, not
|
|
discussion. To join, send an empty message to
|
|
mjd-perl-memoize-request@Plover.com.
|
|
|
|
=cut
|