lib/Memoize/Expire.pm

   1
   2 package Memoize::Expire;
   3 # require 5.00556;
   4 use Carp;
   5 $DEBUG = 0;
   6 $VERSION = '0.51';
   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   memoize 'function',
 126     SCALAR_CACHE => [TIE, Memoize::Expire,
 127                      LIFETIME => $lifetime,    # In seconds
 128                      NUM_USES => $n_uses,
 129                      TIE      => [Module, args...],
 130                     ],
 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 TIE 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 (By default, plain hash variables implement the cache.)  The layer
 143 expires cached values whenever they get too old, have been used too
 144 often, or both.
 145
 146 To specify a real-time timeout, supply the LIFETIME option with a
 147 numeric value.  Cached data will expire after this many seconds, and
 148 will be looked up afresh when it expires.  When a data item is looked
 149 up afresh, its lifetime is reset.
 150
 151 If you specify NUM_USES with an argument of I<n>, then each cached
 152 data item will be discarded and looked up afresh after the I<n>th time
 153 you access it.  When a data item is looked up afresh, its number of
 154 uses is reset.
 155
 156 If you specify both arguments, data will be discarded from the cache
 157 when either expiration condition holds.
 158
 159 If you want the cache to persist between invocations of your program,
 160 supply a TIE option to specify the package name and arguments for a
 161 the tied hash that will implement the persistence.  For example:
 162
 163   use Memoize;
 164   use DB_File;
 165   memoize 'function',
 166     SCALAR_CACHE => [TIE, Memoize::Expire,
 167                      LIFETIME => $lifetime,    # In seconds
 168                      NUM_USES => $n_uses,
 169                      TIE      => [DB_File, $filename, O_CREAT|O_RDWR, 0666],
 170                     ], ...;
 171
 172
 173
 174 =head1 INTERFACE
 175
 176 There is nothing special about Memoize::Expire.  It is just an
 177 example.  If you don't like the policy that it implements, you are
 178 free to write your own expiration policy module that implements
 179 whatever policy you desire.  Here is how to do that.  Let us suppose
 180 that your module will be named MyExpirePolicy.
 181
 182 Short summary: You need to create a package that defines four methods:
 183
 184 =over 4
 185
 186 =item
 187 TIEHASH
 188
 189 Construct and return cache object.
 190
 191 =item
 192 EXISTS
 193
 194 Given a function argument, is the corresponding function value in the
 195 cache, and if so, is it fresh enough to use?
 196
 197 =item
 198 FETCH
 199
 200 Given a function argument, look up the corresponding function value in
 201 the cache and return it.
 202
 203 =item
 204 STORE
 205
 206 Given a function argument and the corresponding function value, store
 207 them into the cache.
 208
 209 =back
 210
 211 The user who wants the memoization cache to be expired according to
 212 your policy will say so by writing
 213
 214   memoize 'function',
 215     SCALAR_CACHE => [TIE, MyExpirePolicy, args...];
 216
 217 This will invoke MyExpirePolicy->TIEHASH(args).
 218 MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
 219 the cache, and it should return the cache object to the caller.
 220
 221 For example, MyExpirePolicy::TIEHASH might create an object that
 222 contains a regular Perl hash (which it will to store the cached
 223 values) and some extra information about the arguments and how old the
 224 data is and things like that.  Let us call this object `C'.
 225
 226 When Memoize needs to check to see if an entry is in the cache
 227 already, it will invoke C->EXISTS(key).  C<key> is the normalized
 228 function argument.  MyExpirePolicy::EXISTS should return 0 if the key
 229 is not in the cache, or if it has expired, and 1 if an unexpired value
 230 is in the cache.  It should I<not> return C<undef>, because there is a
 231 bug in some versions of Perl that will cause a spurious FETCH if the
 232 EXISTS method returns C<undef>.
 233
 234 If your EXISTS function returns true, Memoize will try to fetch the
 235 cached value by invoking C->FETCH(key).  MyExpirePolicy::FETCH should
 236 return the cached value.  Otherwise, Memoize will call the memoized
 237 function to compute the appropriate value, and will store it into the
 238 cache by calling C->STORE(key, value).
 239
 240 Here is a very brief example of a policy module that expires each
 241 cache item after ten seconds.
 242
 243         package Memoize::TenSecondExpire;
 244
 245         sub TIEHASH {
 246           my ($package) = @_;
 247           my %cache;
 248           bless \%cache => $package;
 249         }
 250
 251         sub EXISTS {
 252           my ($cache, $key) = @_;
 253           if (exists $cache->{$key} &&
 254               $cache->{$key}{EXPIRE_TIME} > time) {
 255             return 1
 256           } else {
 257             return 0;  # Do NOT return `undef' here.
 258           }
 259         }
 260
 261         sub FETCH {
 262           my ($cache, $key) = @_;
 263           return $cache->{$key}{VALUE};
 264         }
 265
 266         sub STORE {
 267           my ($cache, $key, $newvalue) = @_;
 268           $cache->{$key}{VALUE} = $newvalue;
 269           $cache->{$key}{EXPIRE_TIME} = time + 10;
 270         }
 271
 272 To use this expiration policy, the user would say
 273
 274         use Memoize;
 275         memoize 'function',
 276             SCALAR_CACHE => [TIE, Memoize::TenSecondExpire];
 277
 278 Memoize would then call C<function> whenever a cached value was
 279 entirely absent or was older than ten seconds.
 280
 281 It's nice if you allow a C<TIE> argument to C<TIEHASH> that ties the
 282 underlying cache so that the user can specify that the cache is
 283 persistent or that it has some other interesting semantics.  The
 284 sample C<Memoize::Expire> module demonstrates how to do this.  It
 285 implements a policy that expires cache items when they get too old or
 286 when they have been accessed too many times.
 287
 288 Another sample module, C<Memoize::Saves>, is included with this
 289 package.  It implements a policy that allows you to specify that
 290 certain function values whould always be looked up afresh.  See the
 291 documentation for details.
 292
 293 =head1 ALTERNATIVES
 294
 295 Joshua Chamas's Tie::Cache module may be useful as an expiration
 296 manager.  (If you try this, let me know how it works out.)
 297
 298 If you develop any useful expiration managers that you think should be
 299 distributed with Memoize, please let me know.
 300
 301 =head1 CAVEATS
 302
 303 This module is experimental, and may contain bugs.  Please report bugs
 304 to the address below.
 305
 306 Number-of-uses is stored as a 16-bit unsigned integer, so can't exceed
 307 65535.
 308
 309 Because of clock granularity, expiration times may occur up to one
 310 second sooner than you expect.  For example, suppose you store a value
 311 with a lifetime of ten seconds, and you store it at 12:00:00.998 on a
 312 certain day.  Memoize will look at the clock and see 12:00:00.  Then
 313 9.01 seconds later, at 12:00:10.008 you try to read it back.  Memoize
 314 will look at the clock and see 12:00:10 and conclude that the value
 315 has expired.  Solution: Build an expiration policy module that uses
 316 Time::HiRes to examine a clock with better granularity.  Contributions
 317 are welcome.  Send them to:
 318
 319 =head1 AUTHOR
 320
 321 Mark-Jason Dominus (mjd-perl-memoize+@plover.com)
 322
 323 Mike Cariaso provided valuable insight into the best way to solve this
 324 problem.
 325
 326 =head1 SEE ALSO
 327
 328 perl(1)
 329
 330 The Memoize man page.
 331
 332 http://www.plover.com/~mjd/perl/Memoize/  (for news and updates)
 333
 334 I maintain a mailing list on which I occasionally announce new
 335 versions of Memoize.  The list is for announcements only, not
 336 discussion.  To join, send an empty message to
 337 mjd-perl-memoize-request@Plover.com.
 338
 339 =cut