summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2024-03-15 03:06:35 +0000
committerNorbert Preining <norbert@preining.info>2024-03-15 03:06:35 +0000
commit12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch)
tree0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize
parent62170822e034fdd3f81de7274835d0d3b0467100 (diff)
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm48
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Expire.pm80
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireFile.pm52
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/ExpireTest.pm49
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/NDBM_File.pm85
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/SDBM_File.pm80
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Memoize/Storable.pm45
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