diff options
author | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
commit | 12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch) | |
tree | 0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize | |
parent | 62170822e034fdd3f81de7274835d0d3b0467100 (diff) |
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize')
7 files changed, 121 insertions, 318 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm index cf5f7f5bc2..c0aa5e6d36 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm @@ -1,31 +1,37 @@ +use strict; use warnings; + package Memoize::AnyDBM_File; +our $VERSION = '1.16'; -=head1 NAME +our @ISA = qw(DB_File GDBM_File Memoize::NDBM_File SDBM_File ODBM_File) unless @ISA; -Memoize::AnyDBM_File - glue to provide EXISTS for AnyDBM_File for Storable use +for my $mod (@ISA) { + if (eval "require $mod") { + $mod = 'NDBM_File' + if $mod eq 'Memoize::NDBM_File' + and eval { NDBM_File->VERSION( '1.16' ) }; + print STDERR "AnyDBM_File => Selected $mod.\n" if our $Verbose; + @ISA = $mod; + return 1; + } +} -=head1 DESCRIPTION +die "No DBM package was successfully found or installed"; -See L<Memoize>. +__END__ -=cut +=pod -use vars qw(@ISA $VERSION); -$VERSION = '1.03'; -@ISA = qw(DB_File GDBM_File Memoize::NDBM_File Memoize::SDBM_File ODBM_File) unless @ISA; +=head1 NAME -my $verbose = 1; +Memoize::AnyDBM_File - glue to provide EXISTS for AnyDBM_File for Storable use -my $mod; -for $mod (@ISA) { -# (my $truemod = $mod) =~ s/^Memoize:://; -# my $file = "$mod.pm"; -# $file =~ s{::}{/}g; - if (eval "require $mod") { - print STDERR "AnyDBM_File => Selected $mod.\n" if $Verbose; - @ISA = ($mod); # if we leave @ISA alone, warnings abound - return 1; - } -} +=head1 DESCRIPTION -die "No DBM package was successfully found or installed"; +This class does the same thing as L<AnyDBM_File>, except that instead of +L<NDBM_File> itself it loads L<Memoize::NDBM_File> if L<NDBM_File> lacks +L<EXISTS|perltie/C<EXISTS>> support. + +Code which requires perl 5.37.3 or newer should simply use L<AnyBDM_File> directly. + +=cut 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 diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireFile.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireFile.pm deleted file mode 100644 index 06b72f8ef2..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireFile.pm +++ /dev/null @@ -1,52 +0,0 @@ -package Memoize::ExpireFile; - -=head1 NAME - -Memoize::ExpireFile - test for Memoize expiration semantics - -=head1 DESCRIPTION - -See L<Memoize::Expire>. - -=cut - -$VERSION = '1.03'; -use Carp; - -my $Zero = pack("N", 0); - -sub TIEHASH { - my ($package, %args) = @_; - my $cache = $args{HASH} || {}; - bless {ARGS => \%args, C => $cache} => $package; -} - - -sub STORE { -# print "Expiry manager STORE handler\n"; - my ($self, $key, $data) = @_; - my $cache = $self->{C}; - my $cur_date = pack("N", (stat($key))[9]); - $cache->{"C$key"} = $data; - $cache->{"T$key"} = $cur_date; -} - -sub FETCH { - my ($self, $key) = @_; - $self->{C}{"C$key"}; -} - -sub EXISTS { -# print "Expiry manager EXISTS handler\n"; - my ($self, $key) = @_; - my $cache_date = $self->{C}{"T$key"} || $Zero; - my $file_date = pack("N", (stat($key))[9]);# -# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) { -# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date); -# } - my $res = $cache_date ge $file_date; -# print $res ? "... still good\n" : "... expired\n"; - $res; -} - -1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireTest.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireTest.pm deleted file mode 100644 index 7f7dd28af6..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireTest.pm +++ /dev/null @@ -1,49 +0,0 @@ -package Memoize::ExpireTest; - -=head1 NAME - -Memoize::ExpireTest - test for Memoize expiration semantics - -=head1 DESCRIPTION - -This module is just for testing expiration semantics. It's not a very -good example of how to write an expiration module. - -If you are looking for an example, I recommend that you look at the -simple example in the Memoize::Expire documentation, or at the code -for Memoize::Expire itself. - -If you have questions, I will be happy to answer them if you send them -to mjd-perl-memoize+@plover.com. - -=cut - -$VERSION = '1.03'; -my %cache; - -sub TIEHASH { - my ($pack) = @_; - bless \%cache => $pack; -} - -sub EXISTS { - my ($cache, $key) = @_; - exists $cache->{$key} ? 1 : 0; -} - -sub FETCH { - my ($cache, $key) = @_; - $cache->{$key}; -} - -sub STORE { - my ($cache, $key, $val) = @_; - $cache->{$key} = $val; -} - -sub expire { - my ($key) = @_; - delete $cache{$key}; -} - -1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/NDBM_File.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/NDBM_File.pm index ff934c656b..fc29f79986 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/NDBM_File.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/NDBM_File.pm @@ -1,77 +1,38 @@ -package Memoize::NDBM_File; - -=head1 NAME - -Memoize::NDBM_File - glue to provide EXISTS for NDBM_File for Storable use - -=head1 DESCRIPTION +use strict; use warnings; -See L<Memoize>. - -=cut +package Memoize::NDBM_File; +our $VERSION = '1.16'; use NDBM_File; -@ISA = qw(NDBM_File); -$VERSION = '1.03'; - -$Verbose = 0; +our @ISA = qw(NDBM_File); -sub AUTOLOAD { - warn "Nonexistent function $AUTOLOAD invoked in Memoize::NDBM_File\n"; -} - -sub import { - warn "Importing Memoize::NDBM_File\n" if $Verbose; +# NDBM_File cannot store undef and will store an empty string if you try +# but it does return undef if you try to read a non-existent key +# so we can emulate exists() using defined() +sub EXISTS { + defined shift->FETCH(@_); } +# Perl 5.37.3 adds this EXISTS emulation to NDBM_File itself +delete $Memoize::NDBM_File::{'EXISTS'} + if eval { NDBM_File->VERSION( '1.16' ) }; -my %keylist; - -# This is so ridiculous... -sub _backhash { - my $self = shift; - my %fakehash; - my $k; - for ($k = $self->FIRSTKEY(); defined $k; $k = $self->NEXTKEY($k)) { - $fakehash{$k} = undef; - } - $keylist{$self} = \%fakehash; -} - -sub EXISTS { - warn "Memoize::NDBM_File EXISTS (@_)\n" if $Verbose; - my $self = shift; - _backhash($self) unless exists $keylist{$self}; - my $r = exists $keylist{$self}{$_[0]}; - warn "Memoize::NDBM_File EXISTS (@_) ==> $r\n" if $Verbose; - $r; -} +1; -sub DEFINED { - warn "Memoize::NDBM_File DEFINED (@_)\n" if $Verbose; - my $self = shift; - _backhash($self) unless exists $keylist{$self}; - defined $keylist{$self}{$_[0]}; -} +__END__ -sub DESTROY { - warn "Memoize::NDBM_File DESTROY (@_)\n" if $Verbose; - my $self = shift; - delete $keylist{$self}; # So much for reference counting... - $self->SUPER::DESTROY(@_); -} +=pod -# Maybe establish the keylist at TIEHASH time instead? +=head1 NAME -sub STORE { - warn "Memoize::NDBM_File STORE (@_)\n" if $VERBOSE; - my $self = shift; - $keylist{$self}{$_[0]} = undef; - $self->SUPER::STORE(@_); -} +Memoize::NDBM_File - glue to provide EXISTS for NDBM_File for Storable use +=head1 DESCRIPTION +This class provides L<EXISTS|perltie/C<EXISTS>> support for L<NDBM_File>. -# Inherit FETCH and TIEHASH +L<In Perl 5.37.3|https://github.com/Perl/perl5/commit/c0a1a377c02ed789f5eff667f46a2314a05c5a4c>, +support for C<EXISTS> was added to L<NDBM_File> itself. +Code which requires such a perl should simply use L<NBDM_File> directly. -1; +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/SDBM_File.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/SDBM_File.pm index 7cfaa4afb9..87ef28e1ef 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/SDBM_File.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/SDBM_File.pm @@ -1,75 +1,27 @@ -package Memoize::SDBM_File; - -=head1 NAME - -Memoize::SDBM_File - glue to provide EXISTS for SDBM_File for Storable use - -=head1 DESCRIPTION - -See L<Memoize>. - -=cut +use strict; use warnings; -use SDBM_File; -@ISA = qw(SDBM_File); -$VERSION = '1.03'; - -$Verbose = 0; - -sub AUTOLOAD { - warn "Nonexistent function $AUTOLOAD invoked in Memoize::SDBM_File\n"; -} - -sub import { - warn "Importing Memoize::SDBM_File\n" if $Verbose; -} +package Memoize::SDBM_File; +our $VERSION = '1.16'; +use SDBM_File 1.01; # for EXISTS support +our @ISA = qw(SDBM_File); -my %keylist; +1; -# This is so ridiculous... -sub _backhash { - my $self = shift; - my %fakehash; - my $k; - for ($k = $self->FIRSTKEY(); defined $k; $k = $self->NEXTKEY($k)) { - $fakehash{$k} = undef; - } - $keylist{$self} = \%fakehash; -} +__END__ -sub EXISTS { - warn "Memoize::SDBM_File EXISTS (@_)\n" if $Verbose; - my $self = shift; - _backhash($self) unless exists $keylist{$self}; - my $r = exists $keylist{$self}{$_[0]}; - warn "Memoize::SDBM_File EXISTS (@_) ==> $r\n" if $Verbose; - $r; -} +=pod -sub DEFINED { - warn "Memoize::SDBM_File DEFINED (@_)\n" if $Verbose; - my $self = shift; - _backhash($self) unless exists $keylist{$self}; - defined $keylist{$self}{$_[0]}; -} +=head1 NAME -sub DESTROY { - warn "Memoize::SDBM_File DESTROY (@_)\n" if $Verbose; - my $self = shift; - delete $keylist{$self}; # So much for reference counting... - $self->SUPER::DESTROY(@_); -} +Memoize::SDBM_File - DEPRECATED compability shim -# Maybe establish the keylist at TIEHASH time instead? +=head1 DESCRIPTION -sub STORE { - warn "Memoize::SDBM_File STORE (@_)\n" if $VERBOSE; - my $self = shift; - $keylist{$self}{$_[0]} = undef; - $self->SUPER::STORE(@_); -} +This class used to provide L<EXISTS|perltie/C<EXISTS>> support for L<SDBM_File> +before support for C<EXISTS> was added to L<SDBM_File> itself +L<in Perl 5.6.0|perl56delta/SDBM_File>. -# Inherit FETCH and TIEHASH +Any code still using this class should be rewritten to use L<SBDM_File> directly. -1; +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Storable.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Storable.pm index 1314797297..923e57dc57 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Storable.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Storable.pm @@ -1,27 +1,19 @@ -package Memoize::Storable; - -=head1 NAME - -Memoize::Storable - store Memoized data in Storable database - -=head1 DESCRIPTION +use strict; use warnings; -See L<Memoize>. +package Memoize::Storable; +our $VERSION = '1.16'; -=cut +use Storable 1.002 (); # for lock_* function variants -use Storable (); -$VERSION = '1.03'; -$Verbose = 0; +our $Verbose; sub TIEHASH { - require Carp if $Verbose; my $package = shift; my $filename = shift; - my $truehash = (-e $filename) ? Storable::retrieve($filename) : {}; + my $truehash = (-e $filename) ? Storable::lock_retrieve($filename) : {}; my %options; print STDERR "Memoize::Storable::TIEHASH($filename, @_)\n" if $Verbose; - @options{@_} = (); + @options{@_} = (1) x @_; my $self = {FILENAME => $filename, H => $truehash, @@ -31,34 +23,30 @@ sub TIEHASH { } sub STORE { - require Carp if $Verbose; my $self = shift; print STDERR "Memoize::Storable::STORE(@_)\n" if $Verbose; $self->{H}{$_[0]} = $_[1]; } sub FETCH { - require Carp if $Verbose; my $self = shift; print STDERR "Memoize::Storable::FETCH(@_)\n" if $Verbose; $self->{H}{$_[0]}; } sub EXISTS { - require Carp if $Verbose; my $self = shift; print STDERR "Memoize::Storable::EXISTS(@_)\n" if $Verbose; exists $self->{H}{$_[0]}; } sub DESTROY { - require Carp if $Verbose; my $self= shift; print STDERR "Memoize::Storable::DESTROY(@_)\n" if $Verbose; if ($self->{OPTIONS}{'nstore'}) { - Storable::nstore($self->{H}, $self->{FILENAME}); + Storable::lock_nstore($self->{H}, $self->{FILENAME}); } else { - Storable::store($self->{H}, $self->{FILENAME}); + Storable::lock_store($self->{H}, $self->{FILENAME}); } } @@ -69,4 +57,19 @@ sub FIRSTKEY { sub NEXTKEY { undef; } + 1; + +__END__ + +=pod + +=head1 NAME + +Memoize::Storable - store Memoized data in Storable database + +=head1 DESCRIPTION + +See L<Memoize>. + +=cut |