lib/Memoize/Expire.pm

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