Memoize-ExpireLRU-0.55/0040755000076400007640000000000007074754600013602 5ustar powerssrcMemoize-ExpireLRU-0.55/Makefile.PL0100644000076400007640000000057307061622074015551 0ustar powerssrcuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Memoize::ExpireLRU', VERSION_FROM => 'ExpireLRU.pm', # finds $VERSION PREREQ_PM => { Memoize => 0.52 , }, dist => { COMPRESS => 'gzip', SUFFIX => '.gz', }, ); Memoize-ExpireLRU-0.55/Changes0100644000076400007640000000055307074754457015107 0ustar powerssrcRevision history for Perl extension String::Strip 0.52 Wed Mar 8 23:08:34 EST 2000 - original version 0.53 Thu Apr 6 23:34:12 EDT 2000 - Tiny bug fixes (!= -> ne) 0.54 Tue Apr 11 21:46:37 EDT 2000 - Big bug fixes. Consider this the first working version 0.55 Tue Apr 11 21:46:37 EDT 2000 - Just why can't you save from a screwed up upload on PAUSE? Memoize-ExpireLRU-0.55/test.pl0100755000076400007640000001071107074754547015130 0ustar powerssrc#!/usr/local/bin/perl -w ########################################################################### # File - test.pl # Created 12 Feb, 2000, Brent B. Powers # # Purpose - test for Memoize::ExpireLRU # # ToDo - Test when tied to other module # # ########################################################################### use strict; use Memoize; my $n = 0; use vars qw($dbg); $dbg = 0; $| = 1; print "1..46\n"; use Memoize::ExpireLRU; ++$n; print "ok $n\n"; my %CALLS = (); sub routine ( $ ) { return shift; } sub routine3 ( $ ) { return shift; } my($flag) = 1; ## 1 gives routine2 as a list, 0 as a scalar sub routine2 ( $ ) { if ($flag) { my($z) = shift; return (1, $z); } else { return shift; } } sub show ( $ ) { print "not " unless shift; ++$n; print "ok $n\n"; } memoize('routine', SCALAR_CACHE => ['TIE', 'Memoize::ExpireLRU', CACHESIZE => 4, TUNECACHESIZE => 6, INSTANCE => 'routine', ], LIST_CACHE => 'FAULT'); if ($flag) { memoize('routine2', LIST_CACHE => ['TIE', 'Memoize::ExpireLRU', CACHESIZE => 1, TUNECACHESIZE => 5, INSTANCE => 'routine2', ], SCALAR_CACHE => 'FAULT',); } else { memoize('routine2', SCALAR_CACHE => ['TIE', 'Memoize::ExpireLRU', CACHESIZE => 1, TUNECACHESIZE => 5, INSTANCE => 'routine2', ], LIST_CACHE => 'FAULT'); } memoize('routine3', SCALAR_CACHE => ['TIE', 'Memoize::ExpireLRU', CACHESIZE => 4, INSTANCE => 'routine3', ], LIST_CACHE => 'FAULT'); $Memoize::ExpireLRU::DEBUG = 1; $Memoize::ExpireLRU::DEBUG = 0; show(1); # 3--6 ## Fill the cache for (0..3) { show(routine($_) == $_); $CALLS{$_} = $_; } # 7--10 ## Ensure that the return values were correct for (keys %CALLS) { show($CALLS{$_} == (0,1,2,3)[$_]); } # 11--14 ## Check returns from the cache for (0..3) { show(routine($_) == $_); } # 15--18 ## Make sure we can get each one of the array foreach (0,2,0,0) { show(routine($_) == $_); } ## Make sure we can get each one of the aray, where the timestamps are ## different my($i); for (0..3) { # sleep(1); $i = routine($_); } # 19 show(1); # 20-23 for (0,2,0,0) { show(routine($_) == $_); } ## Check getting a new one ## Force the order for (3,2,1,0) { $i = routine($_); } # 24--25 ## Push off the last one, and ensure that the ## one we pushed off is really pushed off for (4, 3) { show(routine($_) == $_); } # 26--30 ## Play with the second function ## First, fill it my(@a); for (5,4,3,2,1,0) { if ($flag) { show((routine2($_))[1] == $_); } else { show($_ == routine2($_)); } } ## Now, hit each of them, in order # 31 -- 35 ## Force at least one cache hit if ($flag) { @a = routine2(0); } else { routine2(0); } for (1..4) { if ($flag) { show((routine2($_))[1] == $_); } else { show($_ == routine2($_)); } } ## 36-44 for (0,1,2,3,4,5,5,4,3) { show($_ == routine3($_)); } my($q) = < [ # Memoize::ExpireLRU, # CACHESIZE => n, # TUNECACHESIZE => m, # INSTANCE => IDString # TIE => [...] # ] ############################################# ## ## This used to all be a bit more reasonable, but then it turns out ## that Memoize doesn't call FETCH if EXISTS returns true and it's in ## scalar context. Thus, everything really has to be done in the ## EXISTS code. Harumph. ## ############################################# use vars qw(@AllTies $EndDebug); $EndDebug = 0; 1; sub TIEHASH { my ($package, %args, %cache, @index, @Tune, @Stats); ($package, %args)= @_; my($self) = bless \%args => $package; $self->{CACHESIZE} or croak "Memoize::ExpireLRU: CACHESIZE must be specified >0; aborting"; $self->{TUNECACHESIZE} ||= 0; delete($self->{TUNECACHESIZE}) unless $self->{TUNECACHESIZE}; $self->{C} = \%cache; $self->{I} = \@index; defined($self->{INSTANCE}) or $self->{INSTANCE} = "$self"; foreach (@AllTies) { if ($_->{INSTANCE} eq $self->{INSTANCE}) { croak "Memoize::ExpireLRU: Attempt to register the same routine twice; aborting"; } } if ($self->{TUNECACHESIZE}) { $EndDebug = 1; for (my $i = 0; $i < $args{TUNECACHESIZE}; $i++) { $Stats[$i] = 0; } $self->{T} = \@Stats; $self->{TI} = \@Tune; $self->{cm} = $args{ch} = $args{th} = 0; } if ($self->{TIE}) { my($module, $modulefile, @opts, $rc, %tcache); ($module, @opts) = @{$args{TIE}}; $modulefile = $module . '.pm'; $modulefile =~ s{::}{/}g; eval { require $modulefile }; if ($@) { croak "Memoize::ExpireLRU: Couldn't load hash tie module `$module': $@; aborting"; } $rc = (tie %tcache => $module, @opts); unless ($rc) { croak "Memoize::ExpireLRU: Couldn't tie hash to `$module': $@; aborting"; } ## Preload our cache foreach (keys %tcache) { $self->{C}->{$_} = $tcache{$_} } $self->{TiC} = \%tcache; } push(@AllTies, $self); return $self; } sub EXISTS { my($self, $key) = @_; $DEBUG and print STDERR " >> $self->{INSTANCE} >> EXISTS: $key\n"; if (exists $self->{C}->{$key}) { my($t, $i);#, %t, %r); ## Adjust the positions in the index cache ## 1. Find the old entry in the array (and do the stat's) $i = _find($self->{I}, $self->{C}->{$key}->{t}, $key); if (!defined($i)) { print STDERR "Cache trashed (unable to find $key)\n"; DumpCache($self->{INSTANCE}); ShowStats; die "Aborting..."; } ## 2. Remove the old entry from the array $t = splice(@{$self->{I}}, $i, 1); ## 3. Update the timestamp of the new array entry, as ## well as that in the cache $self->{C}->{$key}->{t} = $t->{t} = time; ## 4. Store the updated entry back into the array as the MRU unshift(@{$self->{I}}, $t); ## 5. Adjust stats if (defined($self->{T})) { $self->{T}->[$i]++ if defined($self->{T}); $self->{ch}++; } if ($DEBUG) { print STDERR " Cache hit at $i"; print STDERR " ($self->{ch})" if defined($self->{T}); print STDERR ".\n"; } return 1; } else { if (exists($self->{TUNECACHESIZE})) { $self->{cm}++; $DEBUG and print STDERR " Cache miss ($self->{cm}).\n"; ## Ughhh. A linear search my($i, $j); for ($i = $j = $self->{CACHESIZE}; $i <= $#{$self->{T}}; $i++) { next unless defined($self->{TI}) && defined($self->{TI}->[$i- $j]) && defined($self->{TI}->[$i - $j]->{k}) && $self->{TI}->[$i - $j]->{k} eq $key; $self->{T}->[$i]++; $self->{th}++; $DEBUG and print STDERR " TestCache hit at $i. ($self->{th})\n"; splice(@{$self->{TI}}, $i - $j, 1); return 0; } } else { $DEBUG and print STDERR " Cache miss.\n"; } return 0; } } sub STORE { my ($self, $key, $value) = @_; $DEBUG and print STDERR " >> $self->{INSTANCE} >> STORE: $key $value\n"; my(%r, %t); $t{t} = $r{t} = time; $r{v} = $value; $t{k} = $key; # Store the value into the hash $self->{C}->{$key} = \%r; ## As well as the tied cache, if it exists $self->{TC}->{$key} = $value if defined($self->{TC}); # By definition, this item is the MRU, so add it to the beginning # of the LRU queue. Since this is a STORE, we know it doesn't already # exist. unshift(@{$self->{I}}, \%t); ## Update the tied cache $self->{TC}->{$key} = $value if defined($self->{TC}); ## Do we have too many entries? while (scalar(@{$self->{I}}) > $self->{CACHESIZE}) { ## Chop off whatever is at the end ## Get the key $key = pop(@{$self->{I}}); delete($self->{C}->{$key->{k}}); delete($self->{TC}->{$key->{k}}) if defined($self->{TC}); ## Throw it to the beginning of the test cache unshift(@{$self->{TI}}, $key) if defined($self->{T}); } ## Now, what about the Tuning Index if (defined($self->{T})) { if (scalar(@{$self->{TI}}) > $self->{TUNECACHESIZE} - $self->{CACHESIZE}) { $#{$self->{TI}} = $self->{TUNECACHESIZE} - $self->{CACHESIZE} - 1; } } $value; } sub FETCH { my($self, $key) = @_; $DEBUG and print STDERR " >> $self->{INSTANCE} >> FETCH: $key\n"; return $self->{C}->{$key}->{v}; } sub _find ( $$$ ) { my($Aref, $time, $key) = @_; my($t, $b, $n, $l); $t = $#{$Aref}; $n = $b = 0; $l = -2; while ($time != $Aref->[$n]->{t}) { if ($time < $Aref->[$n]->{t}) { $b = $n; } else { $t = $n; } if ($t <= $b) { ## Trouble, we're out. if ($Aref->[$t]->{t} == $time) { $n = $t; } elsif ($Aref->[$b]->{t} == $time) { $n = $b; } else { ## Really big trouble ## Complain loudly print "Trouble\n"; return undef; } } else { $n = $b + (($t - $b) >> 1); $n++ if $l == $n; $l = $n; } } ## Drop down in the array until the time isn't the time while (($n > 0) && ($time == $Aref->[$n-1]->{t})) { $n--; } while (($time == $Aref->[$n]->{t}) && ($key ne $Aref->[$n]->{k})) { $n++; } if ($key ne $Aref->[$n]->{k}) { ## More big trouble print "More trouble\n"; return undef; } return $n; } END { print STDERR ShowStats() if $EndDebug; } __END__ sub DumpCache ( $ ) { ## Utility routine to display the caches of the given instance my($Instance, $self, $p) = shift; foreach $self (@AllTies) { next unless $self->{INSTANCE} eq $Instance; $p = "$Instance:\n Cache Keys:\n"; foreach my $x (@{$self->{I}}) { ## The cache is at $self->{C} (->{$key}) $p .= " '$x->{k}'\n"; } $p .= " Test Cache Keys:\n"; foreach my $x (@{$self->{TI}}) { $p .= " '$x->{k}'\n"; } return $p; } return "Instance $Instance not found\n"; } sub ShowStats () { ## Utility routine to show statistics my($k) = 0; my($p) = ''; foreach my $self (@AllTies) { next unless defined($self->{T}); $p .= "ExpireLRU Statistics:\n" unless $k; $k++; $p .= <{INSTANCE} Cache Size: $self->{CACHESIZE} Experimental Cache Size: $self->{TUNECACHESIZE} Cache Hits: $self->{ch} Cache Misses: $self->{cm} Additional Cache Hits at Experimental Size: $self->{th} Distribution : Hits EOS for (my $i = 0; $i < $self->{TUNECACHESIZE}; $i++) { if ($i == $self->{CACHESIZE}) { $p .= " ---- -----\n"; } $p .= sprintf(" %3d : %s\n", $i, $self->{T}->[$i]); } } return $p; } =head1 NAME Memoize - Expiry plug-in for Memoize that adds LRU cache expiration =head1 SYNOPSIS use Memoize; memoize('slow_function', TIE => [Memoize::ExpireLRU, CACHESIZE => n, ]); Note that one need not C this module. It will be found by the Memoize module. The argument to CACHESIZE must be an integer. Normally, this is all that is needed. Additional options are available: TUNECACHESIZE => m, INSTANCE => 'descriptive_name', TIE => '[DB_File, $filename, O_RDWR | O_CREATE, 0666]' =head1 DESCRIPTION For the theory of Memoization, please see the Memoize module documentation. This module implements an expiry policy for Memoize that follows LRU semantics, that is, the last n results, where n is specified as the argument to the C parameter, will be cached. =head1 PERFORMANCE TUNING It is often quite difficult to determine what size cache will give optimal results for a given function. To aid in determining this, ExpireLRU includes cache tuning support. Enabling this causes a definite performance hit, but it is often useful before code is released to production. To enable cache tuning support, simply specify the optional C parameter with a size greater than that of the C parameter. When the program exits, a set of statistics will be printed to stderr. If multiple routines have been memoized, separate sets of statistics are printed for each routine. The default names are somewhat cryptic: this is the purpose of the C parameter. The value of this parameter will be used as the identifier within the statistics report. =head1 DIAGNOSTIC METHODS Two additional routines are available but not exported. Memoize::ExpireLRU::ShowStats returns a string identical to the statistics report printed to STDERR at the end of the program if test caches have been enabled; Memoize::ExpireLRU::DumpCache takes the instance name of a memoized function as a parameter, and returns a string describing the current state of that instance. =head1 AUTHOR Brent B. Powers (B2Pi), Powers@B2Pi.com Copyright(c) 1999 Brent B. Powers. All rights reserved. This program is free software, you may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Memoize =cut Memoize-ExpireLRU-0.55/README0100644000076400007640000000043707061621612014453 0ustar powerssrcThis is the README file for Memoize::ExpireLRU Memoize::ExpireLRU is a module that implements LRU expiration for Memoize. To build and install this extension, simply chant: perl Makefile.PL make make test make install Memoize::ExpireLRU requires Memoize version 0.52 or greater. Memoize-ExpireLRU-0.55/MANIFEST0100644000076400007640000000007107061622461014721 0ustar powerssrcChanges ExpireLRU.pm MANIFEST Makefile.PL README test.pl