diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm')
| -rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm | 80 |
1 files changed, 31 insertions, 49 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm index 9b3b94444c..0683ecd711 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm @@ -1,23 +1,16 @@ +use strict; use warnings; package Memoize::Expire; -# require 5.00556; +our $VERSION = '1.16'; + use Carp; -$DEBUG = 0; -$VERSION = '1.03'; +our $DEBUG; -# 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: +# The format of the metadata is: # (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 ($@) { @@ -43,7 +36,7 @@ sub TIEHASH { } $args{LIFETIME} ||= 0; $args{NUM_USES} ||= 0; - $args{C} = \%cache; + $args{C} = delete $args{HASH} || \%cache; bless \%args => $package; } @@ -54,27 +47,25 @@ sub STORE { # 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; + @{$self->{C}}{"H$key", "V$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]}); + my ($last_access, $expire_time, $num_uses_left) = _get_header($_[0]{C}{"H$_[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; + $_[0]{C}{"H$_[1]"} = _make_header(time, $expire_time, --$num_uses_left); + $_[0]{C}{"V$_[1]"}; } sub EXISTS { $DEBUG and print STDERR " >> Exists $_[1]\n"; - unless (exists $_[0]{C}{$_[1]}) { + unless (exists $_[0]{C}{"V$_[1]"}) { $DEBUG and print STDERR " Not in underlying hash at all.\n"; return 0; } - my $item = $_[0]{C}{$_[1]}; + my $item = $_[0]{C}{"H$_[1]"}; my ($last_access, $expire_time, $num_uses_left) = _get_header($item); my $ttl = $expire_time - time; if ($DEBUG) { @@ -91,26 +82,21 @@ sub EXISTS { } } -# Arguments: last access time, expire time, number of uses remaining -sub _make_header { - pack "N N n", @_; +sub FIRSTKEY { + scalar keys %{$_[0]{C}}; + &NEXTKEY; } -sub _strip_header { - substr($_[0], 10); +sub NEXTKEY { + while (defined(my $key = each %{$_[0]{C}})) { + return substr $key, 1 if 'V' eq substr $key, 0, 1; + } + undef; } # 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); +sub _make_header { + pack "N N n", @_; } # Return last access time, expire time, number of uses remaining @@ -120,6 +106,10 @@ sub _get_header { 1; +__END__ + +=pod + =head1 NAME Memoize::Expire - Plug-in module for automatic expiration of memoized values @@ -249,7 +239,7 @@ 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'. +data is and things like that. Let us call this object I<C<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 @@ -282,7 +272,7 @@ cache item after ten seconds. $cache->{$key}{EXPIRE_TIME} > time) { return 1 } else { - return 0; # Do NOT return `undef' here. + return 0; # Do NOT return undef here } } @@ -318,11 +308,10 @@ See the documentation for details. =head1 ALTERNATIVES -Brent Powers has a C<Memoize::ExpireLRU> module that was designed to +Brent Powers has a L<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>. +comes in, the least-recently used data is expired. Joshua Chamas's Tie::Cache module may be useful as an expiration manager. (If you try this, let me know how it works out.) @@ -349,7 +338,7 @@ C<Time::HiRes> installed. =head1 AUTHOR -Mark-Jason Dominus (mjd-perl-memoize+@plover.com) +Mark-Jason Dominus Mike Cariaso provided valuable insight into the best way to solve this problem. @@ -360,11 +349,4 @@ 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 |