r55999 - in /branches/upstream/libmemoize-expirelru-perl: ./ current/ current/Changes current/ExpireLRU.pm current/MANIFEST current/Makefile.PL current/README current/test.pl
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Apr 12 10:41:30 UTC 2010
Author: eloy
Date: Mon Apr 12 10:41:19 2010
New Revision: 55999
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55999
Log:
[svn-inject] Installing original source of libmemoize-expirelru-perl
Added:
branches/upstream/libmemoize-expirelru-perl/
branches/upstream/libmemoize-expirelru-perl/current/
branches/upstream/libmemoize-expirelru-perl/current/Changes
branches/upstream/libmemoize-expirelru-perl/current/ExpireLRU.pm
branches/upstream/libmemoize-expirelru-perl/current/MANIFEST
branches/upstream/libmemoize-expirelru-perl/current/Makefile.PL
branches/upstream/libmemoize-expirelru-perl/current/README
branches/upstream/libmemoize-expirelru-perl/current/test.pl (with props)
Added: branches/upstream/libmemoize-expirelru-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/Changes?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/Changes (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/Changes Mon Apr 12 10:41:19 2010
@@ -1,0 +1,13 @@
+Revision 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?
Added: branches/upstream/libmemoize-expirelru-perl/current/ExpireLRU.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/ExpireLRU.pm?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/ExpireLRU.pm (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/ExpireLRU.pm Mon Apr 12 10:41:19 2010
@@ -1,0 +1,395 @@
+###########################################################################
+# File - ExpireLRU.pm
+# Created 12 Feb, 2000, Brent B. Powers
+#
+# Purpose - This package implements LRU expiration. It does this by
+# using a bunch of different data structures. Tuning
+# support is included, but costs performance.
+#
+# ToDo - Test the further tie stuff
+#
+# Copyright(c) 2000 Brent B. Powers and B2Pi LLC
+#
+# You may copy and distribute this program under the same terms as
+# Perl itself.
+#
+###########################################################################
+package Memoize::ExpireLRU;
+
+use strict;
+use AutoLoader qw(AUTOLOAD);
+use Carp;
+use vars qw($DEBUG $VERSION);
+
+$DEBUG = 0;
+$VERSION = '0.55';
+
+# Usage: memoize func ,
+# TIE => [
+# 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 .= <<EOS;
+
+ ExpireLRU instantiation: $self->{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<use> 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<CACHESIZE> 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<TUNECACHESIZE> parameter with a size greater than that of the
+C<CACHESIZE> 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<INSTANCE>
+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 at 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
Added: branches/upstream/libmemoize-expirelru-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/MANIFEST?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/MANIFEST (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/MANIFEST Mon Apr 12 10:41:19 2010
@@ -1,0 +1,6 @@
+Changes
+ExpireLRU.pm
+MANIFEST
+Makefile.PL
+README
+test.pl
Added: branches/upstream/libmemoize-expirelru-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/Makefile.PL?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/Makefile.PL (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/Makefile.PL Mon Apr 12 10:41:19 2010
@@ -1,0 +1,12 @@
+use 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',
+ },
+ );
Added: branches/upstream/libmemoize-expirelru-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/README?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/README (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/README Mon Apr 12 10:41:19 2010
@@ -1,0 +1,13 @@
+This 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.
Added: branches/upstream/libmemoize-expirelru-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmemoize-expirelru-perl/current/test.pl?rev=55999&op=file
==============================================================================
--- branches/upstream/libmemoize-expirelru-perl/current/test.pl (added)
+++ branches/upstream/libmemoize-expirelru-perl/current/test.pl Mon Apr 12 10:41:19 2010
@@ -1,0 +1,231 @@
+#!/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) = <<EOT;
+routine2:
+ Cache Keys:
+ '4'
+ Test Cache Keys:
+ '3'
+ '2'
+ '1'
+ '0'
+EOT
+
+# 45
+show($q eq Memoize::ExpireLRU::DumpCache('routine2'));
+
+$q = <<EOT;
+ExpireLRU Statistics:
+
+ ExpireLRU instantiation: routine
+ Cache Size: 4
+ Experimental Cache Size: 6
+ Cache Hits: 20
+ Cache Misses: 6
+Additional Cache Hits at Experimental Size: 1
+ Distribution : Hits
+ 0 : 3
+ 1 : 2
+ 2 : 5
+ 3 : 10
+ ---- -----
+ 4 : 1
+ 5 : 0
+
+ ExpireLRU instantiation: routine2
+ Cache Size: 1
+ Experimental Cache Size: 5
+ Cache Hits: 1
+ Cache Misses: 10
+Additional Cache Hits at Experimental Size: 4
+ Distribution : Hits
+ 0 : 1
+ ---- -----
+ 1 : 1
+ 2 : 1
+ 3 : 1
+ 4 : 1
+EOT
+
+# 46
+show($q eq Memoize::ExpireLRU::ShowStats);
Propchange: branches/upstream/libmemoize-expirelru-perl/current/test.pl
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list