summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Memoize
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:57:31 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:57:31 +0000
commit320d8694fec25ed148613684543b5a0504a046ae (patch)
tree0ddcf933d3acd3c98a387fa2bf73d0554ca6e50d /Master/tlpkg/tlperl/lib/Memoize
parent779e71f16ca01a6244b632b95bdb461fec163b34 (diff)
New tlperl part XIV
git-svn-id: svn://tug.org/texlive/trunk@21436 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Memoize')
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm31
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/Expire.pm365
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/ExpireFile.pm52
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/ExpireTest.pm49
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/NDBM_File.pm77
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/SDBM_File.pm75
-rw-r--r--Master/tlpkg/tlperl/lib/Memoize/Storable.pm72
7 files changed, 721 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm b/Master/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm
new file mode 100644
index 00000000000..91f960962f9
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/AnyDBM_File.pm
@@ -0,0 +1,31 @@
+package Memoize::AnyDBM_File;
+
+=head1 NAME
+
+Memoize::AnyDBM_File - glue to provide EXISTS for AnyDBM_File for Storable use
+
+=head1 DESCRIPTION
+
+See L<Memoize>.
+
+=cut
+
+use vars qw(@ISA $VERSION);
+$VERSION = 0.65;
+@ISA = qw(DB_File GDBM_File Memoize::NDBM_File Memoize::SDBM_File ODBM_File) unless @ISA;
+
+my $verbose = 1;
+
+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;
+ }
+}
+
+die "No DBM package was successfully found or installed";
diff --git a/Master/tlpkg/tlperl/lib/Memoize/Expire.pm b/Master/tlpkg/tlperl/lib/Memoize/Expire.pm
new file mode 100644
index 00000000000..97e1aa44208
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/Expire.pm
@@ -0,0 +1,365 @@
+
+package Memoize::Expire;
+# require 5.00556;
+use Carp;
+$DEBUG = 0;
+$VERSION = '1.00';
+
+# 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:
+# (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 ($@) {
+ Time::HiRes->import('time');
+ }
+}
+
+sub TIEHASH {
+ my ($package, %args) = @_;
+ my %cache;
+ if ($args{TIE}) {
+ my ($module, @opts) = @{$args{TIE}};
+ my $modulefile = $module . '.pm';
+ $modulefile =~ s{::}{/}g;
+ eval { require $modulefile };
+ if ($@) {
+ croak "Memoize::Expire: Couldn't load hash tie module `$module': $@; aborting";
+ }
+ my $rc = (tie %cache => $module, @opts);
+ unless ($rc) {
+ croak "Memoize::Expire: Couldn't tie hash to `$module': $@; aborting";
+ }
+ }
+ $args{LIFETIME} ||= 0;
+ $args{NUM_USES} ||= 0;
+ $args{C} = \%cache;
+ bless \%args => $package;
+}
+
+sub STORE {
+ $DEBUG and print STDERR " >> Store $_[1] $_[2]\n";
+ my ($self, $key, $value) = @_;
+ my $expire_time = $self->{LIFETIME} > 0 ? $self->{LIFETIME} + time : 0;
+ # 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;
+ $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]});
+ $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;
+}
+
+sub EXISTS {
+ $DEBUG and print STDERR " >> Exists $_[1]\n";
+ unless (exists $_[0]{C}{$_[1]}) {
+ $DEBUG and print STDERR " Not in underlying hash at all.\n";
+ return 0;
+ }
+ my $item = $_[0]{C}{$_[1]};
+ my ($last_access, $expire_time, $num_uses_left) = _get_header($item);
+ my $ttl = $expire_time - time;
+ if ($DEBUG) {
+ $_[0]{LIFETIME} and print STDERR " Time to live for this item: $ttl\n";
+ $_[0]{NUM_USES} and print STDERR " Uses remaining: $num_uses_left\n";
+ }
+ if ( (! $_[0]{LIFETIME} || $expire_time > time)
+ && (! $_[0]{NUM_USES} || $num_uses_left > 0 )) {
+ $DEBUG and print STDERR " (Still good)\n";
+ return 1;
+ } else {
+ $DEBUG and print STDERR " (Expired)\n";
+ return 0;
+ }
+}
+
+# Arguments: last access time, expire time, number of uses remaining
+sub _make_header {
+ pack "N N n", @_;
+}
+
+sub _strip_header {
+ substr($_[0], 10);
+}
+
+# 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);
+}
+
+# Return last access time, expire time, number of uses remaining
+sub _get_header {
+ unpack "N N n", substr($_[0], 0, 10);
+}
+
+1;
+
+=head1 NAME
+
+Memoize::Expire - Plug-in module for automatic expiration of memoized values
+
+=head1 SYNOPSIS
+
+ use Memoize;
+ use Memoize::Expire;
+ tie my %cache => 'Memoize::Expire',
+ LIFETIME => $lifetime, # In seconds
+ NUM_USES => $n_uses;
+
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache ];
+
+=head1 DESCRIPTION
+
+Memoize::Expire is a plug-in module for Memoize. It allows the cached
+values for memoized functions to expire automatically. This manual
+assumes you are already familiar with the Memoize module. If not, you
+should study that manual carefully first, paying particular attention
+to the HASH feature.
+
+Memoize::Expire is a layer of software that you can insert in between
+Memoize itself and whatever underlying package implements the cache.
+The layer presents a hash variable whose values expire whenever they
+get too old, have been used too often, or both. You tell C<Memoize> to
+use this forgetful hash as its cache instead of the default, which is
+an ordinary hash.
+
+To specify a real-time timeout, supply the C<LIFETIME> option with a
+numeric value. Cached data will expire after this many seconds, and
+will be looked up afresh when it expires. When a data item is looked
+up afresh, its lifetime is reset.
+
+If you specify C<NUM_USES> with an argument of I<n>, then each cached
+data item will be discarded and looked up afresh after the I<n>th time
+you access it. When a data item is looked up afresh, its number of
+uses is reset.
+
+If you specify both arguments, data will be discarded from the cache
+when either expiration condition holds.
+
+Memoize::Expire uses a real hash internally to store the cached data.
+You can use the C<HASH> option to Memoize::Expire to supply a tied
+hash in place of the ordinary hash that Memoize::Expire will normally
+use. You can use this feature to add Memoize::Expire as a layer in
+between a persistent disk hash and Memoize. If you do this, you get a
+persistent disk cache whose entries expire automatically. For
+example:
+
+ # Memoize
+ # |
+ # Memoize::Expire enforces data expiration policy
+ # |
+ # DB_File implements persistence of data in a disk file
+ # |
+ # Disk file
+
+ use Memoize;
+ use Memoize::Expire;
+ use DB_File;
+
+ # Set up persistence
+ tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666];
+
+ # Set up expiration policy, supplying persistent hash as a target
+ tie my %cache => 'Memoize::Expire',
+ LIFETIME => $lifetime, # In seconds
+ NUM_USES => $n_uses,
+ HASH => \%disk_cache;
+
+ # Set up memoization, supplying expiring persistent hash for cache
+ memoize 'function', SCALAR_CACHE => [ HASH => \%cache ];
+
+=head1 INTERFACE
+
+There is nothing special about Memoize::Expire. It is just an
+example. If you don't like the policy that it implements, you are
+free to write your own expiration policy module that implements
+whatever policy you desire. Here is how to do that. Let us suppose
+that your module will be named MyExpirePolicy.
+
+Short summary: You need to create a package that defines four methods:
+
+=over 4
+
+=item
+TIEHASH
+
+Construct and return cache object.
+
+=item
+EXISTS
+
+Given a function argument, is the corresponding function value in the
+cache, and if so, is it fresh enough to use?
+
+=item
+FETCH
+
+Given a function argument, look up the corresponding function value in
+the cache and return it.
+
+=item
+STORE
+
+Given a function argument and the corresponding function value, store
+them into the cache.
+
+=item
+CLEAR
+
+(Optional.) Flush the cache completely.
+
+=back
+
+The user who wants the memoization cache to be expired according to
+your policy will say so by writing
+
+ tie my %cache => 'MyExpirePolicy', args...;
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache];
+
+This will invoke C<< MyExpirePolicy->TIEHASH(args) >>.
+MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
+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'.
+
+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
+function argument. MyExpirePolicy::EXISTS should return 0 if the key
+is not in the cache, or if it has expired, and 1 if an unexpired value
+is in the cache. It should I<not> return C<undef>, because there is a
+bug in some versions of Perl that will cause a spurious FETCH if the
+EXISTS method returns C<undef>.
+
+If your EXISTS function returns true, Memoize will try to fetch the
+cached value by invoking C<< C->FETCH(key) >>. MyExpirePolicy::FETCH should
+return the cached value. Otherwise, Memoize will call the memoized
+function to compute the appropriate value, and will store it into the
+cache by calling C<< C->STORE(key, value) >>.
+
+Here is a very brief example of a policy module that expires each
+cache item after ten seconds.
+
+ package Memoize::TenSecondExpire;
+
+ sub TIEHASH {
+ my ($package, %args) = @_;
+ my $cache = $args{HASH} || {};
+ bless $cache => $package;
+ }
+
+ sub EXISTS {
+ my ($cache, $key) = @_;
+ if (exists $cache->{$key} &&
+ $cache->{$key}{EXPIRE_TIME} > time) {
+ return 1
+ } else {
+ return 0; # Do NOT return `undef' here.
+ }
+ }
+
+ sub FETCH {
+ my ($cache, $key) = @_;
+ return $cache->{$key}{VALUE};
+ }
+
+ sub STORE {
+ my ($cache, $key, $newvalue) = @_;
+ $cache->{$key}{VALUE} = $newvalue;
+ $cache->{$key}{EXPIRE_TIME} = time + 10;
+ }
+
+To use this expiration policy, the user would say
+
+ use Memoize;
+ tie my %cache10sec => 'Memoize::TenSecondExpire';
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache10sec];
+
+Memoize would then call C<function> whenever a cached value was
+entirely absent or was older than ten seconds.
+
+You should always support a C<HASH> argument to C<TIEHASH> that ties
+the underlying cache so that the user can specify that the cache is
+also persistent or that it has some other interesting semantics. The
+example above demonstrates how to do this, as does C<Memoize::Expire>.
+
+=head1 ALTERNATIVES
+
+Brent Powers has a C<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>.
+
+Joshua Chamas's Tie::Cache module may be useful as an expiration
+manager. (If you try this, let me know how it works out.)
+
+If you develop any useful expiration managers that you think should be
+distributed with Memoize, please let me know.
+
+=head1 CAVEATS
+
+This module is experimental, and may contain bugs. Please report bugs
+to the address below.
+
+Number-of-uses is stored as a 16-bit unsigned integer, so can't exceed
+65535.
+
+Because of clock granularity, expiration times may occur up to one
+second sooner than you expect. For example, suppose you store a value
+with a lifetime of ten seconds, and you store it at 12:00:00.998 on a
+certain day. Memoize will look at the clock and see 12:00:00. Then
+9.01 seconds later, at 12:00:10.008 you try to read it back. Memoize
+will look at the clock and see 12:00:10 and conclude that the value
+has expired. This will probably not occur if you have
+C<Time::HiRes> installed.
+
+=head1 AUTHOR
+
+Mark-Jason Dominus (mjd-perl-memoize+@plover.com)
+
+Mike Cariaso provided valuable insight into the best way to solve this
+problem.
+
+=head1 SEE ALSO
+
+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/Master/tlpkg/tlperl/lib/Memoize/ExpireFile.pm b/Master/tlpkg/tlperl/lib/Memoize/ExpireFile.pm
new file mode 100644
index 00000000000..e52c09a3bf3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/ExpireFile.pm
@@ -0,0 +1,52 @@
+package Memoize::ExpireFile;
+
+=head1 NAME
+
+Memoize::ExpireFile - test for Memoize expiration semantics
+
+=head1 DESCRIPTION
+
+See L<Memoize::Expire>.
+
+=cut
+
+$VERSION = 1.01;
+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/Master/tlpkg/tlperl/lib/Memoize/ExpireTest.pm b/Master/tlpkg/tlperl/lib/Memoize/ExpireTest.pm
new file mode 100644
index 00000000000..729f6b98506
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/ExpireTest.pm
@@ -0,0 +1,49 @@
+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 = 0.65;
+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/Master/tlpkg/tlperl/lib/Memoize/NDBM_File.pm b/Master/tlpkg/tlperl/lib/Memoize/NDBM_File.pm
new file mode 100644
index 00000000000..96eabfbb7c8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/NDBM_File.pm
@@ -0,0 +1,77 @@
+package Memoize::NDBM_File;
+
+=head1 NAME
+
+Memoize::NDBM_File - glue to provide EXISTS for NDBM_File for Storable use
+
+=head1 DESCRIPTION
+
+See L<Memoize>.
+
+=cut
+
+use NDBM_File;
+@ISA = qw(NDBM_File);
+$VERSION = 0.65;
+
+$Verbose = 0;
+
+sub AUTOLOAD {
+ warn "Nonexistent function $AUTOLOAD invoked in Memoize::NDBM_File\n";
+}
+
+sub import {
+ warn "Importing Memoize::NDBM_File\n" if $Verbose;
+}
+
+
+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;
+}
+
+sub DEFINED {
+ warn "Memoize::NDBM_File DEFINED (@_)\n" if $Verbose;
+ my $self = shift;
+ _backhash($self) unless exists $keylist{$self};
+ defined $keylist{$self}{$_[0]};
+}
+
+sub DESTROY {
+ warn "Memoize::NDBM_File DESTROY (@_)\n" if $Verbose;
+ my $self = shift;
+ delete $keylist{$self}; # So much for reference counting...
+ $self->SUPER::DESTROY(@_);
+}
+
+# Maybe establish the keylist at TIEHASH time instead?
+
+sub STORE {
+ warn "Memoize::NDBM_File STORE (@_)\n" if $VERBOSE;
+ my $self = shift;
+ $keylist{$self}{$_[0]} = undef;
+ $self->SUPER::STORE(@_);
+}
+
+
+
+# Inherit FETCH and TIEHASH
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Memoize/SDBM_File.pm b/Master/tlpkg/tlperl/lib/Memoize/SDBM_File.pm
new file mode 100644
index 00000000000..f66273f2747
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/SDBM_File.pm
@@ -0,0 +1,75 @@
+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 SDBM_File;
+@ISA = qw(SDBM_File);
+$VERSION = 0.65;
+
+$Verbose = 0;
+
+sub AUTOLOAD {
+ warn "Nonexistent function $AUTOLOAD invoked in Memoize::SDBM_File\n";
+}
+
+sub import {
+ warn "Importing Memoize::SDBM_File\n" if $Verbose;
+}
+
+
+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::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;
+}
+
+sub DEFINED {
+ warn "Memoize::SDBM_File DEFINED (@_)\n" if $Verbose;
+ my $self = shift;
+ _backhash($self) unless exists $keylist{$self};
+ defined $keylist{$self}{$_[0]};
+}
+
+sub DESTROY {
+ warn "Memoize::SDBM_File DESTROY (@_)\n" if $Verbose;
+ my $self = shift;
+ delete $keylist{$self}; # So much for reference counting...
+ $self->SUPER::DESTROY(@_);
+}
+
+# Maybe establish the keylist at TIEHASH time instead?
+
+sub STORE {
+ warn "Memoize::SDBM_File STORE (@_)\n" if $VERBOSE;
+ my $self = shift;
+ $keylist{$self}{$_[0]} = undef;
+ $self->SUPER::STORE(@_);
+}
+
+# Inherit FETCH and TIEHASH
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Memoize/Storable.pm b/Master/tlpkg/tlperl/lib/Memoize/Storable.pm
new file mode 100644
index 00000000000..4c29dd7eb8f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Memoize/Storable.pm
@@ -0,0 +1,72 @@
+package Memoize::Storable;
+
+=head1 NAME
+
+Memoize::Storable - store Memoized data in Storable database
+
+=head1 DESCRIPTION
+
+See L<Memoize>.
+
+=cut
+
+use Storable ();
+$VERSION = 0.65;
+$Verbose = 0;
+
+sub TIEHASH {
+ require Carp if $Verbose;
+ my $package = shift;
+ my $filename = shift;
+ my $truehash = (-e $filename) ? Storable::retrieve($filename) : {};
+ my %options;
+ print STDERR "Memoize::Storable::TIEHASH($filename, @_)\n" if $Verbose;
+ @options{@_} = ();
+ my $self =
+ {FILENAME => $filename,
+ H => $truehash,
+ OPTIONS => \%options
+ };
+ bless $self => $package;
+}
+
+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});
+ } else {
+ Storable::store($self->{H}, $self->{FILENAME});
+ }
+}
+
+sub FIRSTKEY {
+ 'Fake hash from Memoize::Storable';
+}
+
+sub NEXTKEY {
+ undef;
+}
+1;