lib/Memoize/Expire.pm

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