r38237 - in /branches/upstream/libcache-fastmmap-perl/current: Cache-FastMmap-CImpl/CImpl.pm Changes FastMmap.pm MANIFEST META.yml t/15.t t/7.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Jun 18 22:33:13 UTC 2009
Author: jawnsy-guest
Date: Thu Jun 18 22:33:05 2009
New Revision: 38237
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38237
Log:
[svn-upgrade] Integrating new upstream version, libcache-fastmmap-perl (1.33)
Added:
branches/upstream/libcache-fastmmap-perl/current/t/15.t
Modified:
branches/upstream/libcache-fastmmap-perl/current/Cache-FastMmap-CImpl/CImpl.pm
branches/upstream/libcache-fastmmap-perl/current/Changes
branches/upstream/libcache-fastmmap-perl/current/FastMmap.pm
branches/upstream/libcache-fastmmap-perl/current/MANIFEST
branches/upstream/libcache-fastmmap-perl/current/META.yml
branches/upstream/libcache-fastmmap-perl/current/t/7.t
Modified: branches/upstream/libcache-fastmmap-perl/current/Cache-FastMmap-CImpl/CImpl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/Cache-FastMmap-CImpl/CImpl.pm?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/Cache-FastMmap-CImpl/CImpl.pm (original)
+++ branches/upstream/libcache-fastmmap-perl/current/Cache-FastMmap-CImpl/CImpl.pm Thu Jun 18 22:33:05 2009
@@ -15,7 +15,7 @@
use strict;
use warnings;
-our $VERSION = '1.30';
+our $VERSION = '1.33';
require XSLoader;
XSLoader::load('Cache::FastMmap::CImpl', $VERSION);
Modified: branches/upstream/libcache-fastmmap-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/Changes?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/Changes (original)
+++ branches/upstream/libcache-fastmmap-perl/current/Changes Thu Jun 18 22:33:05 2009
@@ -1,4 +1,18 @@
Revision history for Perl extension Cache::FastMmap.
+
+1.33 Thu Jun 18 12:00 2009
+ - Update version in META.yml
+
+1.32 Thu Jun 18 11:55 2009
+ - Better LiveCaches tracking via DESTROY
+
+1.31 Thu Jun 18 11:40 2009
+ - when in raw_values => 0 mode, the write_cb is now
+ correctly called with thawed data, rather than the
+ raw frozen data
+ - empty_on_exit correctly called even when a global
+ cache is left at interpreter exit time (required
+ Scalar::Util qw(weaken) for object tracking)
1.30 Fri May 8 11:10 2009
- Fix for Mandriva compiler (thanks Jean-Christian Hassler)
Modified: branches/upstream/libcache-fastmmap-perl/current/FastMmap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/FastMmap.pm?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/FastMmap.pm (original)
+++ branches/upstream/libcache-fastmmap-perl/current/FastMmap.pm Thu Jun 18 22:33:05 2009
@@ -287,7 +287,11 @@
use warnings;
use bytes;
-our $VERSION = '1.30';
+our $VERSION = '1.33';
+
+# Track currently live caches so we can cleanup in END {}
+# if we have empty_on_exit set
+our %LiveCaches;
use Cache::FastMmap::CImpl;
@@ -525,6 +529,15 @@
if ($compress) {
eval "use Compress::Zlib; 1;"
|| die "Could not load Compress::Zlib module: $@";
+ }
+
+ # If using empty_on_exit, need to track used caches
+ my $empty_on_exit = $Self->{empty_on_exit} = int($Args{empty_on_exit} || 0);
+
+ # Need Scalar::Util::weaken to track open caches
+ if ($empty_on_exit) {
+ eval "use Scalar::Util qw(weaken); 1;"
+ || die "Could not load Scalar::Util module: $@";
}
# Work out expiry time in seconds
@@ -585,8 +598,8 @@
= @Args{qw(context read_cb write_cb delete_cb)};
@$Self{qw(cache_not_found allow_recursive write_back)}
= (@Args{qw(cache_not_found allow_recursive)}, $write_back);
- @$Self{qw(empty_on_exit unlink_on_exit enable_stats)}
- = (@Args{qw(empty_on_exit unlink_on_exit)}, $enable_stats);
+ @$Self{qw(unlink_on_exit enable_stats)}
+ = (@Args{qw(unlink_on_exit)}, $enable_stats);
# Save pid
$Self->{pid} = $$;
@@ -615,6 +628,10 @@
# And initialise it
$Cache->fc_init();
+ # Track cache if need to empty on exit
+ weaken($LiveCaches{ref($Self)} = $Self)
+ if $empty_on_exit;
+
# All done, return PERL hash ref as class
return $Self;
}
@@ -900,16 +917,23 @@
my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
my $Mode = $_[1] || 0;
+ my ($Compress, $RawValues) = @$Self{qw(compress raw_values)};
+
return $Cache->fc_get_keys($Mode)
- if $Mode <= 1 || ($Mode == 2 && $Self->{raw_values} && !$Self->{compress});
+ if $Mode <= 1 || ($Mode == 2 && $RawValues && !$Compress);
# If we're getting values as well, and they're not raw, unfreeze them
my @Details = $Cache->fc_get_keys(2);
+
for (@Details) {
- if (defined(my $Value = $_->{value})) {
- $Value = Compress::Zlib::memGunzip($Value) if $Self->{compress};
- $Value = ${thaw($Value)} if !$Self->{raw_values};
- $_->{value} = $Value;
+ my $Val = $_->{value};
+ if (defined $Val) {
+ $Val = Compress::Zlib::memGunzip($Val) if $Compress;
+ if (!$RawValues) {
+ $Val = eval { thaw($Val) };
+ $Val = $$Val if ref($Val);
+ }
+ $_->{value} = $Val;
}
}
return @Details;
@@ -1104,9 +1128,20 @@
my @WBItems = $Cache->fc_expunge($Mode, $write_cb ? 1 : 0, $Len);
+ my ($Compress, $RawValues) = @$Self{qw(compress raw_values)};
+
for (@WBItems) {
next if !($_->{flags} & FC_ISDIRTY);
- eval { $write_cb->($Self->{context}, $_->{key}, $_->{value}, $_->{expire_time}); };
+
+ my $Val = $_->{value};
+ if (defined $Val) {
+ $Val = Compress::Zlib::memGunzip($Val) if $Compress;
+ if (!$RawValues) {
+ $Val = eval { thaw($Val) };
+ $Val = $$Val if ref($Val);
+ }
+ }
+ eval { $write_cb->($Self->{context}, $_->{key}, $Val, $_->{expire_time}); };
}
}
@@ -1118,8 +1153,12 @@
return $expire_time =~ /^(\d+)\s*([mhdws]?)/i ? $1 * $Times{$2} : 0;
}
-sub DESTROY {
+sub cleanup {
my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
+
+ # Avoid potential double cleanup
+ return if $Self->{cleaned};
+ $Self->{cleaned} = 1;
# Expunge all entries on exit if requested and in parent process
if ($Self->{empty_on_exit} && $Cache && $Self->{pid} == $$) {
@@ -1134,6 +1173,21 @@
unlink($Self->{share_file})
if $Self->{unlink_on_exit} && $Self->{pid} == $$;
+
+}
+
+sub DESTROY {
+ my $Self = shift;
+ $Self->cleanup();
+ delete $LiveCaches{ref($Self)} if $Self->{empty_on_exit};
+}
+
+sub END {
+ while (my (undef, $Self) = each %LiveCaches) {
+ # Weak reference, might be undef already
+ $Self->cleanup() if $Self;
+ }
+ %LiveCaches = ();
}
sub CLONE {
@@ -1174,7 +1228,7 @@
Otherwise the defaults seem sensible to cleanup unneeded share files rather than
leaving them around to accumulate.
-=item After 1.28
+=item From 1.29
=over 4
@@ -1185,6 +1239,19 @@
=back
+=item From 1.31
+
+=over 4
+
+=item *
+
+Before 1.31, if you were using raw_values => 0 mode, then the write_cb
+would be called with raw frozen data, rather than the thawed object.
+From 1.31 onwards, it correctly calls write_cb with the thawed object
+value (eg what was passed to the ->set() call in the first place)
+
+=back
+
=back
=head1 SEE ALSO
Modified: branches/upstream/libcache-fastmmap-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/MANIFEST?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/MANIFEST (original)
+++ branches/upstream/libcache-fastmmap-perl/current/MANIFEST Thu Jun 18 22:33:05 2009
@@ -2,14 +2,14 @@
Cache-FastMmap-CImpl/CImpl.pm
Cache-FastMmap-CImpl/CImpl.xs
Cache-FastMmap-CImpl/Makefile.PL
-Cache-FastMmap-CImpl/unix.c
-Cache-FastMmap-CImpl/win32.c
Cache-FastMmap-CImpl/mmap_cache.c
Cache-FastMmap-CImpl/mmap_cache.h
Cache-FastMmap-CImpl/mmap_cache_internals.h
Cache-FastMmap-CImpl/mmap_cache_test.c
Cache-FastMmap-CImpl/ppport.h
Cache-FastMmap-CImpl/README
+Cache-FastMmap-CImpl/unix.c
+Cache-FastMmap-CImpl/win32.c
Changes
FastMmap.pm
Makefile.PL
@@ -22,6 +22,7 @@
t/12.t
t/13.t
t/14.t
+t/15.t
t/2.t
t/3.t
t/4.t
Modified: branches/upstream/libcache-fastmmap-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/META.yml?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/META.yml (original)
+++ branches/upstream/libcache-fastmmap-perl/current/META.yml Thu Jun 18 22:33:05 2009
@@ -1,11 +1,14 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Cache-FastMmap
-version: 1.30
-version_from: FastMmap.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Cache-FastMmap
+version: 1.33
+abstract: Uses an mmap'ed file to act as a shared memory interprocess cache
+license: ~
+author:
+ - Rob Mueller <cpan at robm.fastmail.fm>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Storable: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30_01
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Added: branches/upstream/libcache-fastmmap-perl/current/t/15.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/t/15.t?rev=38237&op=file
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/t/15.t (added)
+++ branches/upstream/libcache-fastmmap-perl/current/t/15.t Thu Jun 18 22:33:05 2009
@@ -1,0 +1,57 @@
+
+#########################
+
+use Test::More tests => 9;
+BEGIN { use_ok('Cache::FastMmap') };
+use Data::Dumper;
+use strict;
+
+#########################
+
+# Test writeback and cache_not_found option
+
+# Test a backing store just made of a local hash
+my %BackingStore = (
+ foo => { key1 => '123abc' },
+ bar => undef
+);
+
+my %OrigBackingStore = %BackingStore;
+
+my $RCBCalled = 0;
+
+my $FC = Cache::FastMmap->new(
+ cache_not_found => 1,
+ raw_values => 0,
+ init_file => 1,
+ num_pages => 89,
+ page_size => 1024,
+ context => \%BackingStore,
+ read_cb => sub { $RCBCalled++; return $_[0]->{$_[1]}; },
+ write_cb => sub { $_[0]->{$_[1]} = $_[2]; },
+ delete_cb => sub { delete $_[0]->{$_[1]} },
+ write_action => 'write_back'
+);
+
+ok( defined $FC );
+
+# Should pull from the backing store
+ok( eq_hash( $FC->get('foo'), { key1 => '123abc' } ), "cb get 1");
+is( $FC->get('bar'), undef, "cb get 2");
+is( $RCBCalled, 2, "cb get 2");
+
+# Should be in the cache now
+ok( eq_hash( $FC->get('foo'), { key1 => '123abc' } ), "cb get 3");
+is( $FC->get('bar'), undef, "cb get 4");
+is( $RCBCalled, 2, "cb get 2");
+
+# Need to make them dirty
+$FC->set('foo', { key1 => '123abc' });
+$FC->set('bar', undef);
+
+# Should force cache data back to backing store
+%BackingStore = ();
+$FC->empty();
+
+ok( eq_hash(\%BackingStore, \%OrigBackingStore), "items match 1" . Dumper(\%BackingStore, \%OrigBackingStore));
+
Modified: branches/upstream/libcache-fastmmap-perl/current/t/7.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-fastmmap-perl/current/t/7.t?rev=38237&op=diff
==============================================================================
--- branches/upstream/libcache-fastmmap-perl/current/t/7.t (original)
+++ branches/upstream/libcache-fastmmap-perl/current/t/7.t Thu Jun 18 22:33:05 2009
@@ -1,7 +1,7 @@
#########################
-use Test::More tests => 11;
+use Test::More tests => 13;
BEGIN { use_ok('Cache::FastMmap') };
use strict;
@@ -27,7 +27,8 @@
read_cb => sub { return $_[0]->{$_[1]}; },
write_cb => sub { $_[0]->{$_[1]} = $_[2]; },
delete_cb => sub { delete $_[0]->{$_[1]} },
- write_action => 'write_back'
+ write_action => 'write_back',
+ empty_on_exit => 1
);
ok( defined $FC );
@@ -92,6 +93,23 @@
# So all written items should be in backing store
ok( eq_hash(\%WrittenItems, \%BackingStore), "items match 3");
+my @Keys = $FC->get_keys(0);
+ok( scalar(@Keys) == 0, "no items left in cache" );
+
+%WrittenItems = %BackingStore = ();
+
+# Put 3000 items in the cache
+for (1 .. 3000) {
+ my ($Key, $Val) = (RandStr(10), RandStr(100));
+ $FC->set($Key, $Val);
+ $WrittenItems{$Key} = $Val;
+}
+
+# empty_on_exit is set, so this should push to backing store
+$FC = undef;
+
+ok( eq_hash(\%WrittenItems, \%BackingStore), "items match 4");
+
sub RandStr {
return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]);
}
More information about the Pkg-perl-cvs-commits
mailing list