| Subject: | Memoize::Expire stringifies the caches values, making it useless for functions that return objects |
If you try to use Memoize::Expire to memoize a function or method which
returns an object, then the first time anything is retrieved from the
cache, you discover you have a stringified version of the object, not
the actual blessed reference.
This is because Memoize::Expire prepend the metadata for the lifetime
and number of uses remaining to the front of the cached value, and act
of concatenation stringifies the object.
I've added a test case that exposes the bug, and then reworked the
internals of Memoize::Expire to use a hash reference to track the
metadata, and the actual data values, without accidentally stringifying
them.
This patch should allow Memoize::Expire to be used with functions that
return arbitrary data, although I have only tested it for one case: a
function that returns a single object, which was the use case of mine
that exposed the bug.
I have no incremented the version number in this release, and I'll leave
that up to Mark Jason.
| Subject: | Memoize-1.01-no-stringify-values.patch |
diff -rc Memoize-1.01-orig/Memoize/Expire.pm Memoize-1.01/Memoize/Expire.pm
*** Memoize-1.01-orig/Memoize/Expire.pm 2002-03-29 13:51:27.000000000 -0500
--- Memoize-1.01/Memoize/Expire.pm 2008-08-08 16:41:42.000000000 -0400
***************
*** 1,22 ****
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};
--- 1,15 ----
package Memoize::Expire;
# require 5.00556;
+ use strict;
use Carp;
+
+ use vars qw( $DEBUG $VERSION );
+
$DEBUG = 0;
$VERSION = '1.00';
! use Data::Dumper;
BEGIN {
eval {require Time::HiRes};
***************
*** 48,88 ****
}
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 {
--- 41,91 ----
}
sub STORE {
my ($self, $key, $value) = @_;
+ $DEBUG and print STDERR " >> Store $key => $value\n";
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.
! $self->{C}{$key} = {
! expire_time => $expire_time,
! num_uses_left => $self->{NUM_USES}-1,
! value => $value,
! };
$value;
}
sub FETCH {
! my ($self, $key) = @_;
! my $data = $self->{C}{$key};
! $DEBUG and print STDERR "Data for $key is:\n" . Data::Dumper->Dump([$data],['data']);
! my $value = $data->{value};
! $DEBUG and print STDERR " >> Fetch cached value for $key => $value\n";
! if ( $self->{LIFETIME} ) {
! my $ttl = $data->{expire_time} - time();
! $DEBUG and print STDERR " >> (ttl: $ttl)\n";
! }
! if ( $self->{NUM_USES} ) {
! $DEBUG and print STDERR " >> (nuses: $data->{num_uses})\n";
! $data->{num_uses_left}--;
! }
! $value;
}
sub EXISTS {
! my ($self, $key) = @_;
! $DEBUG and print STDERR " >> Exists $key\n";
! unless (exists $self->{C}{$key}) {
$DEBUG and print STDERR " Not in underlying hash at all.\n";
return 0;
}
! my $data = $self->{C}{$key};
! my $ttl = $data->{expire_time} - time;
if ($DEBUG) {
! $self->{LIFETIME} and print STDERR " Time to live for this item: $ttl\n";
! $self->{NUM_USES} and print STDERR " Uses remaining: $data->{num_uses_left}\n";
}
! if ( (! $self->{LIFETIME} || $data->{expire_time} > time)
! && (! $self->{NUM_USES} || $data->{num_uses_left} > 0 )) {
$DEBUG and print STDERR " (Still good)\n";
return 1;
} else {
***************
*** 91,123 ****
}
}
- # 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
--- 94,99 ----
diff -rc Memoize-1.01-orig/t/expmod_t.t Memoize-1.01/t/expmod_t.t
*** Memoize-1.01-orig/t/expmod_t.t 2002-07-12 13:57:12.000000000 -0400
--- Memoize-1.01/t/expmod_t.t 2008-08-08 16:45:15.000000000 -0400
***************
*** 24,30 ****
# Perhaps nobody will notice if we don't say anything
# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
! print "1..15\n";
$| = 1;
# (1)
--- 24,30 ----
# Perhaps nobody will notice if we don't say anything
# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
! print "1..17\n";
$| = 1;
# (1)
***************
*** 134,136 ****
--- 134,169 ----
}
}
+ sub object {
+ return MyObject->new(time);
+ }
+
+ tie my %object_cache => 'Memoize::Expire', LIFETIME => 15;
+ memoize 'object',
+ SCALAR_CACHE => [HASH => \%object_cache ],
+ LIST_CACHE => 'FAULT'
+ ;
+
+ my $first = object(1);
+ ++$n;
+ if ( ref $first && $first->isa('MyObject') ) {
+ print "ok $n # looks like first is a " . (ref $first) . "\n";
+ } else {
+ print "not ok $n # expected first to be MyObject, but it's '$first'\n";
+ }
+
+ my $second = object(1);
+ ++$n;
+ if ( ref $second && $second->isa('MyObject') ) {
+ print "ok $n # looks like second is a " . (ref $second) ."\n";
+ } else {
+ print "not ok $n # expected second to be MyObject, but it's '$second'\n";
+ }
+
+ package MyObject;
+
+ sub new {
+ my $class = shift;
+ my $time = shift;
+ return bless \$time, $class;
+ }