Cache-FastMmap-1.44/0000755000000000000000000000000012723546254012663 5ustar rootrootCache-FastMmap-1.44/META.yml0000644000000000000000000000122712723546254014136 0ustar rootroot--- #YAML:1.0 name: Cache-FastMmap version: 1.44 abstract: Uses an mmap'ed file to act as a shared memory interprocess cache author: - Rob Mueller license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Storable: 0 resources: repository: https://github.com/robmueller/cache-fastmmap no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Cache-FastMmap-1.44/MANIFEST0000644000000000000000000000050612612316360014003 0ustar rootrootlib/Cache/FastMmap.pm FastMmap.xs mmap_cache.c mmap_cache.h mmap_cache_internals.h mmap_cache_test.c ppport.h unix.c win32.c Changes Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/1.t t/10.t t/11.t t/12.t t/13.t t/14.t t/15.t t/16.t t/2.t t/3.t t/4.t t/5.t t/6.t t/7.t t/8.t t/9.t t/FastMmapTest.pl Cache-FastMmap-1.44/t/0000755000000000000000000000000012723546254013126 5ustar rootrootCache-FastMmap-1.44/t/2.t0000644000000000000000000000533212612316360013445 0ustar rootroot ######################### use Test::More tests => 46; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new(init_file => 1, expire_time => 3, raw_values => 1); ok( defined $FC ); my $FC2 = Cache::FastMmap->new(init_file => 1, expire_time => 5, raw_values => 1); ok( defined $FC2 ); ok( $FC->set('abc', '123'), "expire set 1"); is( $FC->get('abc'), '123', "expire get 2"); ok( $FC2->set('abc', '123'), "expire set 3"); ok( $FC2->set('def', '123', 3), "expire set 4"); ok( $FC2->set('ghi', '123', 'now'), "expire set 5"); ok( $FC2->set('jkl', '123', 'never'), "expire set 6"); is( $FC2->get('abc'), '123', "expire get 7"); is( $FC2->get('def'), '123', "expire get 8"); is( $FC2->get('ghi'), '123', "expire get 9"); is( $FC2->get('jkl'), '123', "expire get 10"); sleep(2); ok( $FC->set('def', '456'), "expire set 11"); is( $FC->get('abc'), '123', "expire get 12"); is( $FC->get('def'), '456', "expire get 13"); is( $FC2->get('abc'), '123', "expire get 14"); is( $FC2->get('def'), '123', "expire get 15"); ok( !defined $FC2->get('ghi'), "expire get 16"); is( $FC2->get('jkl'), '123', "expire get 17"); sleep(2); ok( !defined $FC->get('abc'), "expire get 18"); is( $FC->get('def'), '456', "expire get 19"); is( $FC2->get('abc'), '123', "expire get 20"); ok( !defined $FC2->get('def'), "expire get 21"); ok( !defined $FC2->get('ghi'), "expire get 22"); is( $FC2->get('jkl'), '123', "expire get 23"); sleep(2); ok( !defined $FC->get('abc'), "expire get 24"); ok( !defined $FC->get('def'), "expire get 25"); ok( !defined $FC2->get('abc'), "expire get 26"); ok( !defined $FC2->get('def'), "expire get 27"); ok( !defined $FC2->get('ghi'), "expire get 28"); is( $FC2->get('jkl'), '123', "expire get 29"); ok( $FC->set('abc', '123', '1s'), "expire set 31"); ok( $FC->set('abc', '123', '1m'), "expire set 32"); ok( $FC->set('abc', '123', '1d'), "expire set 33"); ok( $FC->set('abc', '123', '1w'), "expire set 34"); ok( $FC->set('abc', '123', '1 second'), "expire set 41"); ok( $FC->set('abc', '123', '1 minute'), "expire set 42"); ok( $FC->set('abc', '123', '1 day'), "expire set 43"); ok( $FC->set('abc', '123', '1 week'), "expire set 44"); ok( $FC->set('abc', '123', 'now'), "expire set 45"); ok( $FC->set('abc', '123', 'never'), "expire set 46"); ok( $FC->set('abc', '123', 's'), "expire set 47"); ok( $FC->set('abc', '123', ''), "expire set 48"); ok( $FC->set('abc', '123', -1), "expire set 49"); ok( $FC->set('abc', '123', 'garbage'), "expire set 50"); Cache-FastMmap-1.44/t/6.t0000644000000000000000000000673512612316360013461 0ustar rootroot ######################### use Test::More; BEGIN { eval "use GTop ();"; if ($@) { plan skip_all => 'No GTop installed, no memory leak tests'; } else { plan tests => 10; } use_ok('Cache::FastMmap'); } use strict; my $GTop = GTop->new; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. our ($DidRead, $DidWrite, $DidDelete, $HitCount); our $FC; $FC = Cache::FastMmap->new(init_file => 0, raw_values => 1); $FC = undef; TestLeak(\&NewLeak, "new - 1"); TestLeak(\&NewLeak, "new - 2"); TestLeak(\&NewLeak2, "new2 - 1"); TestLeak(\&NewLeak2, "new2 - 2"); $FC = Cache::FastMmap->new( init_file => 1, raw_values => 1, num_pages => 17, page_size => 8192, read_cb => sub { $DidRead++; return undef; }, write_cb => sub { $DidWrite++; }, delete_cb => sub { $DidDelete++; }, write_action => 'write_back' ); ok( defined $FC ); # Prefill cache to make sure all pages mapped for (1 .. 2000) { $FC->set(RandStr(15), RandStr(10)); } $FC->get('foo'); our $Key = "blah100000blah"; our $Val = "\x{263A}" . RandStr(17); our $StartKey = 1; TestLeak(\&SetLeak, "set"); $StartKey = 1; TestLeak(\&GetLeak, "get"); $FC->clear(); $StartKey = 1; TestLeak(\&SetLeak, "set2"); our (@a, @b, @c); @a = $FC->get_keys(0); @b = $FC->get_keys(1); @c = $FC->get_keys(2); @a = @b = @c = (); ListLeak(); TestLeak(\&ListLeak, "list"); sub RandStr { return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]); } sub TestLeak { my $Sub = shift; my $Test = shift; my $Before = $GTop->proc_mem($$)->size; eval { $Sub->(); }; if ($@) { ok(0, "leak test died: $@"); } my $After = $GTop->proc_mem($$)->size; my $Extra = ($After - $Before)/1024; ok( $Extra < 30, "leak test $Extra > 30k - $Test"); } sub NewLeak { for (1 .. 1000) { $FC = Cache::FastMmap->new( init_file => 0, raw_values => 1, num_pages => 17, page_size => 8192, read_cb => sub { $DidRead++; return undef; }, write_cb => sub { $DidWrite++; }, delete_cb => sub { $DidDelete++; }, write_action => 'write_back' ); } $FC = undef; } sub NewLeak2 { for (1 .. 100) { $FC = Cache::FastMmap->new( init_file => 1, raw_values => 1, num_pages => 17, page_size => 8192, read_cb => sub { $DidRead++; return undef; }, write_cb => sub { $DidWrite++; }, delete_cb => sub { $DidDelete++; }, write_action => 'write_back' ); } $FC = undef; } sub SetLeak { for (1 .. 10000) { $Key = "blah" . $StartKey++ . "blah"; if ($_ < 9000) { $Val = RandStr(int(rand(15))+2); } elsif ($_ < 9500) { $Val = "\x{263A}" . RandStr(int(rand(15))+2); } else { $Val = undef; } $FC->set($Key, $Val); } } sub GetLeak { for (1 .. 20000) { $Key = "blah" . $StartKey++ . "blah"; $HitCount++ if $FC->get($Key); } } sub WBLeak { for (1 .. 5000) { $Key = "blah" . $StartKey++ . "blah"; if ($_ < 4000) { $Val = RandStr(int(rand(15))+2); } elsif ($_ < 4500) { $Val = "\x{263A}" . RandStr(int(rand(15))+2); } else { $Val = undef; } $FC->set($Key, $Val); my $PreDidWrite = $DidWrite; $FC->empty(); $PreDidWrite + 1 == $DidWrite || die "write count mismatch"; $FC->get($Key) && die "get success"; } } sub ListLeak { for (1 .. 100) { @a = $FC->get_keys(0); @b = $FC->get_keys(1); @c = $FC->get_keys(2); @a = @b = @c = (); } } Cache-FastMmap-1.44/t/15.t0000644000000000000000000000254612612316360013535 0ustar rootroot ######################### 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)); Cache-FastMmap-1.44/t/1.t0000644000000000000000000000761712612316360013454 0ustar rootroot ######################### use Test::More tests => 56; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new(init_file => 1, raw_values => 1); ok( defined $FC ); # Test empty cache ok( !defined $FC->get(''), "empty get('')" ); ok( !defined $FC->get(' '), "empty get(' ')" ); ok( !defined $FC->get(' ' x 1024), "empty get(' ' x 1024)" ); ok( !defined $FC->get(' ' x 65536), "empty get(' ' x 65536)" ); # Test basic store/get on key sizes ok( $FC->set('', 'abc'), "set('', 'abc')" ); is( $FC->get(''), 'abc', "get('') eq 'abc'"); ok( $FC->set(' ', 'def'), "set(' ', 'def')" ); is( $FC->get(' '), 'def', "get(' ') eq 'def'"); ok( $FC->set(' ' x 1024, 'ghi'), "set(' ' x 1024, 'ghi')"); is( $FC->get(' ' x 1024), 'ghi', "get(' ' x 1024) eq 'ghi'"); # Bigger than the page size - should not work ok( !$FC->set(' ' x 65536, 'jkl'), "set(' ' x 65536, 'jkl')"); ok( !defined $FC->get(' ' x 65536), "empty get(' ' x 65536)"); # Test basic store/get on value sizes ok( $FC->set('abc', ''), "set('abc', '')"); is( $FC->get('abc'), '', "get('abc') eq ''"); ok( $FC->set('def', 'x'), "set('def', 'x')"); is( $FC->get('def'), 'x', "get('def') eq 'x'"); ok( $FC->set('ghi', 'x' . ('y' x 1024) . 'z'), "set('ghi', ...)"); is( $FC->get('ghi'), 'x' . ('y' x 1024) . 'z', "get('ghi') eq ..."); # Bigger than the page size - should not work ok( !$FC->set('jkl', 'x' . ('y' x 65536) . 'z'), "set('jkl', ...)"); ok( !defined $FC->get('jkl'), "empty get('jkl')" ); # Ref key should use 'stringy' version my $Ref = [ ]; ok( $FC->set($Ref, 'abcd'), "set($Ref)" ); is( $FC->get($Ref), 'abcd', "get($Ref)" ); is( $FC->get("$Ref"), 'abcd', "get(\"$Ref\")" ); # Check UTF8 ok( $FC->set("key\x{263A}", "val"), "set utf8 key" ); is( $FC->get("key\x{263A}"), "val", "get utf8 key" ); ok( $FC->set("key", "val\x{263A}"), "set utf8 val" ); is( $FC->get("key"), "val\x{263A}", "get utf8 val" ); ok( $FC->set("key2\x{263A}", "val2\x{263A}"), "set utf8 key/val" ); is( $FC->get("key2\x{263A}"), "val2\x{263A}", "get utf8 key/val" ); # Check clearing actually works $FC->clear(); ok( !defined $FC->get('abc'), "post clear 1" ); ok( !defined $FC->get('def'), "post clear 2" ); ok( !defined $FC->get('ghi'), "post clear 3" ); ok( !defined $FC->get('jkl'), "post clear 4" ); ok( !defined $FC->get("key"), "post clear 5" ); ok( !defined $FC->get("key\x{263A}"), "post clear 6" ); ok( !defined $FC->get("key2\x{263A}"), "post clear 7" ); # Check getting key/value lists ok( $FC->set("abc", "123"), "get_keys set 1" ); ok( $FC->set("bcd", "234"), "get_keys set 2" ); ok( $FC->set("cde", "345"), "get_keys set 3" ); is( join(",", sort $FC->get_keys), "abc,bcd,cde", "get_keys 1"); my %keys = map { $_->{key} => $_ } $FC->get_keys(2); is( scalar(keys %keys), 3, "get_keys 2" ); is($keys{abc}->{value}, "123", "get_keys 3"); is($keys{bcd}->{value}, "234", "get_keys 4"); is($keys{cde}->{value}, "345", "get_keys 5"); # Test getting key/value lists with UTF8 $FC->set("def\x{263A}", "456\x{263A}"); is( join(",", sort $FC->get_keys), "abc,bcd,cde,def\x{263A}", "get_keys 6"); %keys = map { $_->{key} => $_ } $FC->get_keys(2); is( scalar(keys %keys), 4 , "get_keys 7"); is($keys{abc}->{value}, "123", "get_keys 8"); is($keys{bcd}->{value}, "234", "get_keys 9"); is($keys{cde}->{value}, "345", "get_keys 10"); is($keys{"def\x{263A}"}->{value}, "456\x{263A}", "get_keys 11"); # basic multi_* tests $FC->multi_set("page1", { k1 => 1, k2 => 2 }); $FC->multi_set("page2", { k3 => 1, k4 => 2 }); my $R = $FC->multi_get("page1", [ qw(k1 k2) ]); is($R->{k1}, 1, "multi_get 1"); is($R->{k2}, 2, "multi_get 2"); $R = $FC->multi_get("page2", [ qw(k3 k4) ]); is($R->{k3}, 1, "multi_get 3"); is($R->{k4}, 2, "multi_get 4"); Cache-FastMmap-1.44/t/FastMmapTest.pl0000755000000000000000000001444712612316360016036 0ustar rootroot#!/usr/local/bin/perl -w use lib '/home/mod_perl/hm/modules'; use ExtUtils::testlib; use Cache::FastMmap; use Data::Dumper; use POSIX ":sys_wait_h"; use strict; #EdgeTests(); my $FC = Cache::FastMmap->new( init_file => 1, raw_values => 1 ) || die "Could not create file cache"; BasicTests($FC); $FC->clear(); my @Keys; RepeatMixTest($FC, 0.0, \@Keys); RepeatMixTest($FC, 0.5, \@Keys); RepeatMixTest($FC, 0.8, \@Keys); ForkTests($FC); $FC = Cache::FastMmap->new( init_file => 1, page_size => 8192, raw_values => 1 ) || die "Could not create file cache"; BasicTests($FC); $FC->clear(); @Keys = (); RepeatMixTest($FC, 0.0, \@Keys); RepeatMixTest($FC, 0.5, \@Keys); RepeatMixTest($FC, 0.8, \@Keys); ForkTests($FC); print "All done\n"; exit(0); sub BasicTests { my $FC = shift; printf "Basic tests\n"; # Test empty !defined $FC->get('') || die "Not undef on empty get"; !defined $FC->get(' ') || die "Not undef on empty get"; !defined $FC->get(' ' x 1024) || die "Not undef on empty get"; !defined $FC->get(' ' x 65536) || die "Not undef on empty get"; # Test basic store/get on key sizes $FC->set('', 'abc'); $FC->get('') eq 'abc' || die "Get mismatch"; $FC->set(' ', 'def'); $FC->get(' ') eq 'def' || die "Get mismatch"; $FC->set(' ' x 1024, 'ghi'); $FC->get(' ' x 1024) eq 'ghi' || die "Get mismatch"; # Bigger than the page size - shouldn't work $FC->set(' ' x 65536, 'jkl'); !defined $FC->get(' ' x 65536) || die "Get mismatch"; # Test basic store/get on value sizes $FC->set('abc', ''); $FC->get('abc') eq '' || die "Get mismatch"; $FC->set('def', 'x'); $FC->get('def') eq 'x' || die "Get mismatch"; $FC->set('ghi', 'x' . ('y' x 1024) . 'z'); $FC->get('ghi') eq 'x' . ('y' x 1024) . 'z' || die "Get mismatch"; # Bigger than the page size - shouldn't work $FC->set('jkl', 'x' . ('y' x 65536) . 'z'); !defined $FC->get('jkl') || die "Get mismatch"; # Ref key should use 'stringy' version my $Ref = [ ]; $FC->set($Ref, 'abcd'); $FC->get($Ref) eq 'abcd' || die "Get mismatch"; $FC->get("$Ref") eq 'abcd' || die "Get mismatch"; # Check utf8 # eval { $FC->set("\x{263A}", "blah\x{263A}"); }; # $@ || die "Set utf8 succeeded, but should have failed: $@"; # eval { $FC->set("blah", "\x{263A}"); }; # $@ || die "Set utf8 succeeded, but should have failed: $@"; # eval { $FC->get("\x{263A}"); }; # $@ || die "Set utf8 succeeded, but should have failed: $@"; $FC->set("\x{263A}", "blah\x{263A}"); $FC->get("\x{263A}") eq "blah\x{263A}" || die "Get mismatch"; $FC->clear(); $FC->set("abc", "123"); $FC->set("bcd", "234"); $FC->set("cde", "345"); $FC->set("def", "456"); join(",", sort $FC->get_keys) eq "abc,bcd,cde,def" || die "get_keys mismatch"; $FC->set("efg\x{263A}", "567\x{263A}"); join(",", sort $FC->get_keys) eq "abc,bcd,cde,def,efg\x{263A}" || die "get_keys mismatch"; my %keys = map { $_->{key} => $_ } $FC->get_keys(2); $keys{abc}->{value} eq "123" || die "get_keys missing"; $keys{"efg\x{263A}"}->{value} eq "567\x{263A}" || die "get_keys missing"; } sub EdgeTests { my $FC = Cache::FastMmap->new( init_file => 1, num_pages => 1, raw_values => 1 ) || die "Could not create file cache"; printf "Edge tests. Assume implementation\n"; $FC->clear(); # bytes for kv data # 65536 - 8*4 - 4*4*89 = 64080 # adds 4*2 + 1 + 1 = 10 bytes, 64070 rem $FC->set('a', 'a'); $FC->get('a') eq 'a' || die "Get mismatch"; # Ensure oldest timestamp sleep 2; # adds 4*2 + 1 + 64051 = 64060, 10 rem $FC->set('b', 'b' x 64051); $FC->get('b') eq 'b' x 64051 || die "Get mismatch"; sleep 2; # adds 4*2 + 1 + 1 = 10 bytes, 0 rem $FC->set('c', 'c'); $FC->get('c') eq 'c' || die "Get mismatch"; $FC->get('b') eq 'b' x 64051 || die "Get mismatch"; $FC->get('a') eq 'a' || die "Get mismatch"; # adds 4*2 + 1 + 1 = 10 bytes, force expunge $FC->set('d', 'd'); !defined $FC->get('a') || die "Get mismatch"; !defined $FC->get('b') || die "Get mismatch"; $FC->get('d') eq 'd' || die "Get mismatch"; $FC->get('c') eq 'c' || die "Get mismatch"; # Try again $FC->clear(); # adds 4*2 + 1 + 1 = 10 bytes, 64070 rem $FC->set('a', 'a'); $FC->get('a') eq 'a' || die "Get mismatch"; # Ensure oldest timestamp sleep 2; # adds 4*2 + 1 + 64052 = 64061, 9 rem $FC->set('b', 'b' x 64052); $FC->get('b') eq 'b' x 64052 || die "Get mismatch"; sleep 2; # adds 4*2 + 1 + 1 = 10 bytes, -1 rem, force expunge $FC->set('c', 'c'); $FC->get('c') eq 'c' || die "Get mismatch"; !defined $FC->get('b') || die "Get mismatch"; !defined $FC->get('a') || die "Get mismatch"; # adds 4*2 + 1 + 1 = 10 bytes $FC->set('d', 'd'); $FC->get('d') eq 'd' || die "Get mismatch"; $FC->get('c') eq 'c' || die "Get mismatch"; } sub ForkTests { # Now fork several children to test cache concurrency my ($Pid, %Kids); for (my $j = 0; $j < 8; $j++) { if (!($Pid = fork())) { RepeatMixTest($FC, 0.4, \@Keys); exit; } $Kids{$Pid} = 1; select(undef, undef, undef, 0.001); } # Wait for children to finish my $Kid; do { $Kid = waitpid(-1, WNOHANG); delete $Kids{$Kid}; } until $Kid > 0 && !%Kids; } sub RepeatMixTest { my ($FC, $Ratio, $WroteKeys) = @_; print "Repeat mix tests\n"; my ($Read, $ReadHit); # Lots of random tests for (1 .. 10000) { # Read/write ratio if (rand() < $Ratio) { # Pick a key from known written ones my $K = $WroteKeys->[ rand(@$WroteKeys) ]; my $V = $FC->get($K); $Read++; # Skip if not found in cache next if !defined $V; $ReadHit++; # Offset of 10 past first chars of value are key substr($V, 10, length($K)) eq $K || die "Cache/key not equal: $K, $V"; } else { my $K = RandStr(16); my $V = RandStr(10) . $K . RandStr(int(rand(200))); push @$WroteKeys, $K; $FC->set($K, $V); } } printf "Read hit pct: %5.3f\n", ($ReadHit/$Read) if $Read; return; } sub RandStr { my $Len = shift; if (!$::URandom) { open($::URandom, '/dev/urandom') || die "Could not open /dev/urandom: $!"; } sysread($::URandom, my $D, $Len); $D =~ s/(.)/chr(ord($1) % 26 + ord('a'))/ge; return $D; } Cache-FastMmap-1.44/t/4.t0000644000000000000000000000407612612316360013453 0ustar rootroot ######################### use Test::More tests => 9; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # Test a backing store just made of a local hash my %BackingStore = ( foo => '123abc', bar => '456def' ); my %WrittenItems = %BackingStore; my $FC = Cache::FastMmap->new( raw_values => 1, init_file => 1, num_pages => 3, page_size => 32768, context => \%BackingStore, read_cb => sub { return $_[0]->{$_[1]}; }, write_cb => sub { $_[0]->{$_[1]} = $_[2]; }, delete_cb => sub { delete $_[0]->{$_[1]} }, write_action => 'write_back' ); ok( defined $FC ); srand(6543); # Put 100 items in the cache (should be big enough) for (1 .. 100) { my ($Key, $Val) = (RandStr(10), RandStr(100)); $FC->set($Key, $Val); $WrittenItems{$Key} = $Val; } # Should only be 2 items in the backing store ok( scalar(keys %BackingStore) == 2, "items match 1"); # Should flush back all the items to backing store $FC->empty(); # Get values in cache should be empty my %CacheItems = map { $_->{key} => $_->{value} } $FC->get_keys(2); ok( scalar(keys %CacheItems) == 0, "empty cache"); # Backing store should be equal to all items we wrote ok( eq_hash(\%WrittenItems, \%BackingStore), "items match 1"); # Should be able to read all items my $Failed = 0; for (keys %WrittenItems) { $Failed++ if $FC->get($_) ne $WrittenItems{$_}; } ok( $Failed == 0, "got all written items 1" ); # Empty backing store %BackingStore = (); # Should still be able to read all items $Failed = 0; for (keys %WrittenItems) { $Failed++ if $FC->get($_) ne $WrittenItems{$_}; } ok( $Failed == 0, "got all written items 2" ); # Now there should be nothing left $FC->clear(); %CacheItems = map { $_->{key} => $_->{value} } $FC->get_keys(2); ok( scalar(keys %CacheItems) == 0, "empty cache 2"); ok( scalar(keys %BackingStore) == 0, "empty backing store 1"); sub RandStr { return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]); } Cache-FastMmap-1.44/t/8.t0000644000000000000000000000265412612316360013457 0ustar rootroot ######################### use Test::More tests => 17; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new(init_file => 1, raw_values => 0); ok( defined $FC ); # Test empty cache ok( !defined $FC->get(''), "empty get('')" ); ok( $FC->set('123', 'abc'), "set('123', 'abc')" ); ok( $FC->get('123') eq 'abc', "get('123') eq 'abc'"); ok( $FC->set('123', undef), "set('123', undef)" ); ok( !defined $FC->get('123'), "!defined get('123')"); ok( $FC->set('123', [ 'abc' ]), "set('123', [ 'abc' ])" ); ok( eq_array($FC->get('123'), [ 'abc' ]), "get('123') eq [ 'abc' ]"); # Check UTF8 ok( $FC->set("key\x{263A}", [ "val\x{263A}" ]), "set utf8 key/val" ); ok( eq_array($FC->get("key\x{263A}"), [ "val\x{263A}" ]), "get utf8 key/val" ); is( join(",", sort $FC->get_keys), "123,key\x{263A}", "get_keys 1"); my %keys = map { $_->{key} => $_ } $FC->get_keys(2); is( scalar(keys %keys), 2, "get_keys 2" ); ok( eq_array($keys{123}->{value}, [ "abc" ]), "get_keys 3"); ok( eq_array($keys{"key\x{263A}"}->{value}, [ "val\x{263A}" ]), "get_keys 4"); # Check clearing actually works $FC->clear(); ok( !defined $FC->get('123'), "post clear 1" ); ok( !defined $FC->get("key\x{263A}"), "post clear 6" ); Cache-FastMmap-1.44/t/14.t0000644000000000000000000000151212612316360013524 0ustar rootroot ######################### use Test::More tests => 110; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new( enable_stats => 1 ); ok( defined $FC ); ok( !defined $FC->get("a") ); $FC->set("a", "b"); ok( $FC->get("a") eq "b" ); # Get 100 times for (1 .. 100) { ok( $FC->get("a") eq "b" ); } my ($nreads, $nreadhits) = $FC->get_statistics(); cmp_ok( $nreads, '==', 102 ); cmp_ok( $nreadhits, '==', 101 ); ($nreads, $nreadhits) = $FC->get_statistics(1); cmp_ok( $nreads, '==', 102 ); cmp_ok( $nreadhits, '==', 101 ); ($nreads, $nreadhits) = $FC->get_statistics(1); cmp_ok( $nreads, '==', 0 ); cmp_ok( $nreadhits, '==', 0 ); Cache-FastMmap-1.44/t/12.t0000644000000000000000000000305412612316360013525 0ustar rootroot ######################### our ($IsWin, $Tests); BEGIN { $IsWin = 0; $Tests = 7; if ($^O eq "MSWin32") { $IsWin = 1; $Tests -= 2; } } use Test::More tests => $Tests; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new(init_file => 1, raw_values => 1); ok( defined $FC ); # Check get_and_set() ok( $FC->set("cnt", 1), "set counter" ); is( $FC->get_and_set("cnt", sub { return ++$_[1]; }), 2, "get_and_set 1" ); is( $FC->get_and_set("cnt", sub { return ++$_[1]; }), 3, "get_and_set 2" ); # Basic atomicness test my $loops = 5000; if (!$IsWin) { $FC->set("cnt", 0); if (my $pid = fork()) { for (1 .. $loops) { $FC->get_and_set("cnt", sub { return ++$_[1]; }); } waitpid($pid, 0); is( $FC->get("cnt"), $loops*2, "get_and_set 1"); } else { for (1 .. $loops) { $FC->get_and_set("cnt", sub { return ++$_[1]; }); } CORE::exit(0); } } # Check get_and_remove() if (!$IsWin) { my $got_but_didnt_remove = 0; if (my $pid = fork()) { for (1..$loops) { $FC->set("cnt", "data"); my ($got, $did_remove) = $FC->get_and_remove("cnt"); # With atomicity, we should never get something out, but fail to remove something: $got_but_didnt_remove++ if $got && !$did_remove; } waitpid($pid, 0); is( $got_but_didnt_remove, 0, "get_and_remove 1" ); } else { for (1..$loops) { $FC->remove("cnt"); } CORE::exit(0); } } Cache-FastMmap-1.44/t/3.t0000644000000000000000000000351212612316360013444 0ustar rootroot ######################### use Test::More tests => 8; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new(init_file => 1, raw_values => 1); ok( defined $FC ); my (@Keys, $HitRate); $HitRate = RepeatMixTest($FC, 1000, 0.0, \@Keys); ok( $HitRate == 0.0, "hit rate 1"); $HitRate = RepeatMixTest($FC, 1000, 0.5, \@Keys); ok( $HitRate == 1.0, "hit rate 2"); $HitRate = RepeatMixTest($FC, 1000, 0.8, \@Keys); ok( $HitRate == 1.0, "hit rate 3"); $FC = undef; @Keys = (); # Should be repeatable srand(123456); $FC = Cache::FastMmap->new( init_file => 1, page_size => 8192, raw_values => 1 ); ok( defined $FC ); $HitRate = RepeatMixTest($FC, 1000, 0.0, \@Keys); ok( $HitRate == 0.0, "hit rate 1"); $HitRate = RepeatMixTest($FC, 10000, 0.5, \@Keys); ok( $HitRate > 0.8 && $HitRate < 0.95, "hit rate 4 - $HitRate"); sub RepeatMixTest { my ($FC, $NItems, $Ratio, $WroteKeys) = @_; my ($Read, $ReadHit); # Lots of random tests for (1 .. $NItems) { # Read/write ratio if (rand() < $Ratio) { # Pick a key from known written ones my $K = $WroteKeys->[ rand(@$WroteKeys) ]; my $V = $FC->get($K); $Read++; # Skip if not found in cache next if !defined $V; $ReadHit++; # Offset of 10 past first chars of value are key substr($V, 10, length($K)) eq $K || die "Cache/key not equal: $K, $V"; } else { my $K = RandStr(16); my $V = RandStr(10) . $K . RandStr(int(rand(200))); push @$WroteKeys, $K; $FC->set($K, $V); } } return $Read ? ($ReadHit/$Read) : 0.0; } sub RandStr { return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]); } Cache-FastMmap-1.44/t/16.t0000644000000000000000000000142412612316360013530 0ustar rootroot ######################### use Test::More tests => 3; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new( init_file => 1, raw_values => 0, num_pages => 1, page_size => 2 ** 15, ); ok( defined $FC ); my @d; for (1 .. 20) { $FC->set($_, $d[$_]=$_) for 1 .. 100; for (1 .. 50) { $FC->remove($_*2); $d[$_*2] = undef; $FC->set($_, $_*2); $d[$_] = $_*2; for my $c (1 .. 100) { my $v = $FC->get($c); ($v || 0) == ($d[$c] || 0) || die "at offset $c, got $v expected $d[$c]"; } } } ok(1, "ordering santity tests complete"); Cache-FastMmap-1.44/t/5.t0000644000000000000000000000337012612316360013450 0ustar rootroot ######################### use Test::More tests => 9; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # Test a backing store just made of a local hash my %BackingStore = ( foo => '123abc', bar => '456def' ); my %WrittenItems = %BackingStore; my $FC = Cache::FastMmap->new( raw_values => 1, init_file => 1, num_pages => 89, page_size => 2048, context => \%BackingStore, read_cb => sub { return $_[0]->{$_[1]}; }, write_cb => sub { $_[0]->{$_[1]} = $_[2]; }, delete_cb => sub { delete $_[0]->{$_[1]} }, write_action => 'write_through' ); ok( defined $FC ); srand(6543); # Put 3000 items in the cache for (1 .. 3000) { my ($Key, $Val) = (RandStr(10), RandStr(100)); $FC->set($Key, $Val); $WrittenItems{$Key} = $Val; } # Get values in cache my %CacheItems = map { $_->{key} => $_->{value} } $FC->get_keys(2); # Reality check approximate number of items in each ok( scalar(keys %BackingStore) == 3002, "backing store size 1" ); ok( scalar(keys %CacheItems) > 500, "backing store size 2" ); # Should be equal to all items we wrote ok( eq_hash(\%BackingStore, \%WrittenItems), "items match 1"); # Check we can get the items we wrote is( $FC->get('foo'), '123abc', "cb get 1"); is( $FC->get('bar'), '456def', "cb get 2"); # Read them forward and backward my $Failed = 0; for (keys %WrittenItems, reverse keys %WrittenItems) { $Failed++ if $FC->get($_) ne $WrittenItems{$_}; } ok( $Failed == 0, "got all written items" ); ok( eq_hash(\%WrittenItems, \%BackingStore), "items match 2"); sub RandStr { return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]); } Cache-FastMmap-1.44/t/10.t0000644000000000000000000000240612612316360013523 0ustar rootroot ######################### 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 => '123abc', bar => undef ); my %OrigBackingStore = %BackingStore; my $RCBCalled = 0; my $FC = Cache::FastMmap->new( cache_not_found => 1, raw_values => 1, 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 is( $FC->get('foo'), '123abc', "cb get 1"); is( $FC->get('bar'), undef, "cb get 2"); is( $RCBCalled, 2, "cb get 2"); # Should be in the cache now is( $FC->get('foo'), '123abc', "cb get 3"); is( $FC->get('bar'), undef, "cb get 4"); is( $RCBCalled, 2, "cb get 2"); $FC->set('foo', '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)); Cache-FastMmap-1.44/t/9.t0000644000000000000000000000304712612316360013455 0ustar rootroot ######################### use Test::More tests => 5; BEGIN { use_ok('Cache::FastMmap') }; use Storable qw(freeze thaw); use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $FC = Cache::FastMmap->new( page_size => 8192, num_pages => 3, init_file => 1, raw_values => 1 ); ok( defined $FC ); sub rand_str { return join '', map { chr(rand(26) + ord('a')) } 1 .. int($_[0]); } srand(123); my $Bad = 0; my @LastEntries; foreach my $i (1 .. 500) { my $K = rand_str(rand(10) + 10); my $V = rand_str(rand(20) + 20); $FC->set($K, $V); push @LastEntries, [ $K, $V ]; shift @LastEntries if @LastEntries > 25; foreach my $e (0 .. @LastEntries-1) { local $_ = $LastEntries[$e]; if ($_->[1] ne ($FC->get($_->[0]) || '')) { $Bad = 1; last; } } last if $Bad; select(undef, undef, undef, 0.01); } ok( !$Bad ); $FC = Cache::FastMmap->new( page_size => 8192, num_pages => 3, init_file => 1 ); ok( defined $FC ); $Bad = 0; @LastEntries = (); foreach my $i (1 .. 500) { my $K = rand_str(rand(10) + 10); my $V = [ rand_str(rand(20) + 20) ]; $FC->set($K, $V); push @LastEntries, [ $K, freeze($V) ]; shift @LastEntries if @LastEntries > 25; foreach my $e (0 .. @LastEntries-1) { local $_ = $LastEntries[$e]; if ($_->[1] ne freeze($FC->get($_->[0]) || [])) { $Bad = 1; last; } } last if $Bad; select(undef, undef, undef, 0.01); } ok( !$Bad ); Cache-FastMmap-1.44/t/11.t0000644000000000000000000000154512612316360013527 0ustar rootroot ######################### use Test::More tests => 7; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Test recursive cache use sub get_fc { my $FC; $FC = Cache::FastMmap->new( cache_not_found => 1, raw_values => 1, init_file => 1, num_pages => 89, page_size => 1024, read_cb => sub { $FC->get($_[1] . "1"); }, write_cb => sub { $FC->set($_[1] . "1", $_[2]); }, delete_cb => sub { $FC->delete($_[1]); }, write_action => 'write_back', @_ ); return $FC; } my $FC = get_fc(); ok( defined $FC ); $FC->set("foo1", "bar"); my $V = eval { $FC->get("foo"); }; ok(!$V, "no return"); like($@, qr/already locked/, "recurse fail"); $FC = undef; $FC = get_fc(allow_recursive => 1); ok( defined $FC ); $FC->set("foo1", "bar"); $V = eval { $FC->get("foo"); }; ok(!$@, "recurse success 1"); is($V, "bar", "recurse success 2"); Cache-FastMmap-1.44/t/13.t0000644000000000000000000000457612660462013013540 0ustar rootrootuse strict; use warnings; use Test::More; use Data::Dumper; $Data::Dumper::Deparse = 1; BEGIN { note 'Compression testing'; use_ok('Cache::FastMmap'); } my %compressors = ( lz4 => 'Compress::LZ4', snappy => 'Compress::Snappy', zlib => 'Compress::Zlib', ); for my $compressor ( keys %compressors ) { note " Testing with $compressors{$compressor}"; # Avoid prototype mismatch warnings if ( ! eval "require $compressors{$compressor};" ) { note " Cannot load $compressors{$compressor}: skipping tests: reason: $@"; next; } my $FC = Cache::FastMmap->new( page_size => 8192, num_pages => 1, init_file => 1, raw_values => 1, compressor => $compressor ); ok( defined $FC, 'create compressing cache' ); my $FCNC = Cache::FastMmap->new( page_size => 8192, num_pages => 1, init_file => 1, raw_values => 1, ); ok( defined $FCNC, 'create non-compressing cache of same size' ); my $K1 = rand_str(10); my $K2 = rand_str(10); my $V = rand_str(10) x 1000; ok( $FC->set($K1, $V), 'set() with large value in compressing cache' ); ok( $FC->set($K2, $V), 'also set() same value with different key' ); ok( !$FCNC->set($K1, $V), 'cannot set() same value in non-compressing cache' ); ok( !$FCNC->set($K2, $V), 'also fail to set() with different key' ); my $CV1 = $FC->get($K1); my $CV2 = $FC->get($K2); is( $CV1, $V, 'get() same large value from compressing cache' ); is( $CV2, $V, 'also get() same value with second key used' ); $CV1 = $FCNC->get($K1); $CV2 = $FCNC->get($K2); ok( !defined $CV1, 'cannot get() anything from non-compressing cache' ); ok( !defined $CV2, 'also fail to get() with second key used' ); } note ' Check support for deprecated `compress` param'; for ( 1, 'Compress::NonExistent', 'Compress::LZ4' ) { my $DCNC = Cache::FastMmap->new( page_size => 8192, num_pages => 1, init_file => 1, raw_values => 1, compress => $_, ); ok( defined $DCNC, 'create cache with `compress` param: ' . $_ ); my $wanted = quotemeta('&$uncompress(my $Tmp = shift())'); $wanted = qr/$wanted/; my $got = Dumper $DCNC->{uncompress}; like( $got, $wanted, 'using `Compress::Zlib` as compressor' ); } done_testing; sub rand_str { return join '', map { chr(rand(26) + ord('a')) } 1 .. int($_[0]); } __END__ Cache-FastMmap-1.44/t/7.t0000644000000000000000000000562312612316360013455 0ustar rootroot ######################### use Test::More tests => 13; BEGIN { use_ok('Cache::FastMmap') }; use strict; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # Test a backing store just made of a local hash my %BackingStore = ( foo => '123abc', bar => '456def' ); my %WrittenItems = %BackingStore; my $FC = Cache::FastMmap->new( raw_values => 1, init_file => 1, num_pages => 89, page_size => 1024, context => \%BackingStore, read_cb => sub { return $_[0]->{$_[1]}; }, write_cb => sub { $_[0]->{$_[1]} = $_[2]; }, delete_cb => sub { delete $_[0]->{$_[1]} }, write_action => 'write_back', empty_on_exit => 1 ); ok( defined $FC ); srand(6543); # Put 3000 items in the cache for (1 .. 3000) { my ($Key, $Val) = (RandStr(10), RandStr(100)); $FC->set($Key, $Val); $WrittenItems{$Key} = $Val; } # Get values in cache my %CacheItems = map { $_->{key} => $_->{value} } $FC->get_keys(2); # Reality check approximate number of items in each ok( scalar(keys %BackingStore) < 2700, "backing store size 1" ); ok( scalar(keys %CacheItems) > 300, "backing store size 2" ); # Merge with backing store items my %AllItems = (%BackingStore, %CacheItems); # Should be equal to all items we wrote ok( eq_hash(\%AllItems, \%WrittenItems), "items match 1"); # Check we can get the items we wrote is( $FC->get('foo'), '123abc', "cb get 1"); is( $FC->get('bar'), '456def', "cb get 2"); # Read them forward and backward, which should force # complete flush and read from backing store my $Failed = 0; for (keys %WrittenItems, reverse keys %WrittenItems) { $Failed++ if $FC->get($_) ne $WrittenItems{$_}; } ok( $Failed == 0, "got all written items 1" ); # Delete some items (should be random from cache/backing store) my @DelKeys = (keys %WrittenItems)[0 .. 300]; for (@DelKeys) { $FC->remove($_); delete $WrittenItems{$_}; } # Check it all matches again %CacheItems = map { $_->{key} => $_->{value} } $FC->get_keys(2); %AllItems = (%BackingStore, %CacheItems); ok( eq_hash(\%AllItems, \%WrittenItems), "items match 2"); $Failed = 0; for (keys %WrittenItems) { $Failed++ if $FC->get($_) ne $WrittenItems{$_}; } ok( $Failed == 0, "got all written items 2" ); # Force flushing of cache $FC->empty(); # 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]); } Cache-FastMmap-1.44/win32.c0000644000000000000000000001537512612316360013772 0ustar rootroot/* * AUTHOR * * Ash Berlin * * Based on code by * Rob Mueller * * COPYRIGHT AND LICENSE * * Copyright (C) 2007 by Ash Berlin * * This library is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * */ #include #include #include #include #include #include "mmap_cache.h" #include "mmap_cache_internals.h" #ifdef _MSC_VER #if _MSC_VER <= 1310 #define vsnprintf _vsnprintf #endif #endif char* _mmc_get_def_share_filename(mmap_cache * cache) { int ret; static char buf[MAX_PATH]; ret = GetTempPath(MAX_PATH, buf); if (ret > MAX_PATH) { _mmc_set_error(cache, GetLastError(), "Unable to get temp path"); return NULL; } return strcat(buf, "sharefile"); } int mmc_open_cache_file(mmap_cache* cache, int* do_init) { int i; void *tmp; HANDLE fh, fileMap, findHandle; WIN32_FIND_DATA statbuf; *do_init = 0; findHandle = FindFirstFile(cache->share_file, &statbuf); /* Create file if it doesn't exist */ if (findHandle == INVALID_HANDLE_VALUE) { fh = CreateFile(cache->share_file, GENERIC_WRITE, FILE_SHARE_WRITE, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, NULL); if (fh == INVALID_HANDLE_VALUE) { _mmc_set_error(cache, GetLastError(), "Create of share file %s failed", cache->share_file); return -1; } /* Fill file with 0's */ tmp = malloc(cache->c_page_size); if (!tmp) { _mmc_set_error(cache, GetLastError(), "Malloc of tmp space failed"); return -1; } memset(tmp, 0, cache->c_page_size); for (i = 0; i < cache->c_num_pages; i++) { DWORD tmpOut; WriteFile(fh, tmp, cache->c_page_size, &tmpOut, NULL); } free(tmp); /* Later on initialise page structures */ *do_init = 1; CloseHandle(fh); } else { FindClose(findHandle); if (cache->init_file || (statbuf.nFileSizeLow != cache->c_size)) { *do_init = 1; fh = CreateFile(cache->share_file, GENERIC_WRITE, FILE_SHARE_WRITE, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, NULL); if (fh == INVALID_HANDLE_VALUE) { _mmc_set_error(cache, GetLastError(), "Truncate of existing share file %s failed", cache->share_file); return -1; } CloseHandle(fh); } } fh = CreateFile(cache->share_file, // File Name GENERIC_READ|GENERIC_WRITE, // Desired Access FILE_SHARE_READ|FILE_SHARE_WRITE, // Share mode NULL, // Security Rights OPEN_EXISTING, // Creation Mode FILE_ATTRIBUTE_TEMPORARY, // File Attribs NULL); // Template File if (fh == INVALID_HANDLE_VALUE) { _mmc_set_error(cache, GetLastError(), "Open of share file \"%s\" failed", cache->share_file); return -1; } cache->fh = fh; return 0; } int mmc_map_memory(mmap_cache * cache) { HANDLE fileMap = CreateFileMapping(cache->fh, NULL, PAGE_READWRITE, 0, cache->c_size, NULL); if (fileMap == NULL) { _mmc_set_error(cache, GetLastError(), "CreateFileMapping of %s failed", cache->share_file); CloseHandle(cache->fh); return -1; } cache->mm_var = MapViewOfFile(fileMap, FILE_MAP_WRITE|FILE_MAP_READ, 0,0,0); if (cache->mm_var == NULL) { _mmc_set_error(cache, GetLastError(), "Mmap of shared file %s failed", cache->share_file); CloseHandle(fileMap); CloseHandle(cache->fh); return -1; } /* If I read the docs right, this will do nothing untill the mm_var is unmapped */ if (CloseHandle(fileMap) == FALSE) { _mmc_set_error(cache, GetLastError(), "CloseHandle(fileMap) on shared file %s failed", cache->share_file); UnmapViewOfFile(cache->mm_var); CloseHandle(fileMap); CloseHandle(cache->fh); return -1; } return 0; } int mmc_close_fh(mmap_cache* cache) { int ret = CloseHandle(cache->fh); cache->fh = NULL; return ret; } int mmc_unmap_memory(mmap_cache* cache) { int res = UnmapViewOfFile(cache->mm_var); if (res == -1) { _mmc_set_error(cache, GetLastError(), "Unmmap of shared file %s failed", cache->share_file); } return res; } int mmc_lock_page(mmap_cache* cache, MU32 p_offset) { OVERLAPPED lock; DWORD lock_res, bytesTransfered; memset(&lock, 0, sizeof(lock)); lock.Offset = p_offset; lock.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); if (LockFileEx(cache->fh, 0, 0, cache->c_page_size, 0, &lock) == 0) { _mmc_set_error(cache, GetLastError(), "LockFileEx failed"); return -1; } lock_res = WaitForSingleObjectEx(lock.hEvent, 10000, FALSE); if (lock_res != WAIT_OBJECT_0 || GetOverlappedResult(cache->fh, &lock, &bytesTransfered, FALSE) == FALSE) { CloseHandle(lock.hEvent); _mmc_set_error(cache, GetLastError(), "Overlapped Lock failed"); return -1; } return 0; } int mmc_unlock_page(mmap_cache* cache) { OVERLAPPED lock; memset(&lock, 0, sizeof(lock)); lock.Offset = cache->p_offset; lock.hEvent = 0; UnlockFileEx(cache->fh, 0, cache->c_page_size, 0, &lock); /* Set to bad value while page not locked */ cache->p_cur = ~0; /* ~0 = -1, but unsigned */ } /* * int _mmc_set_error(mmap_cache *cache, int err, char * error_string, ...) * * Set internal error string/state * */ int _mmc_set_error(mmap_cache *cache, int err, char * error_string, ...) { va_list ap; static char errbuf[1024]; char *msgBuff; va_start(ap, error_string); /* Make sure it's terminated */ errbuf[1023] = '\0'; /* Start with error string passed */ vsnprintf(errbuf, 1023, error_string, ap); /* Add system error code if passed */ if (err) { strncat(errbuf, ": ", 1024); FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL, err, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR) &msgBuff, 0, NULL ); strncat(errbuf, msgBuff, 1023); LocalFree(msgBuff); } /* Save in cache object */ cache->last_error = errbuf; va_end(ap); return 0; } Cache-FastMmap-1.44/FastMmap.xs0000644000000000000000000002544512612316360014747 0ustar rootroot#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include "mmap_cache.h" #define FC_UTF8VAL (1<<31) #define FC_UTF8KEY (1<<30) #define FC_UNDEF (1<<29) #define FC_ENTRY \ mmap_cache * cache; \ if (!SvROK(obj)) { \ croak("Object not reference"); \ XSRETURN_UNDEF; \ } \ obj = SvRV(obj); \ if (!SvIOKp(obj)) { \ croak("Object not initiliased correctly"); \ XSRETURN_UNDEF; \ } \ cache = INT2PTR(mmap_cache *, SvIV(obj) ); \ if (!cache) { \ croak("Object not created correctly"); \ XSRETURN_UNDEF; \ } MODULE = Cache::FastMmap PACKAGE = Cache::FastMmap PROTOTYPES: ENABLE SV * fc_new() INIT: mmap_cache * cache; SV * obj_pnt, * obj; CODE: cache = mmc_new(); /* Create integer which is pointer to cache object */ obj_pnt = newSViv(PTR2IV(cache)); /* Create reference to integer value. This will be the object */ obj = newRV_noinc((SV *)obj_pnt); RETVAL = obj; OUTPUT: RETVAL NO_OUTPUT int fc_set_param(obj, param, val) SV * obj; char * param; char * val; INIT: FC_ENTRY CODE: RETVAL = mmc_set_param(cache, param, val); POSTCALL: if (RETVAL != 0) { croak("%s", mmc_error(cache)); } NO_OUTPUT int fc_init(obj) SV * obj; INIT: FC_ENTRY CODE: RETVAL = mmc_init(cache); POSTCALL: if (RETVAL != 0) { croak("%s", mmc_error(cache)); } void fc_close(obj) SV * obj INIT: FC_ENTRY CODE: mmc_close(cache); sv_setiv(obj, 0); void fc_hash(obj, key); SV * obj; SV * key; INIT: int key_len; void * key_ptr; MU32 hash_page, hash_slot; STRLEN pl_key_len; FC_ENTRY PPCODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Hash key to get page and slot */ mmc_hash(cache, key_ptr, key_len, &hash_page, &hash_slot); XPUSHs(sv_2mortal(newSViv((IV)hash_page))); XPUSHs(sv_2mortal(newSViv((IV)hash_slot))); NO_OUTPUT int fc_lock(obj, page); SV * obj; UV page; INIT: FC_ENTRY CODE: RETVAL = mmc_lock(cache, (MU32)page); POSTCALL: if (RETVAL != 0) { croak("%s", mmc_error(cache)); } NO_OUTPUT int fc_unlock(obj); SV * obj; INIT: FC_ENTRY CODE: RETVAL = mmc_unlock(cache); POSTCALL: if (RETVAL != 0) { croak("%s", mmc_error(cache)); } int fc_is_locked(obj) SV * obj; INIT: FC_ENTRY CODE: /* Write value to cache */ RETVAL = mmc_is_locked(cache); OUTPUT: RETVAL void fc_read(obj, hash_slot, key) SV * obj; U32 hash_slot; SV * key; INIT: int key_len, val_len, found; void * key_ptr, * val_ptr; MU32 flags = 0; STRLEN pl_key_len; SV * val; FC_ENTRY PPCODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Get value data pointer */ found = mmc_read(cache, (MU32)hash_slot, key_ptr, key_len, &val_ptr, &val_len, &flags); /* If not found, use undef */ if (found == -1) { val = &PL_sv_undef; } else { /* Cached an undef value? */ if (flags & FC_UNDEF) { val = &PL_sv_undef; } else { /* Create PERL SV */ val = sv_2mortal(newSVpvn((const char *)val_ptr, val_len)); /* Make UTF8 if stored from UTF8 */ if (flags & FC_UTF8VAL) { SvUTF8_on(val); } } flags = flags & ~(FC_UTF8KEY | FC_UTF8VAL | FC_UNDEF); } XPUSHs(val); XPUSHs(sv_2mortal(newSViv((IV)flags))); XPUSHs(sv_2mortal(newSViv((IV)!found))); int fc_write(obj, hash_slot, key, val, expire_seconds, in_flags) SV * obj; U32 hash_slot; SV * key; SV * val; U32 expire_seconds; U32 in_flags; INIT: int key_len, val_len; void * key_ptr, * val_ptr; STRLEN pl_key_len, pl_val_len; FC_ENTRY CODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Check for storing undef, and store empty string with undef flag set */ if (!SvOK(val)) { in_flags |= FC_UNDEF; val_ptr = ""; val_len = 0; } else { /* Get key length, data pointer */ val_ptr = (void *)SvPV(val, pl_val_len); val_len = (int)pl_val_len; /* Set UTF8-ness flag of stored value */ if (SvUTF8(val)) { in_flags |= FC_UTF8VAL; } if (SvUTF8(key)) { in_flags |= FC_UTF8KEY; } } /* Write value to cache */ RETVAL = mmc_write(cache, (MU32)hash_slot, key_ptr, key_len, val_ptr, val_len, (MU32)expire_seconds, (MU32)in_flags); OUTPUT: RETVAL int fc_delete(obj, hash_slot, key) SV * obj; U32 hash_slot; SV * key; INIT: MU32 out_flags; int key_len, did_delete; void * key_ptr; STRLEN pl_key_len; FC_ENTRY PPCODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Write value to cache */ did_delete = mmc_delete(cache, (MU32)hash_slot, key_ptr, key_len, &out_flags); XPUSHs(sv_2mortal(newSViv((IV)did_delete))); XPUSHs(sv_2mortal(newSViv((IV)out_flags))); void fc_get_page_details(obj) SV * obj; INIT: MU32 nreads = 0, nreadhits = 0; FC_ENTRY PPCODE: mmc_get_page_details(cache, &nreads, &nreadhits); XPUSHs(sv_2mortal(newSViv((IV)nreads))); XPUSHs(sv_2mortal(newSViv((IV)nreadhits))); NO_OUTPUT void fc_reset_page_details(obj) SV * obj; INIT: MU32 nreads = 0, nreadhits = 0; FC_ENTRY CODE: mmc_reset_page_details(cache); void fc_expunge(obj, mode, wb, len) SV * obj; int mode; int wb; int len; INIT: MU32 new_num_slots = 0, ** to_expunge = 0; int num_expunge, item; void * key_ptr, * val_ptr; int key_len, val_len; MU32 last_access, expire_time, flags; FC_ENTRY PPCODE: num_expunge = mmc_calc_expunge(cache, mode, len, &new_num_slots, &to_expunge); if (to_expunge) { /* Want list of expunged keys/values? */ if (wb) { for (item = 0; item < num_expunge; item++) { mmc_get_details(cache, to_expunge[item], &key_ptr, &key_len, &val_ptr, &val_len, &last_access, &expire_time, &flags); { HV * ih = (HV *)sv_2mortal((SV *)newHV()); SV * key = newSVpvn((const char *)key_ptr, key_len); SV * val; if (flags & FC_UTF8KEY) { SvUTF8_on(key); flags ^= FC_UTF8KEY; } if (flags & FC_UNDEF) { val = newSV(0); flags ^= FC_UNDEF; } else { val = newSVpvn((const char *)val_ptr, val_len); if (flags & FC_UTF8VAL) { SvUTF8_on(val); flags ^= FC_UTF8VAL; } } /* Store in hash ref */ hv_store(ih, "key", 3, key, 0); hv_store(ih, "value", 5, val, 0); hv_store(ih, "last_access", 11, newSViv((IV)last_access), 0); hv_store(ih, "expire_time", 11, newSViv((IV)expire_time), 0); hv_store(ih, "flags", 5, newSViv((IV)flags), 0); /* Create reference to hash */ XPUSHs(sv_2mortal(newRV((SV *)ih))); } } } mmc_do_expunge(cache, num_expunge, new_num_slots, to_expunge); } void fc_get_keys(obj, mode) SV * obj; int mode; INIT: mmap_cache_it * it; MU32 * entry_ptr; void * key_ptr, * val_ptr; int key_len, val_len; MU32 last_access, expire_time, flags; FC_ENTRY PPCODE: it = mmc_iterate_new(cache); /* Iterate over all items */ while (entry_ptr = mmc_iterate_next(it)) { SV * key; mmc_get_details(cache, entry_ptr, &key_ptr, &key_len, &val_ptr, &val_len, &last_access, &expire_time, &flags); /* Create key SV, and set UTF8'ness if needed */ key = newSVpvn((const char *)key_ptr, key_len); if (flags & FC_UTF8KEY) { SvUTF8_on(key); flags ^= FC_UTF8KEY; } /* Mode 0 is just list of keys */ if (mode == 0) { XPUSHs(sv_2mortal(key)); /* Mode 1/2 is list of hash-refs */ } else if (mode == 1 || mode == 2) { HV * ih = (HV *)sv_2mortal((SV *)newHV()); /* These things by default */ hv_store(ih, "key", 3, key, 0); hv_store(ih, "last_access", 11, newSViv((IV)last_access), 0); hv_store(ih, "expire_time", 11, newSViv((IV)expire_time), 0); hv_store(ih, "flags", 5, newSViv((IV)flags), 0); /* Add value to hash-ref if mode 2 */ if (mode == 2) { SV * val; if (flags & FC_UNDEF) { val = newSV(0); flags ^= FC_UNDEF; } else { val = newSVpvn((const char *)val_ptr, val_len); if (flags & FC_UTF8VAL) { SvUTF8_on(val); flags ^= FC_UTF8VAL; } } hv_store(ih, "value", 5, val, 0); } /* Create reference to hash */ XPUSHs(sv_2mortal(newRV((SV *)ih))); } } mmc_iterate_close(it); SV * fc_get(obj, key) SV * obj; SV * key; INIT: int key_len, val_len, found; void * key_ptr, * val_ptr; MU32 hash_page, hash_slot, flags; STRLEN pl_key_len; SV * val; FC_ENTRY CODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Hash key to get page and slot */ mmc_hash(cache, key_ptr, key_len, &hash_page, &hash_slot); /* Get and lock the page */ mmc_lock(cache, hash_page); /* Get value data pointer */ found = mmc_read(cache, hash_slot, key_ptr, key_len, &val_ptr, &val_len, &flags); /* If not found, use undef */ if (found == -1) { val = &PL_sv_undef; } else { /* Create PERL SV */ val = newSVpvn((const char *)val_ptr, val_len); } mmc_unlock(cache); RETVAL = val; OUTPUT: RETVAL void fc_set(obj, key, val) SV * obj; SV * key; SV * val; INIT: int key_len, val_len, found; void * key_ptr, * val_ptr; MU32 hash_page, hash_slot, flags = 0; STRLEN pl_key_len, pl_val_len; FC_ENTRY CODE: /* Get key length, data pointer */ key_ptr = (void *)SvPV(key, pl_key_len); key_len = (int)pl_key_len; /* Get key length, data pointer */ val_ptr = (void *)SvPV(val, pl_val_len); val_len = (int)pl_val_len; /* Hash key to get page and slot */ mmc_hash(cache, key_ptr, key_len, &hash_page, &hash_slot); /* Get and lock the page */ mmc_lock(cache, hash_page); /* Get value data pointer */ mmc_write(cache, hash_slot, key_ptr, key_len, val_ptr, val_len, -1, flags); mmc_unlock(cache); NO_OUTPUT void fc_dump_page(obj); SV * obj; INIT: FC_ENTRY CODE: _mmc_dump_page(cache); Cache-FastMmap-1.44/README0000644000000000000000000000147012612320711013526 0ustar rootrootCache::FastMmap =========================== A shared memory cache through an mmap'ed file. It's core is written in C for performance. It uses fcntl locking to ensure multiple processes can safely access the cache at the same time. It uses a basic LRU algorithm to keep the most used entries in the cache. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES Storable if you want to store complex structures AUTHOR Rob Mueller DOCUMENTATION See the POD documentation. Viewable online at CPAN http://search.cpan.org/~robm/Cache-FastMmap/ COPYRIGHT AND LICENCE Copyright (C) 2003-2015 by FastMail Pty Ltd This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Cache-FastMmap-1.44/unix.c0000644000000000000000000001271612723540511014007 0ustar rootroot /* * AUTHOR * * Rob Mueller * * COPYRIGHT AND LICENSE * * Copyright (C) 2003 by FastMail IP Partners * * This library is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * */ #include #include #include #include #include #include #include #include #include #include #include #include "mmap_cache.h" #include "mmap_cache_internals.h" char* _mmc_get_def_share_filename(mmap_cache * cache) { return def_share_file; } int mmc_open_cache_file(mmap_cache* cache, int * do_init) { int res, i, fh; void * tmp; struct stat statbuf; /* Check if file exists */ res = stat(cache->share_file, &statbuf); /* Remove if different size or remove requested */ if (!res && (cache->init_file || (statbuf.st_size != cache->c_size))) { res = remove(cache->share_file); if (res == -1 && errno != ENOENT) { _mmc_set_error(cache, errno, "Unlink of existing share file %s failed", cache->share_file); return -1; } } /* Create file if it doesn't exist */ *do_init = 0; res = stat(cache->share_file, &statbuf); if (res == -1) { res = open(cache->share_file, O_WRONLY | O_CREAT | O_EXCL | O_TRUNC | O_APPEND, 0640); if (res == -1) { _mmc_set_error(cache, errno, "Create of share file %s failed", cache->share_file); return -1; } /* Fill file with 0's */ tmp = malloc(cache->c_page_size); if (!tmp) { _mmc_set_error(cache, errno, "Malloc of tmp space failed"); return -1; } memset(tmp, 0, cache->c_page_size); for (i = 0; i < cache->c_num_pages; i++) { int written = write(res, tmp, cache->c_page_size); if (written < 0) { _mmc_set_error(cache, errno, "Write to share file %s failed", cache->share_file); return -1; } if (written < cache->c_page_size) { _mmc_set_error(cache, errno, "Write to share file %s failed; short write (%d of %d bytes written)", cache->share_file, written, cache->c_page_size); return -1; } } free(tmp); /* Later on initialise page structures */ *do_init = 1; close(res); } /* Open for reading/writing */ fh = open(cache->share_file, O_RDWR); if (fh == -1) { _mmc_set_error(cache, errno, "Open of share file %s failed", cache->share_file); return -1; } /* Automatically close cache fd on exec */ fcntl(fh, F_SETFD, FD_CLOEXEC); cache->fh = fh; return 0; } /* * mmc_map_memory(mmap_cache * cache) * * maps the cache file into memory, and sets cache->mm_var as needed. */ int mmc_map_memory(mmap_cache* cache) { /* Map file into memory */ cache->mm_var = mmap(0, cache->c_size, PROT_READ | PROT_WRITE, MAP_SHARED, cache->fh, 0); if (cache->mm_var == (void *)MAP_FAILED) { mmc_close_fh(cache); _mmc_set_error(cache, errno, "Mmap of shared file %s failed", cache->share_file); return -1; } return 0; } /* * mmc_unmap_memory(mmap_cache * cache) * * Unmaps cache->mm_var */ int mmc_unmap_memory(mmap_cache* cache) { int res = munmap(cache->mm_var, cache->c_size); if (res == -1) { _mmc_set_error(cache, errno, "Munmap of shared file %s failed", cache->share_file); return -1; } return res; } int mmc_close_fh(mmap_cache* cache) { int res = close(cache->fh); return res; } int mmc_lock_page(mmap_cache* cache, MU32 p_offset) { struct flock lock; int old_alarm, alarm_left = 10; int lock_res = -1; /* Setup fcntl locking structure */ lock.l_type = F_WRLCK; lock.l_whence = SEEK_SET; lock.l_start = p_offset; lock.l_len = cache->c_page_size; if (cache->catch_deadlocks) old_alarm = alarm(alarm_left); while (lock_res != 0) { /* Lock the page (block till done, signal, or timeout) */ lock_res = fcntl(cache->fh, F_SETLKW, &lock); /* Continue immediately if success */ if (lock_res == 0) { if (cache->catch_deadlocks) alarm(old_alarm); break; } /* Turn off alarm for a moment */ if (cache->catch_deadlocks) alarm_left = alarm(0); /* Some signal interrupted, and it wasn't the alarm? Rerun lock */ if (lock_res == -1 && errno == EINTR && alarm_left) { if (cache->catch_deadlocks) alarm(alarm_left); continue; } /* Lock failed? */ _mmc_set_error(cache, errno, "Lock failed"); if (cache->catch_deadlocks) alarm(old_alarm); return -1; } return 0; } int mmc_unlock_page(mmap_cache * cache) { struct flock lock; /* Setup fcntl locking structure */ lock.l_type = F_UNLCK; lock.l_whence = SEEK_SET; lock.l_start = cache->p_offset; lock.l_len = cache->c_page_size; /* And unlock page */ fcntl(cache->fh, F_SETLKW, &lock); /* Set to bad value while page not locked */ cache->p_cur = -1; return 0; } /* * int _mmc_set_error(mmap_cache *cache, int err, char * error_string, ...) * * Set internal error string/state * */ int _mmc_set_error(mmap_cache *cache, int err, char * error_string, ...) { va_list ap; static char errbuf[1024]; va_start(ap, error_string); /* Make sure it's terminated */ errbuf[1023] = '\0'; /* Start with error string passed */ vsnprintf(errbuf, 1023, error_string, ap); /* Add system error code if passed */ if (err) { strncat(errbuf, ": ", 1024); strncat(errbuf, strerror(err), 1023); } /* Save in cache object */ cache->last_error = errbuf; va_end(ap); return 0; } Cache-FastMmap-1.44/Makefile.PL0000644000000000000000000000122312612316360014621 0ustar rootrootuse 5.006; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Cache::FastMmap', 'VERSION_FROM' => 'lib/Cache/FastMmap.pm', 'ABSTRACT_FROM' => 'lib/Cache/FastMmap.pm', 'AUTHOR' => 'Rob Mueller ', 'PREREQ_PM' => { 'Storable' => 0, }, 'LIBS' => [''], 'INC' => '-I.', 'OBJECT' => 'FastMmap.o mmap_cache.o ' . ($^O eq 'MSWin32' ? 'win32.o' : 'unix.o'), 'META_MERGE' => { 'resources' => { 'repository' => 'https://github.com/robmueller/cache-fastmmap', }, }, # 'OPTIMIZE' => '-g -DDEBUG -ansi -pedantic', ); Cache-FastMmap-1.44/mmap_cache.c0000644000000000000000000010004612612316360015073 0ustar rootroot /* * AUTHOR * * Rob Mueller * * COPYRIGHT AND LICENSE * * Copyright (C) 2003 by FastMail IP Partners * * This library is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * */ #include #include #include #include #include #include #include "mmap_cache.h" #include "mmap_cache_internals.h" /* Default values for a new cache */ char * def_share_file = "/tmp/sharefile"; MU32 def_init_file = 0; MU32 def_test_file = 0; MU32 def_expire_time = 0; MU32 def_c_num_pages = 89; MU32 def_c_page_size = 65536; MU32 def_start_slots = 89; /* * mmap_cache * mmc_new() * * Create a new cache object filled with default values. Values may * be changed and once ready, you should call mmc_init() to actually * open the cache file and mmap it. * */ mmap_cache * mmc_new() { mmap_cache * cache = (mmap_cache *)malloc(sizeof(mmap_cache)); cache->mm_var = 0; cache->p_cur = -1; cache->c_num_pages = def_c_num_pages; cache->c_page_size = def_c_page_size; cache->c_size = 0; cache->start_slots = def_start_slots; cache->expire_time = def_expire_time; cache->fh = 0; cache->share_file = _mmc_get_def_share_filename(cache); cache->init_file = def_init_file; cache->test_file = def_test_file; cache->catch_deadlocks = 0; cache->enable_stats = 0; cache->last_error = 0; return cache; } int mmc_set_param(mmap_cache * cache, char * param, char * val) { if (!strcmp(param, "init_file")) { cache->init_file = atoi(val); } else if (!strcmp(param, "test_file")) { cache->test_file = atoi(val); } else if (!strcmp(param, "page_size")) { cache->c_page_size = atoi(val); } else if (!strcmp(param, "num_pages")) { cache->c_num_pages = atoi(val); } else if (!strcmp(param, "expire_time")) { cache->expire_time = atoi(val); } else if (!strcmp(param, "share_file")) { cache->share_file = val; } else if (!strcmp(param, "start_slots")) { cache->start_slots = atoi(val); } else if (!strcmp(param, "catch_deadlocks")) { cache->catch_deadlocks = atoi(val); } else if (!strcmp(param, "enable_stats")) { cache->enable_stats = atoi(val); } else { _mmc_set_error(cache, 0, "Bad set_param parameter: %s", param); return -1; } return 0; } int mmc_get_param(mmap_cache * cache, char * param) { if (!strcmp(param, "page_size")) { return (int)cache->c_page_size; } else if (!strcmp(param, "num_pages")) { return (int)cache->c_num_pages; } else if (!strcmp(param, "expire_time")) { return (int)cache->expire_time; } else { _mmc_set_error(cache, 0, "Bad set_param parameter: %s", param); return -1; } } /* * int mmc_init(mmap_cache * cache) * * Initialise the cache object, opening the share file and mmap'ing any * memory. * */ int mmc_init(mmap_cache * cache) { int i, do_init; MU32 c_num_pages, c_page_size, c_size, start_slots; /* Need a share file */ if (!cache->share_file) { _mmc_set_error(cache, 0, "No share file specified"); return -1; } /* Basic cache params */ c_num_pages = cache->c_num_pages; ASSERT(c_num_pages >= 1 && c_num_pages <= 1000); c_page_size = cache->c_page_size; ASSERT(c_page_size >= 1024 && c_page_size <= 16*1024*1024); start_slots = cache->start_slots; ASSERT(start_slots >= 10 && start_slots <= 500); cache->c_size = c_size = c_num_pages * c_page_size; if ( mmc_open_cache_file(cache, &do_init) == -1) return -1; /* Map file into memory */ if ( mmc_map_memory(cache) == -1) return -1; /* Initialise pages if new file */ if (do_init) { _mmc_init_page(cache, -1); /* Unmap and re-map to stop gtop telling us our memory usage is up */ if ( mmc_unmap_memory(cache) == -1) return -1; if ( mmc_map_memory(cache) == -1) return -1; } /* Test pages in file if asked */ if (cache->test_file) { for (i = 0; i < cache->c_num_pages; i++) { int lock_page = 0, bad_page = 0; /* Need to lock page, which tests header structure */ if (mmc_lock(cache, i)) { bad_page = 1; /* If lock succeeded, test page structure */ } else { lock_page = 1; if (!_mmc_test_page(cache)) { bad_page = 1; } } /* If we locked, unlock */ if (lock_page) { mmc_unlock(cache); } /* A bad page, initialise it */ if (bad_page) { _mmc_init_page(cache, i); /* Rerun test on this page, potential infinite loop if init_page is broken, but then things are really broken anyway */ i--; } } } return 0; } /* * int mmc_close(mmap_cache * cache) * * Close the given cache, unmmap'ing any memory and closing file * descriptors. * */ int mmc_close(mmap_cache *cache) { int res; /* Shouldn't call if not init'ed */ ASSERT(cache->fh); ASSERT(cache->mm_var); /* Shouldn't call if page still locked */ ASSERT(cache->p_cur == -1); /* Unlock any locked page */ if (cache->p_cur != -1) { mmc_unlock(cache); } /* Close file */ if (cache->fh) { mmc_close_fh(cache); } /* Unmap memory */ if (cache->mm_var) { res = mmc_unmap_memory(cache); if (res == -1) { _mmc_set_error(cache, errno, "Mmap of shared file %s failed", cache->share_file); return -1; } } free(cache); return 0; } char * mmc_error(mmap_cache * cache) { if (cache->last_error) return cache->last_error; return "Unknown error"; } /* * mmc_lock( * cache_mmap * cache, MU32 p_cur * ) * * Lock the given page number using fcntl locking. Setup * cache->p_* fields with correct values for the given page * */ int mmc_lock(mmap_cache * cache, MU32 p_cur) { MU32 p_offset; void * p_ptr; /* Argument sanity check */ if (p_cur > cache->c_num_pages) return -1 + _mmc_set_error(cache, 0, "page %u is larger than number of pages", p_cur); /* Check not already locked */ if (cache->p_cur != -1) return -1 + _mmc_set_error(cache, 0, "page %u is already locked, can't lock multiple pages", cache->p_cur); /* Setup page details */ p_offset = p_cur * cache->c_page_size; p_ptr = PTR_ADD(cache->mm_var, p_offset); if (mmc_lock_page(cache, p_offset) == -1) return -1; if (!(P_Magic(p_ptr) == 0x92f7e3b1)) return -1 + _mmc_set_error(cache, 0, "magic page start marker not found. p_cur is %u, offset is %u", p_cur, p_offset); /* Copy to cache structure */ cache->p_num_slots = P_NumSlots(p_ptr); cache->p_free_slots = P_FreeSlots(p_ptr); cache->p_old_slots = P_OldSlots(p_ptr); cache->p_free_data = P_FreeData(p_ptr); cache->p_free_bytes = P_FreeBytes(p_ptr); cache->p_n_reads = P_NReads(p_ptr); cache->p_n_read_hits = P_NReadHits(p_ptr); /* Reality check */ if (cache->p_num_slots < 89 || cache->p_num_slots > cache->c_page_size) return -1 + _mmc_set_error(cache, 0, "cache num_slots mistmatch"); if (cache->p_free_slots < 0 || cache->p_free_slots > cache->p_num_slots) return -1 + _mmc_set_error(cache, 0, "cache free slots mustmatch"); if (cache->p_old_slots > cache->p_free_slots) return -1 + _mmc_set_error(cache, 0, "cache old slots mistmatch"); if (cache->p_free_data + cache->p_free_bytes != cache->c_page_size) return -1 + _mmc_set_error(cache, 0, "cache free data mistmatch"); /* Check page header */ ASSERT(P_Magic(p_ptr) == 0x92f7e3b1); ASSERT(P_NumSlots(p_ptr) >= 89 && P_NumSlots(p_ptr) < cache->c_page_size); ASSERT(P_FreeSlots(p_ptr) >= 0 && P_FreeSlots(p_ptr) <= P_NumSlots(p_ptr)); ASSERT(P_OldSlots(p_ptr) <= P_FreeSlots(p_ptr)); ASSERT(P_FreeData(p_ptr) + P_FreeBytes(p_ptr) == cache->c_page_size); /* Setup page pointers */ cache->p_cur = p_cur; cache->p_offset = p_cur * cache->c_page_size; cache->p_base = p_ptr; cache->p_base_slots = PTR_ADD(p_ptr, P_HEADERSIZE); ASSERT(_mmc_test_page(cache)); return 0; } /* * mmc_unlock( * cache_mmap * cache * ) * * Unlock any currently locked page * */ int mmc_unlock(mmap_cache * cache) { ASSERT(cache->p_cur != -1); /* If changed, save page header changes back */ if (cache->p_changed) { void * p_ptr = cache->p_base; /* Save any changed information back to page */ P_NumSlots(p_ptr) = cache->p_num_slots; P_FreeSlots(p_ptr) = cache->p_free_slots; P_OldSlots(p_ptr) = cache->p_old_slots; P_FreeData(p_ptr) = cache->p_free_data; P_FreeBytes(p_ptr) = cache->p_free_bytes; P_NReads(p_ptr) = cache->p_n_reads; P_NReadHits(p_ptr) = cache->p_n_read_hits; } /* Test before unlocking */ ASSERT(_mmc_test_page(cache)); mmc_unlock_page(cache); return 0; } /* * mmc_is_locked( * cache_mmap * cache * ) * * Return true if page is locked * */ int mmc_is_locked(mmap_cache * cache) { return cache->p_cur != -1 ? 1 : 0; } /* * int mmc_hash( * cache_mmap * cache, * void *key_ptr, int key_len, * MU32 *hash_page, MU32 *hash_slot * ) * * Hashes the given key, and returns hash value, hash page and hash * slot part * */ int mmc_hash( mmap_cache *cache, void *key_ptr, int key_len, MU32 *hash_page, MU32 *hash_slot ) { MU32 h = 0x92f7e3b1; unsigned char * uc_key_ptr = (unsigned char *)key_ptr; unsigned char * uc_key_ptr_end = uc_key_ptr + key_len; while (uc_key_ptr != uc_key_ptr_end) { h = (h << 4) + (h >> 28) + *uc_key_ptr++; } *hash_page = h % cache->c_num_pages; *hash_slot = h / cache->c_num_pages; return 0; } /* * int mmc_read( * cache_mmap * cache, MU32 hash_slot, * void *key_ptr, int key_len, * void **val_ptr, int *val_len, * MU32 *flags * ) * * Read key from current page * */ int mmc_read( mmap_cache *cache, MU32 hash_slot, void *key_ptr, int key_len, void **val_ptr, int *val_len, MU32 *flags ) { MU32 * slot_ptr; /* Increase read count for page */ if (cache->enable_stats) { cache->p_changed = 1; cache->p_n_reads++; } /* Search slots for key */ slot_ptr = _mmc_find_slot(cache, hash_slot, key_ptr, key_len, 0); /* Did we find a value? */ if (!slot_ptr || *slot_ptr == 0) { /* Return -1 if not */ return -1; /* We found it! Check some other things... */ } else { MU32 * base_det = S_Ptr(cache->p_base, *slot_ptr); MU32 now = (MU32)time(0); MU32 expire_time = S_ExpireTime(base_det); /* Sanity check hash matches */ ASSERT(S_SlotHash(base_det) == hash_slot); /* Value expired? */ if (expire_time && now > expire_time) { /* Delete slot and return not found */ _mmc_delete_slot(cache, slot_ptr); ASSERT(*slot_ptr == 1); return -1; } /* Update hit time */ S_LastAccess(base_det) = now; /* Copy values to pointers */ *flags = S_Flags(base_det); *val_len = S_ValLen(base_det); *val_ptr = S_ValPtr(base_det); /* Increase read hit count */ if (cache->enable_stats) cache->p_n_read_hits++; return 0; } } /* * int mmc_write( * cache_mmap * cache, MU32 hash_slot, * void *key_ptr, int key_len, * void *val_ptr, int val_len, * MU32 expire_seconds, MU32 flags * ) * * Write key to current page * */ int mmc_write( mmap_cache *cache, MU32 hash_slot, void *key_ptr, int key_len, void *val_ptr, int val_len, MU32 expire_seconds, MU32 flags ) { int did_store = 0; MU32 kvlen = KV_SlotLen(key_len, val_len); /* Search for slot with given key */ MU32 * slot_ptr = _mmc_find_slot(cache, hash_slot, key_ptr, key_len, 1); /* If all slots full, definitely can't store */ if (!slot_ptr) return 0; ROUNDLEN(kvlen); ASSERT(cache->p_cur != -1); /* If found, delete slot for new value */ if (*slot_ptr > 1) { _mmc_delete_slot(cache, slot_ptr); ASSERT(*slot_ptr == 1); } ASSERT(*slot_ptr <= 1); /* If there's space, store the key/value in the data section */ if (cache->p_free_bytes >= kvlen) { MU32 * base_det = PTR_ADD(cache->p_base, cache->p_free_data); MU32 now = (MU32)time(0); MU32 expire_time = 0; /* Calculate expiry time */ if (expire_seconds == (MU32)-1) expire_seconds = cache->expire_time; expire_time = expire_seconds ? now + expire_seconds : 0; /* Store info into slot */ S_LastAccess(base_det) = now; S_ExpireTime(base_det) = expire_time; S_SlotHash(base_det) = hash_slot; S_Flags(base_det) = flags; S_KeyLen(base_det) = (MU32)key_len; S_ValLen(base_det) = (MU32)val_len; /* Copy key/value to data section */ memcpy(S_KeyPtr(base_det), key_ptr, key_len); memcpy(S_ValPtr(base_det), val_ptr, val_len); /* Update used slots/free data info */ cache->p_free_slots--; if (*slot_ptr == 1) { cache->p_old_slots--; } /* Save new data offset */ *slot_ptr = cache->p_free_data; /* Update free space */ cache->p_free_bytes -= kvlen; cache->p_free_data += kvlen; /* Ensure changes are saved back */ cache->p_changed = 1; did_store = 1; } return did_store; } /* * int mmc_delete( * cache_mmap * cache, MU32 hash_slot, * void *key_ptr, int key_len * ) * * Delete key from current page * */ int mmc_delete( mmap_cache *cache, MU32 hash_slot, void *key_ptr, int key_len, MU32 * flags ) { /* Search slots for key */ MU32 * slot_ptr = _mmc_find_slot(cache, hash_slot, key_ptr, key_len, 2); /* Did we find a value? */ if (!slot_ptr || *slot_ptr == 0) { /* Return 0 if not deleted */ return 0; /* We found it, delete it */ } else { /* Store flags in output pointer */ MU32 * base_det = S_Ptr(cache->p_base, *slot_ptr); *flags = S_Flags(base_det); _mmc_delete_slot(cache, slot_ptr); return 1; } } int last_access_cmp(const void * a, const void * b) { MU32 av = S_LastAccess(*(MU32 **)a); MU32 bv = S_LastAccess(*(MU32 **)b); if (av < bv) return -1; if (av > bv) return 1; return 0; } /* * int mmc_calc_expunge( * cache_mmap * cache, int mode, int len, MU32 * new_num_slots, MU32 *** to_expunge * ) * * Calculate entries to expunge from current page. * * If len >= 0 * If space available for len bytes & >30% slots free, nothing is expunged * If len < 0 or not above * If mode == 0, only expired items are expunged * If mode == 1, all entries are expunged * If mode == 2, entries are expunged till 40% free space is created * * If expunged is non-null pointer, result is filled with * a list of slots to expunge * * Return value is number of items to expunge * */ int mmc_calc_expunge( mmap_cache * cache, int mode, int len, MU32 * new_num_slots, MU32 *** to_expunge ) { double slots_pct; ASSERT(cache->p_cur != -1); /* If len >= 0, and space available for len bytes, nothing is expunged */ if (len >= 0) { /* Length of key/value data when stored */ MU32 kvlen = KV_SlotLen(len, 0); ROUNDLEN(kvlen); slots_pct = (double)(cache->p_free_slots - cache->p_old_slots) / cache->p_num_slots; /* Nothing to do if hash table more than 30% free slots and enough free space */ if (slots_pct > 0.3 && cache->p_free_bytes >= kvlen) return 0; } { MU32 num_slots = cache->p_num_slots; MU32 used_slots = num_slots - cache->p_free_slots; MU32 * slot_ptr = cache->p_base_slots; MU32 * slot_end = slot_ptr + num_slots; /* Store pointers to used slots */ MU32 ** copy_base_det = (MU32 **)malloc(sizeof(MU32 *) * used_slots); MU32 ** copy_base_det_end = copy_base_det + used_slots; MU32 ** copy_base_det_out = copy_base_det; MU32 ** copy_base_det_in = copy_base_det + used_slots; MU32 page_data_size = cache->c_page_size - num_slots * 4 - P_HEADERSIZE; MU32 in_slots, data_thresh, used_data = 0; MU32 now = (MU32)time(0); /* Loop for each existing slot, and store in a list */ for (; slot_ptr != slot_end; slot_ptr++) { MU32 data_offset = *slot_ptr; MU32 * base_det = S_Ptr(cache->p_base, data_offset); MU32 expire_time, flags, kvlen; /* Ignore if if free slot */ if (data_offset <= 1) { continue; } /* Definitely out if mode == 1 which means expunge all */ if (mode == 1) { *copy_base_det_out++ = base_det; continue; } /* Definitely out if expired, and not dirty */ expire_time = S_ExpireTime(base_det); flags = S_Flags(base_det); if (expire_time && now >= expire_time) { *copy_base_det_out++ = base_det; continue; } /* Track used space */ kvlen = S_SlotLen(base_det); ROUNDLEN(kvlen); ASSERT(kvlen <= page_data_size); used_data += kvlen; ASSERT(used_data <= page_data_size); /* Potentially in */ *--copy_base_det_in = base_det; } /* Check that definitely in and out slots add up to used slots */ ASSERT(copy_base_det_in == copy_base_det_out); ASSERT(mode != 1 || copy_base_det_out == copy_base_det_end); /* Increase slot count if free count is low and there's space to increase */ slots_pct = (double)(copy_base_det_end - copy_base_det_out) / num_slots; if (slots_pct > 0.3 && (page_data_size - used_data > (num_slots + 1) * 4 || mode == 2)) { num_slots = (num_slots * 2) + 1; } page_data_size = cache->c_page_size - num_slots * 4 - P_HEADERSIZE; /* If mode == 0 or 1, we've just worked out ones to keep and * which to dispose of, so return results */ if (mode == 0 || mode == 1) { *to_expunge = copy_base_det; *new_num_slots = num_slots; return (copy_base_det_out - copy_base_det); } /* mode == 2, sort by last access, and remove till enough free space */ /* Sort those potentially in by last access */ in_slots = copy_base_det_end - copy_base_det_in; qsort((void *)copy_base_det_in, in_slots, sizeof(MU32 *), &last_access_cmp); /* Throw out old slots till we have 40% free data space */ data_thresh = (MU32)(0.6 * page_data_size); while (copy_base_det_in != copy_base_det_end && used_data >= data_thresh) { MU32 * slot_ptr = *copy_base_det_in; MU32 kvlen = S_SlotLen(slot_ptr); ROUNDLEN(kvlen); ASSERT(kvlen <= page_data_size); used_data -= kvlen; ASSERT(used_data >= 0); copy_base_det_out = ++copy_base_det_in; } ASSERT(used_data < page_data_size); *to_expunge = copy_base_det; *new_num_slots = num_slots; return (copy_base_det_out - copy_base_det); } } /* * int mmc_do_expunge( * cache_mmap * cache, int num_expunge, MU32 new_num_slots, MU32 ** to_expunge * ) * * Expunge given entries from current page. * */ int mmc_do_expunge( mmap_cache * cache, int num_expunge, MU32 new_num_slots, MU32 ** to_expunge ) { MU32 * base_slots = cache->p_base_slots; MU32 ** to_keep = to_expunge + num_expunge; MU32 ** to_keep_end = to_expunge + (cache->p_num_slots - cache->p_free_slots); MU32 new_used_slots = (to_keep_end - to_keep); /* Build new slots data and KV data */ MU32 slot_data_size = new_num_slots * 4; MU32 * new_slot_data = (MU32 *)malloc(slot_data_size); MU32 page_data_size = cache->c_page_size - new_num_slots * 4 - P_HEADERSIZE; void * new_kv_data = malloc(page_data_size); MU32 new_offset = 0; /* Start all new slots empty */ memset(new_slot_data, 0, slot_data_size); /* Copy entries to keep to new slot entires and data sections */ for (;to_keep < to_keep_end; to_keep++) { MU32 * old_base_det = *to_keep; MU32 * new_slot_ptr; MU32 kvlen; /* Hash key to find starting slot */ MU32 slot = S_SlotHash(old_base_det) % new_num_slots; #ifdef DEBUG /* Check hash actually matches stored value */ { MU32 hash_page_dummy, hash_slot; mmc_hash(cache, S_KeyPtr(old_base_det), S_KeyLen(old_base_det), &hash_page_dummy, &hash_slot); ASSERT(hash_slot == S_SlotHash(old_base_det)); } #endif /* Find free slot */ new_slot_ptr = new_slot_data + slot; while (*new_slot_ptr) { if (++slot >= new_num_slots) { slot = 0; } new_slot_ptr = new_slot_data + slot; } /* Copy slot and KV data */ kvlen = S_SlotLen(old_base_det); memcpy(PTR_ADD(new_kv_data, new_offset), old_base_det, kvlen); /* Store slot data and mark as used */ *new_slot_ptr = new_offset + new_num_slots * 4 + P_HEADERSIZE; ROUNDLEN(kvlen); new_offset += kvlen; } ASSERT(new_offset <= page_data_size); /* printf("page=%d\n", cache->p_cur); printf("old_slots=%d, new_slots=%d\n", old_num_slots, new_num_slots); printf("old_used_slots=%d, new_used_slots=%d\n", old_used_slots, new_used_slots);*/ /* Store back into mmap'ed file space */ memcpy(base_slots, new_slot_data, slot_data_size); memcpy(base_slots + new_num_slots, new_kv_data, new_offset); cache->p_num_slots = new_num_slots; cache->p_free_slots = new_num_slots - new_used_slots; cache->p_old_slots = 0; cache->p_free_data = new_offset + new_num_slots * 4 + P_HEADERSIZE; cache->p_free_bytes = page_data_size - new_offset; /* Make sure changes are saved back to mmap'ed file */ cache->p_changed = 1; /* Free allocated memory */ free(new_kv_data); free(new_slot_data); free(to_expunge); ASSERT(_mmc_test_page(cache)); return 0; } /* * void mmc_get_page_details(mmap_cache * cache, MU32 * n_reads, MU32 * n_read_hits) * * Return details about the current locked page. Currently just * number of reads and number of reads that hit * */ void mmc_get_page_details(mmap_cache * cache, MU32 * n_reads, MU32 * n_read_hits) { *n_reads = cache->p_n_reads; *n_read_hits = cache->p_n_read_hits; return; } /* * void mmc_reset_page_details(mmap_cache * cache) * * Reset any page details (currently just read hits) * */ void mmc_reset_page_details(mmap_cache * cache) { cache->p_n_reads = 0; cache->p_n_read_hits = 0; cache->p_changed = 1; return; } /* * mmap_cache_it * mmc_iterate_new(mmap_cache * cache) * * Setup a new iterator to iterate over stored items * in the cache * */ mmap_cache_it * mmc_iterate_new(mmap_cache * cache) { mmap_cache_it * it = (mmap_cache_it *)malloc(sizeof(mmap_cache_it)); it->cache = cache; it->p_cur = -1; it->slot_ptr = 0; it->slot_ptr_end = 0; return it; } /* * MU32 * mmc_iterate_next(mmap_cache_it * it) * * Move iterator to next item in the cache and return * pointer to details (0 if there is no next). * * You can retrieve details with mmc_get_details(...) * */ MU32 * mmc_iterate_next(mmap_cache_it * it) { mmap_cache * cache = it->cache; MU32 * slot_ptr = it->slot_ptr; MU32 * base_det; /* If empty slot, keep moving till we find a used one */ while (slot_ptr == it->slot_ptr_end || *slot_ptr <= 1) { /* End of page ... */ if (slot_ptr == it->slot_ptr_end) { /* Unlock current page if any */ if (it->p_cur != -1) { mmc_unlock(it->cache); } /* Move to the next page, return 0 if no more pages */ if (++it->p_cur == cache->c_num_pages) { it->p_cur = -1; it->slot_ptr = 0; return 0; } /* Lock the new page number */ mmc_lock(it->cache, it->p_cur); /* Setup new pointers */ slot_ptr = cache->p_base_slots; it->slot_ptr_end = slot_ptr + cache->p_num_slots; /* Check again */ continue; } /* Move to next slot */ slot_ptr++; } /* Get pointer to details for this entry */ base_det = S_Ptr(cache->p_base, *slot_ptr); /* Move to the next slot for next iteration */ it->slot_ptr = ++slot_ptr; /* Return that we found the next item */ return base_det; } /* * void mmc_iterate_close(mmap_cache_it * it) * * Finish and dispose of iterator memory * */ void mmc_iterate_close(mmap_cache_it * it) { /* Unlock page if locked */ if (it->p_cur != -1) { mmc_unlock(it->cache); } /* Free memory */ free(it); } /* * void mmc_get_details( * mmap_cache * cache, * MU32 * base_det, * void ** key_ptr, int * key_len, * void ** val_ptr, int * val_len, * MU32 * last_access, MU32 * expire_time, MU32 * flags * ) * * Given a base_det pointer to entries details * (as returned by mmc_iterate_next(...) and * mmc_calc_expunge(...)) return details of that * entry in the cache * */ void mmc_get_details( mmap_cache * cache, MU32 * base_det, void ** key_ptr, int * key_len, void ** val_ptr, int * val_len, MU32 * last_access, MU32 * expire_time, MU32 * flags ) { cache = cache; *key_ptr = S_KeyPtr(base_det); *key_len = S_KeyLen(base_det); *val_ptr = S_ValPtr(base_det); *val_len = S_ValLen(base_det); *last_access = S_LastAccess(base_det); *expire_time = S_ExpireTime(base_det); *flags = S_Flags(base_det); } /* * _mmc_delete_slot( * mmap_cache * cache, MU32 * slot_ptr * ) * * Delete details from the given slot * */ void _mmc_delete_slot( mmap_cache * cache, MU32 * slot_ptr ) { ASSERT(*slot_ptr > 1); ASSERT(cache->p_cur != -1); /* Set offset to 1 */ *slot_ptr = 1; /* Increase slot free counters */ cache->p_free_slots++; cache->p_old_slots++; /* Ensure changes are saved back */ cache->p_changed = 1; } /* * MU32 * _mmc_find_slot( * mmap_cache * cache, MU32 hash_slot, * void *key_ptr, int key_len, * int mode * ) * * Search current page for a particular 'key'. Use 'hash_slot' to * calculate starting slot. Return pointer to slot. * */ MU32 * _mmc_find_slot( mmap_cache * cache, MU32 hash_slot, void *key_ptr, int key_len, int mode ) { MU32 slots_left, * slots_end; /* Modulo hash_slot to find starting slot */ MU32 * slot_ptr = cache->p_base_slots + (hash_slot % cache->p_num_slots); MU32 * first_deleted = (MU32 *)0; /* Total slots and pointer to end of slot data to do wrapping */ slots_left = cache->p_num_slots; slots_end = cache->p_base_slots + slots_left; ASSERT(cache->p_cur != -1); /* Loop with integer probing till we find or don't */ while (slots_left--) { MU32 data_offset = *slot_ptr; ASSERT(data_offset == 0 || data_offset == 1 || ((data_offset >= P_HEADERSIZE + cache->p_num_slots*4) && (data_offset < cache->c_page_size) && ((data_offset & 3) == 0))); /* data_offset == 0 means empty slot, and no more beyond */ /* data_offset == 1 means deleted slot, we can reuse if writing */ if (data_offset == 0) { /* Return pointer to last checked slot */ break; } if (data_offset == 1 && mode == 1 && 0 == first_deleted) { /* Save pointer to first usable slot; if we don't find the key later, we'll fall back to returning this. */ first_deleted = slot_ptr; } /* deleted slot, keep looking */ if (data_offset == 1) { } else { /* Offset is from start of data area */ MU32 * base_det = S_Ptr(cache->p_base, data_offset); /* Two longs are key len and data len */ MU32 fkey_len = S_KeyLen(base_det); /* Key matches? */ if (fkey_len == (MU32)key_len && !memcmp(key_ptr, S_KeyPtr(base_det), key_len)) { /* Yep, found it! */ return slot_ptr; } } /* Linear probe and wrap at end of slot data... */ if (++slot_ptr == slots_end) { slot_ptr = cache->p_base_slots; } ASSERT(slot_ptr >= cache->p_base_slots && slot_ptr < slots_end); } /* No slot found */ if (++slots_left == 0) slot_ptr = 0; if (1 == mode && 0 != first_deleted) return first_deleted; else return slot_ptr; } /* * void _mmc_init_page(mmap_cache * cache, int page) * * Initialise the given page as empty * * If page == -1, init all pages * */ void _mmc_init_page(mmap_cache * cache, MU32 p_cur) { MU32 start_page = p_cur, end_page = p_cur+1; if (p_cur == -1) { start_page = 0; end_page = cache->c_num_pages; } for (p_cur = start_page; p_cur < end_page; p_cur++) { /* Setup page details */ MU32 p_offset = p_cur * cache->c_page_size; void * p_ptr = PTR_ADD(cache->mm_var, p_offset); /* Initialise to all 0's */ memset(p_ptr, 0, cache->c_page_size); /* Setup header */ P_Magic(p_ptr) = 0x92f7e3b1; P_NumSlots(p_ptr) = cache->start_slots; P_FreeSlots(p_ptr) = cache->start_slots; P_OldSlots(p_ptr) = 0; P_FreeData(p_ptr) = P_HEADERSIZE + cache->start_slots * 4; P_FreeBytes(p_ptr) = cache->c_page_size - P_FreeData(p_ptr); P_NReads(p_ptr) = 0; P_NReadHits(p_ptr) = 0; } } /* * int _mmc_test_page(mmap_cache * cache) * * Test integrity of current page * */ int _mmc_test_page(mmap_cache * cache) { MU32 * slot_ptr = cache->p_base_slots; MU32 count_free = 0, count_old = 0, max_data_offset = 0; MU32 data_size = cache->c_page_size; ASSERT(cache->p_cur != -1); if (!(cache->p_cur != -1)) return 0; for (; slot_ptr < cache->p_base_slots + cache->p_num_slots; slot_ptr++) { MU32 data_offset = *slot_ptr; ASSERT(data_offset == 0 || data_offset == 1 || (data_offset >= P_HEADERSIZE + cache->p_num_slots * 4 && data_offset < cache->c_page_size)); if (!(data_offset == 0 || data_offset == 1 || (data_offset >= P_HEADERSIZE + cache->p_num_slots * 4 && data_offset < cache->c_page_size))) return 0; if (data_offset == 1) { count_old++; } if (data_offset <= 1) { count_free++; continue; } if (data_offset > 1) { MU32 * base_det = S_Ptr(cache->p_base, data_offset); MU32 last_access = S_LastAccess(base_det); MU32 expire_time = S_ExpireTime(base_det); MU32 key_len = S_KeyLen(base_det); MU32 val_len = S_ValLen(base_det); MU32 kvlen = S_SlotLen(base_det); ROUNDLEN(kvlen); ASSERT(last_access > 1000000000 && last_access < 1500000000); if (!(last_access > 1000000000 && last_access < 1500000000)) return 0; ASSERT(expire_time == 0 || (expire_time > 1000000000 && expire_time < 1500000000)); if (!(expire_time == 0 || (expire_time > 1000000000 && expire_time < 1500000000))) return 0; ASSERT(key_len >= 0 && key_len < data_size); if (!(key_len >= 0 && key_len < data_size)) return 0; ASSERT(val_len >= 0 && val_len < data_size); if (!(val_len >= 0 && val_len < data_size)) return 0; ASSERT(kvlen >= 4*4 && kvlen < data_size); if (!(kvlen >= 4*4 && kvlen < data_size)) return 0; /* Keep track of largest end of data position */ if (data_offset + kvlen > max_data_offset) { max_data_offset = data_offset + kvlen; } /* Check if key lookup finds same thing */ { MU32 hash_page, hash_slot, * find_slot_ptr; /* Hash it */ mmc_hash(cache, S_KeyPtr(base_det), (int)key_len, &hash_page, &hash_slot); ASSERT(hash_slot == S_SlotHash(base_det)); if (!(hash_slot == S_SlotHash(base_det))) return 0; find_slot_ptr = _mmc_find_slot(cache, hash_slot, S_KeyPtr(base_det), key_len, 0); ASSERT(find_slot_ptr == slot_ptr); if (!(find_slot_ptr == slot_ptr)) return 0; } } } ASSERT(count_free == cache->p_free_slots); if (!(count_free == cache->p_free_slots)) return 0; ASSERT(count_old == cache->p_old_slots); if (!(count_old == cache->p_old_slots)) return 0; ASSERT(cache->p_free_data >= max_data_offset); if (!(cache->p_free_data >= max_data_offset)) return 0; return 1; } /* * int _mmc_dump_page(mmap_cache * cache) * * Dump text version of current page to STDOUT * */ int _mmc_dump_page(mmap_cache * cache) { MU32 slot; ASSERT(cache->p_cur != -1); printf("PageNum: %d\n", cache->p_cur); printf("\n"); printf("PageSize: %d\n", cache->c_page_size); printf("BasePage: %p\n", cache->p_base); printf("BaseSlots: %p\n", cache->p_base_slots); printf("\n"); printf("NumSlots: %d\n", cache->p_num_slots); printf("FreeSlots: %d\n", cache->p_free_slots); printf("OldSlots: %d\n", cache->p_old_slots); printf("FreeData: %d\n", cache->p_free_data); printf("FreeBytes: %d\n", cache->p_free_bytes); for (slot = 0; slot < cache->p_num_slots; slot++) { MU32 * slot_ptr = cache->p_base_slots + slot; printf("Slot: %d; OF=%d; ", slot, *slot_ptr); if (*slot_ptr > 1) { MU32 * base_det = S_Ptr(cache->p_base, *slot_ptr); MU32 key_len = S_KeyLen(base_det); MU32 val_len = S_ValLen(base_det); char key[256], val[256]; printf("LA=%d, ET=%d, HS=%d, FL=%d\n", S_LastAccess(base_det), S_ExpireTime(base_det), S_SlotHash(base_det), S_Flags(base_det)); /* Get data */ memcpy(key, S_KeyPtr(base_det), key_len > 256 ? 256 : key_len); key[key_len] = 0; memcpy(val, S_ValPtr(base_det), val_len > 256 ? 256 : val_len); val[val_len] = 0; printf(" K=%s, V=%s\n", key, val); } } return 0; } Cache-FastMmap-1.44/mmap_cache_internals.h0000644000000000000000000000612212612316360017157 0ustar rootroot#ifndef mmap_cache_internals_h #define mmap_cache_interanls_h #ifdef DEBUG #define ASSERT(x) assert(x) #include #else #define ASSERT(x) #endif #ifdef WIN32 #include #endif /* Cache structure */ struct mmap_cache { /* Current page details */ void * p_base; MU32 * p_base_slots; MU32 p_cur; MU32 p_offset; MU32 p_num_slots; MU32 p_free_slots; MU32 p_old_slots; MU32 p_free_data; MU32 p_free_bytes; MU32 p_n_reads; MU32 p_n_read_hits; int p_changed; /* General page details */ MU32 c_num_pages; MU32 c_page_size; MU32 c_size; /* Pointer to mmapped area */ void * mm_var; /* Cache general details */ MU32 start_slots; MU32 expire_time; int catch_deadlocks; int enable_stats; /* Share mmap file details */ #ifdef WIN32 HANDLE fh; #else int fh; #endif char * share_file; int init_file; int test_file; int cache_not_found; /* Last error string */ char * last_error; }; struct mmap_cache_it { mmap_cache * cache; MU32 p_cur; MU32 * slot_ptr; MU32 * slot_ptr_end; }; /* Macros to access page entries */ #define PP(p) ((MU32 *)p) #define P_Magic(p) (*(PP(p)+0)) #define P_NumSlots(p) (*(PP(p)+1)) #define P_FreeSlots(p) (*(PP(p)+2)) #define P_OldSlots(p) (*(PP(p)+3)) #define P_FreeData(p) (*(PP(p)+4)) #define P_FreeBytes(p) (*(PP(p)+5)) #define P_NReads(p) (*(PP(p)+6)) #define P_NReadHits(p) (*(PP(p)+7)) #define P_HEADERSIZE 32 /* Macros to access cache slot entries */ #define SP(s) ((MU32 *)s) /* Offset pointer 'p' by 'o' bytes */ #define PTR_ADD(p,o) ((void *)((char *)p + o)) /* Given a data pointer, get key len, value len or combined len */ #define S_Ptr(b,s) ((MU32 *)PTR_ADD(b, s)) #define S_LastAccess(s) (*(s+0)) #define S_ExpireTime(s) (*(s+1)) #define S_SlotHash(s) (*(s+2)) #define S_Flags(s) (*(s+3)) #define S_KeyLen(s) (*(s+4)) #define S_ValLen(s) (*(s+5)) #define S_KeyPtr(s) ((void *)(s+6)) #define S_ValPtr(s) (PTR_ADD((void *)(s+6), S_KeyLen(s))) /* Length of slot data including key and value data */ #define S_SlotLen(s) (sizeof(MU32)*6 + S_KeyLen(s) + S_ValLen(s)) #define KV_SlotLen(k,v) (sizeof(MU32)*6 + k + v) /* Found key/val len to nearest 4 bytes */ #define ROUNDLEN(l) ((l) += 3 - (((l)-1) & 3)) /* Externs from mmap_cache.c */ extern char * def_share_file; extern MU32 def_init_file; extern MU32 def_test_file; extern MU32 def_expire_time; extern MU32 def_c_num_pages; extern MU32 def_c_page_size; extern MU32 def_start_slots; extern char* _mmc_get_def_share_filename(mmap_cache * cache); /* Platform specific functions defined in unix.c | win32.c */ int mmc_open_cache_file(mmap_cache* cache, int * do_init); int mmc_map_memory(mmap_cache* cache); int mmc_unmap_memory(mmap_cache* cache); int mmc_lock_page(mmap_cache* cache, MU32 p_offset); int mmc_unlock_page(mmap_cache * cache); int mmc_close_fh(mmap_cache* cache); int _mmc_set_error(mmap_cache *cache, int err, char * error_string, ...); char* _mmc_get_def_share_filename(mmap_cache * cache); #endif Cache-FastMmap-1.44/ppport.h0000644000000000000000000003470512612316360014357 0ustar rootroot /* ppport.h -- Perl/Pollution/Portability Version 2.0002 * * Automatically Created by Devel::PPPort on Wed Nov 19 19:24:25 2003 * * Do NOT edit this file directly! -- Edit PPPort.pm instead. * * Version 2.x, Copyright (C) 2001, Paul Marquess. * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. * This code may be used and distributed under the same license as any * version of Perl. * * This version of ppport.h is designed to support operation with Perl * installations back to 5.004, and has been tested up to 5.8.0. * * If this version of ppport.h is failing during the compilation of this * module, please check if a newer version of Devel::PPPort is available * on CPAN before sending a bug report. * * If you are using the latest version of Devel::PPPort and it is failing * during compilation of this module, please send a report to perlbug@perl.com * * Include all following information: * * 1. The complete output from running "perl -V" * * 2. This file. * * 3. The name & version of the module you were trying to build. * * 4. A full log of the build that failed. * * 5. Any other information that you think could be relevant. * * * For the latest version of this code, please retreive the Devel::PPPort * module from CPAN. * */ /* * In order for a Perl extension module to be as portable as possible * across differing versions of Perl itself, certain steps need to be taken. * Including this header is the first major one, then using dTHR is all the * appropriate places and using a PL_ prefix to refer to global Perl * variables is the second. * */ /* If you use one of a few functions that were not present in earlier * versions of Perl, please add a define before the inclusion of ppport.h * for a static include, or use the GLOBAL request in a single module to * produce a global definition that can be referenced from the other * modules. * * Function: Static define: Extern define: * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL * */ /* To verify whether ppport.h is needed for your module, and whether any * special defines should be used, ppport.h can be run through Perl to check * your source code. Simply say: * * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] * * The result will be a list of patches suggesting changes that should at * least be acceptable, if not necessarily the most efficient solution, or a * fix for all possible problems. It won't catch where dTHR is needed, and * doesn't attempt to account for global macro or function definitions, * nested includes, typemaps, etc. * * In order to test for the need of dTHR, please try your module under a * recent version of Perl that has threading compiled-in. * */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include "patchlevel.h" # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_Sv Sv # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_defgv defgv # define PL_dirty dirty # define PL_dowarn dowarn # define PL_hints hints # define PL_na na # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfpv rsfp # define PL_stdingv stdingv # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes /* Replace: 0 */ #endif #ifdef HASATTRIBUTE # if defined(__GNUC__) && defined(__cplusplus) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif #else # define PERL_UNUSED_DECL #endif #ifndef dNOOP # define NOOP (void)0 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP # define dTHXa(x) dNOOP # define dTHXoa(x) dNOOP #endif #ifndef pTHX # define pTHX void # define pTHX_ # define aTHX # define aTHX_ #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif /* !INT2PTR */ #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB(HV * stash, char * name, SV *sv); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #ifndef START_MY_CXT /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #else /* single interpreter */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #endif /* START_MY_CXT */ #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # else # if IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # endif # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ # define AvFILLp AvFILL #endif #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Cache-FastMmap-1.44/MANIFEST.SKIP0000644000000000000000000000000712612316360014544 0ustar rootroot^\.git Cache-FastMmap-1.44/mmap_cache_test.c0000644000000000000000000002026512612316360016136 0ustar rootroot#include #include #include #if !defined(WIN32) || defined(CYGWIN) #include #include #include #include #endif #ifdef DEBUG #define ASSERT(x) assert(x) #include #else #define ASSERT(x) #endif #ifndef WIN32 #include #else #include #include #include double last_rand; double drand48(void) { last_rand = rand() / (double)(RAND_MAX+1); ASSERT(last_rand < 1); return last_rand; } #endif #include #include "mmap_cache.h" void * Get(mmap_cache * cache, void * key_ptr, int key_len, int * val_len) { int found; void * val_ptr, * val_rtn_ptr = 0; MU32 hash_page, hash_slot, flags; /* Hash key to get page and slot */ mmc_hash(cache, key_ptr, key_len, &hash_page, &hash_slot); /* Get and lock the page */ mmc_lock(cache, hash_page); /* Get value data pointer */ found = mmc_read(cache, hash_slot, key_ptr, key_len, &val_ptr, val_len, &flags); /* If not found, use undef */ if (found == -1) { } else { /* Put into our own memory */ val_rtn_ptr = (void *)malloc(*val_len); memcpy(val_rtn_ptr, val_ptr, *val_len); } mmc_unlock(cache); return val_rtn_ptr; } void Set(mmap_cache * cache, void * key_ptr, int key_len, void * val_ptr, int val_len) { MU32 hash_page, hash_slot, flags = 0, new_num_slots, ** expunge_items = 0; int num_expunge; /* Hash key to get page and slot */ mmc_hash(cache, key_ptr, key_len, &hash_page, &hash_slot); /* Get and lock the page */ mmc_lock(cache, hash_page); num_expunge = mmc_calc_expunge(cache, 2, key_len + val_len, &new_num_slots, &expunge_items); if (expunge_items) { mmc_do_expunge(cache, num_expunge, new_num_slots, expunge_items); } /* Get value data pointer */ mmc_write(cache, hash_slot, key_ptr, key_len, val_ptr, val_len, 60, flags); mmc_unlock(cache); } char * rand_str(int nchar) { unsigned char * buf = (unsigned char *)malloc(nchar + 1); int i; for (i = 0; i < nchar; i++) { buf[i] = (char)(rand() % 26) + 'A'; } buf[i] = 0; return (char *)buf; } char buf[65537]; int BasicTests(mmap_cache * cache) { int val_len, i; void * val_ptr; printf("Basic tests\n"); /* Test empty */ ASSERT(!Get(cache, "", 0, &val_len)); ASSERT(!Get(cache, " ", 0, &val_len)); for (i = 0; i < 65536; i++) { buf[i] = ' '; } ASSERT(!Get(cache, buf, 1024, &val_len)); ASSERT(!Get(cache, buf, 65536, &val_len)); /* Test basic store/get on key sizes */ Set(cache, "", 0, "abc", 3); ASSERT(!memcmp(val_ptr = Get(cache, "", 0, &val_len), "abc", 3) && val_len == 3); free(val_ptr); Set(cache, " ", 1, "def", 3); ASSERT(!memcmp(val_ptr = Get(cache, " ", 1, &val_len), "def", 3) && val_len == 3); free(val_ptr); Set(cache, buf, 1024, "ghi", 3); ASSERT(!memcmp(val_ptr = Get(cache, buf, 1024, &val_len), "ghi", 3) && val_len == 3); free(val_ptr); /* Bigger than page size - shouldn't work */ Set(cache, buf, 65536, "jkl", 3); ASSERT(!Get(cache, buf, 65536, &val_len)); /* Test basic store/get on value sizes */ Set(cache, "abc", 3, "", 0); ASSERT((val_ptr = Get(cache, "abc", 3, &val_len)) && val_len == 0); free(val_ptr); Set(cache, "def", 3, "x", 1); ASSERT(!memcmp(val_ptr = Get(cache, "def", 3, &val_len), "x", 1) && val_len == 1); free(val_ptr); for (i = 0; i < 1024; i++) { buf[i] = 'y'; } buf[0] = 'z'; buf[1023] = 'w'; Set(cache, "ghi", 3, buf, 1024); ASSERT(!memcmp(val_ptr = Get(cache, "ghi", 3, &val_len), buf, 1024) && val_len == 1024); free(val_ptr); /* Bigger than page size - shouldn't work */ Set(cache, "jkl", 3, buf, 65536); ASSERT(!Get(cache, "jkl", 3, &val_len)); return 0; } int LinearTests(mmap_cache * cache) { int i, gl; char * str1, * str2, * str3; printf("Linear tests\n"); for (i = 0; i < 100000; i++) { str1 = rand_str(10); str2 = rand_str(10); Set(cache, str1, strlen(str1)+1, str2, strlen(str2)+1); str3 = Get(cache, str1, strlen(str1)+1, &gl); ASSERT(strlen(str2)+1 == gl); ASSERT(!memcmp(str2, str3, strlen(str2)+1)); free(str1); free(str2); free(str3); if (i % 1000 == 0) { printf("%d\n", i); } } } int EdgeTests() { return 0; } typedef struct key_list { int n_keys; int buf_size; char ** keys; } key_list; key_list * kl_new() { key_list * kl = (key_list *)malloc(sizeof(key_list)); kl->buf_size = 8; kl->keys = (char **)malloc(sizeof(char *) * kl->buf_size); kl->n_keys = 0; return kl; } void kl_push(key_list * kl, char * key) { if (kl->n_keys < kl->buf_size) { kl->keys[kl->n_keys++] = key; return; } kl->buf_size *= 2; kl->keys = (char **)realloc(kl->keys, sizeof(char *) * kl->buf_size); kl->keys[kl->n_keys++] = key; return; } void kl_free(key_list * kl) { int i; for (i = 0; i < kl->n_keys; i++) { free(kl->keys[i]); } } int urand_fh = 0; void RandSeed() { #ifdef WIN32 //randomize(); #else char buf[8]; if (!urand_fh) { urand_fh = open("/dev/urandom", O_RDONLY); } read(urand_fh, buf, 8); srand48(*(long int *)buf); #endif } int RepeatMixTests(mmap_cache * cache, double ratio, key_list * kl) { int i, val_len; int read = 0, read_hit = 0; char valbuf[256]; printf("Repeat mix tests\n"); for (i = 0; i < 10000; i++) { /* Read/write ratio */ if (drand48() < ratio) { /* Pick a key from known written ones */ char * k = kl->keys[(int)(drand48() * kl->n_keys)]; void * v = Get(cache, k, strlen(k), &val_len); read++; /* Skip if not found in cache */ if (!v) { continue; } read_hit++; /* Offset of 10 past first chars of value are key */ memcpy(valbuf, v+10, strlen(k)); valbuf[strlen(k)] = '\0'; ASSERT(!memcmp(valbuf, k, strlen(k))); free(v); } else { char * k = rand_str(10 + (int)(drand48() * 10)); char * v = rand_str(10); char * ve = rand_str((int)(drand48() * 200)); strcpy(valbuf, v); strcat(valbuf, k); strcat(valbuf, ve); kl_push(kl, k); Set(cache, k, strlen(k), valbuf, strlen(valbuf)); free(ve); free(v); } } if (read) { printf("Read hit pct: %5.3f\n", (double)read_hit/read); } return 1; } void IteratorTests(mmap_cache * cache) { MU32 * entry_ptr; void * key_ptr, * val_ptr; int key_len, val_len; MU32 last_access, expire_time, flags; mmap_cache_it * it = mmc_iterate_new(cache); printf("Iterator tests\n"); while ((entry_ptr = mmc_iterate_next(it))) { mmc_get_details(cache, entry_ptr, &key_ptr, &key_len, &val_ptr, &val_len, &last_access, &expire_time, &flags); ASSERT(key_len >= 10 && key_len <= 20); ASSERT(val_len >= 20 && val_len <= 240); ASSERT(last_access >= 1000000 && last_access <= time(0)); } mmc_iterate_close(it); } int ForkTests(mmap_cache * cache, key_list * kl) { #ifndef WIN32 int pid, j, k, kid, kids[20], nkids = 0, status; struct timeval timeout = { 0, 1000 }; for (j = 0; j < 8; j++) { if (!(pid = fork())) { RandSeed(); RepeatMixTests(cache, 0.4, kl); exit(0); } kids[nkids++] = pid; select(0, 0, 0, 0, &timeout); } do { kid = waitpid(-1, &status, 0); for (j = 0, k = 0; j < nkids; j++) { if (kids[j] != kid) { k++; } kids[j] = kids[k]; } nkids--; } while (kid > 0 && nkids); return 0; #else #endif } int main(int argc, char ** argv) { int res; key_list * kl; mmap_cache * cache; cache = mmc_new(); mmc_set_param(cache, "init_file", "1"); res = mmc_init(cache); kl = kl_new(); BasicTests(cache); LinearTests(cache); mmc_close(cache); cache = mmc_new(); mmc_set_param(cache, "init_file", "1"); res = mmc_init(cache); RepeatMixTests(cache, 0.0, kl); RepeatMixTests(cache, 0.5, kl); RepeatMixTests(cache, 0.8, kl); IteratorTests(cache); ForkTests(cache, kl); kl_free(kl); mmc_close(cache); cache = mmc_new(); mmc_set_param(cache, "init_file", "1"); mmc_set_param(cache, "page_size", "8192"); res = mmc_init(cache); kl = kl_new(); BasicTests(cache); RepeatMixTests(cache, 0.0, kl); RepeatMixTests(cache, 0.5, kl); RepeatMixTests(cache, 0.8, kl); ForkTests(cache, kl); kl_free(kl); mmc_close(cache); return 0; } Cache-FastMmap-1.44/Changes0000644000000000000000000001627012723545776014174 0ustar rootrootRevision history for Perl extension Cache::FastMmap. 1.44 Wed Jun 1 21:45 2016 - Set FD_CLOEXEC flag on cache files when opened. Particularly useful in Net::Server where HUPing a process causes it to exec() itself. Unless you undef the cache references, you'll leak fd's after each HUP 1.43 Fri Oct 23 14:00 2015 - Update copyright + version correctly everywhere 1.42 Fri Oct 23 13:30 2015 - Allow get_and_set callback to return an empty list which means "no change". This allows atomic "get, and set if not present" type action, but without resetting the expiry time on each get. This is basically the same as using the read_cb 1.41 Thu Aug 29 15:30 2013 - Actually reuse deleted slots. Meant that if you used ->remove() a lot, we would re-organise cache more than needed - Include typo and meta patches from dsteinbrunner 1.40 Mon Dec 5 10:30 2011 - Work around reference holding bug in Compress::Zlib 1.39 Mon Jul 18 09:50 2011 - Remove CImpl and simplify structure into just Cache::FastMmap module making all XS calls just function calls in Cache::FastMmap namespace 1.38 Sun Jul 17 18:30 2011 - Fix build process that was completely broken after moving files around into different directories 1.37 Fri Jul 15 16:30 2011 - Use a lock object with DESTROY method to avoid an alarm with a die leaving around a locked paged 1.36 Wed Sep 29 13:10 2010 - Disable wrapping fcntl() lock call in alarm, hurts people that use Time::HiRes::alarm() only to try and catch buggy deadlock code. Enable with catch_deadlocks option 1.35 Fri Feb 19 12:45 2010 - Fix for returning potential bug that returns old stored data. Could occur if you mix deletes (thanks Darrell Bishop) 1.34 Fri Jun 19 12:00 2009 - perldoc fix (thanks Jonathan Yu) 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) 1.29 Fri May 1 17:20 2009 - Support for Windows (thanks to Ash & kmx.at.volny.cz) (https://rt.cpan.org/Public/Bug/Display.html?id=45210) (https://rt.cpan.org/Public/Bug/Display.html?id=16501) 1.28 Fri Jun 27 11:05 2008 - get_and_set() returns new value + didstore boolean if called in list context 1.27 Wed Jun 18 17:15 2008 - Fix non-ansi C code - Remove debug flags 1.26 Thu May 22 14:50 2008 - Check for write failure when creating file thanks to Sam Vilain - Check for $ENV{TMP_DIR} thanks to Sam Vilain - Add compress option - Add basic statistics gathering 1.25 Mon Feb 04 13:20 2008 - Fix multi_set bug and add test (http://rt.cpan.org/Ticket/Display.html?id=32895) - Test share_file is not a reference (http://rt.cpan.org/Ticket/Display.html?id=32252) - Fix C variable declaration error (http://rt.cpan.org/Ticket/Display.html?id=31223) - Fix compile warnings in FreeBSD (http://rt.cpan.org/Ticket/Display.html?id=31900) - Thanks to all the people that contributed to the above bugs 1.24 Mon Oct 22 13:15 2007 - Add atomic get_and_remove() method thanks to Darrell Bishop 1.23 Wed Oct 17 16:00 2007 - Fix expire time parsing 1.22 Wed Oct 17 14:05 2007 - If third parameter to set() is not a references, treat it as a specify expiry time. Increases compatiability with Cache::Cache API. Helpful for Catalyst framework 1.21 Tue Oct 16 10:40 2007 - if first parameter to new() is a hash ref, use it as the options hash. Helpful for Catalyst framework 1.20 Thu Oct 2 13:40 2007 - add to documentation about page size and cache file locations - fix t/6.t test failure under new Test::More 1.19 Thu Aug 23 09:03 2007 - bad C declaration crept in again, now in svn 1.18 Thu Aug 22 17:30 2007 - fix use of $^O not to catch "darwin" (http://rt.cpan.org/Ticket/Display.html?id=28330) 1.17 Thu Aug 22 17:14 2007 - fix declaration in C code that wasn't legal C 1.16 Thu May 8 17:12 2007 - fix typo in Changes file (1.15 is 2007, not 2006) - fix get_keys(2) when undef values in cache - fix some leak detection tests 1.15 Thu May 8 17:12 2007 - catch and rethrow die/exceptions in get_and_set() callbacks - avoid undef warnings when using cache_not_found mode - use unique tempfile name rather than the same every time - add allow_recursive option to allow calls to cache from within a read/write callback sub - add checks to die if we try and lock a cache twice, rather than just causing mysterious errors - add unlink_on_exit to automatically delete the share_file when the cache exits. default to true if we created the share_file, false if we connected to an existing one - make empty_on_exit only call empty if the pid of the process we're cleaning up in is the same as the pid we were created in - die in CLONE, making it clear threads aren't supported 1.14 Thu Oct 20 11:45 2006 - alter calc_expunge to allow more efficient alternate implementation cases 1.13 Thu Oct 20 11:15 2006 - mention UNIX/Win32 compatiability in docs (http://rt.cpan.org/Ticket/Display.html?id=16501) - detect page corruption better and croak rather than segfault (http://rt.cpan.org/Ticket/Display.html?id=17335) - when running in raw_values => 0 mode, always store reference to data. Storable doesn't like freeze(SCALAR) (http://rt.cpan.org/Ticket/Display.html?id=16762) - Handle edge case of slot count increase when page already nearly full possibly causing corruption (can only happen if ->purge() called at just the wrong time) 1.12 Thu Oct 19 09:50 2006 - allow writing into a deleted slot 1.11 Web Oct 18 15:10 2006 - allow setting default slot count via start_slots argument 1.10 Web Oct 18 14:50 2006 - fc_lock() would segfault if no slots were available. Doesn't happen in normal usage, but can happen if cache behaviour altered by alternate code 1.09 Thu Feb 7 15:50 2005 - add get_and_set() routine to allow atomic reading and writing of a cache value (thanks to Sreeji Das) - fix some tests 1.08 Thu Aug 26 12:18 2004 - really remove dependency on perl 5.8 1.07 Thu Aug 19 22:18 2004 - add extra documentation - add parameter to empty() method - add ability to test integrity of cache file - remove dependency on perl 5.8 1.06 Thu May 10 17:18 2004 - add multi_set and multi_get methods 1.05 Sat Jan 31 17:24 2004 - fix another edge case where page would get full, but never expunged when storing references 1.04 Sun Jan 25 00:46 2004 - fix test file after new changes 1.03 Sun Jan 25 00:21 2004 - fix bad sorting when removing old cache entries 1.02 Sat Jan 24 17:05 2004 - fix edge case where page would get full, but never expunged 1.01 Sat Dec 13 18:17 2003 - fix leak from improper munmap call 1.00 Sat Dec 13 14:19 2003 - initial release Cache-FastMmap-1.44/lib/0000755000000000000000000000000012723546254013431 5ustar rootrootCache-FastMmap-1.44/lib/Cache/0000755000000000000000000000000012723546254014434 5ustar rootrootCache-FastMmap-1.44/lib/Cache/FastMmap.pm0000644000000000000000000012155012723545503016502 0ustar rootrootpackage Cache::FastMmap; =head1 NAME Cache::FastMmap - Uses an mmap'ed file to act as a shared memory interprocess cache =head1 SYNOPSIS use Cache::FastMmap; # Uses vaguely sane defaults $Cache = Cache::FastMmap->new(); # $Value must be a reference... $Cache->set($Key, $Value); $Value = $Cache->get($Key); $Cache = Cache::FastMmap->new(raw_values => 1); # $Value can't be a reference... $Cache->set($Key, $Value); $Value = $Cache->get($Key); =head1 ABSTRACT A shared memory cache through an mmap'ed file. It's core is written in C for performance. It uses fcntl locking to ensure multiple processes can safely access the cache at the same time. It uses a basic LRU algorithm to keep the most used entries in the cache. =head1 DESCRIPTION In multi-process environments (eg mod_perl, forking daemons, etc), it's common to want to cache information, but have that cache shared between processes. Many solutions already exist, and may suit your situation better: =over 4 =item * L - acts as a database, data is not automatically expired, slow =item * L - hash implementation is broken, data is not automatically expired, slow =item * L - lots of features, slow =item * L - lots of features, VERY slow. Uses IPC::ShareLite which freeze/thaws ALL data at each read/write =item * L - use your favourite RDBMS. can perform well, need a DB server running. very global. socket connection latency =item * L - similar to this module, in pure perl. slows down with larger pages =item * L - very fast (data ends up mostly in shared memory cache) but acts as a database overall, so data is not automatically expired =back In the case I was working on, I needed: =over 4 =item * Automatic expiry and space management =item * Very fast access to lots of small items =item * The ability to fetch/store many items in one go =back Which is why I developed this module. It tries to be quite efficient through a number of means: =over 4 =item * Core code is written in C for performance =item * It uses multiple pages within a file, and uses Fcntl to only lock a page at a time to reduce contention when multiple processes access the cache. =item * It uses a dual level hashing system (hash to find page, then hash within each page to find a slot) to make most C calls O(1) and fast =item * On each C, if there are slots and page space available, only the slot has to be updated and the data written at the end of the used data space. If either runs out, a re-organisation of the page is performed to create new slots/space which is done in an efficient way =back The class also supports read-through, and write-back or write-through callbacks to access the real data if it's not in the cache, meaning that code like this: my $Value = $Cache->get($Key); if (!defined $Value) { $Value = $RealDataSource->get($Key); $Cache->set($Key, $Value) } Isn't required, you instead specify in the constructor: Cache::FastMmap->new( ... context => $RealDataSourceHandle, read_cb => sub { $_[0]->get($_[1]) }, write_cb => sub { $_[0]->set($_[1], $_[2]) }, ); And then: my $Value = $Cache->get($Key); $Cache->set($Key, $NewValue); Will just work and will be read/written to the underlying data source as needed automatically. =head1 PERFORMANCE If you're storing relatively large and complex structures into the cache, then you're limited by the speed of the Storable module. If you're storing simple structures, or raw data, then Cache::FastMmap has noticeable performance improvements. See L for some comparisons to other modules. =head1 COMPATIBILITY Cache::FastMmap uses mmap to map a file as the shared cache space, and fcntl to do page locking. This means it should work on most UNIX like operating systems. Ash Berlin has written a Win32 layer using MapViewOfFile et al. to provide support for Win32 platform. =head1 MEMORY SIZE Because Cache::FastMmap mmap's a shared file into your processes memory space, this can make each process look quite large, even though it's just mmap'd memory that's shared between all processes that use the cache, and may even be swapped out if the cache is getting low usage. However, the OS will think your process is quite large, which might mean you hit some BSD::Resource or 'ulimits' you set previously that you thought were sane, but aren't anymore, so be aware. =head1 CACHE FILES AND OS ISSUES Because Cache::FastMmap uses an mmap'ed file, when you put values into the cache, you are actually "dirtying" pages in memory that belong to the cache file. Your OS will want to write those dirty pages back to the file on the actual physical disk, but the rate it does that at is very OS dependent. In Linux, you have some control over how the OS writes those pages back using a number of parameters in /proc/sys/vm dirty_background_ratio dirty_expire_centisecs dirty_ratio dirty_writeback_centisecs How you tune these depends heavily on your setup. As an interesting point, if you use a highmem linux kernel, a change between 2.6.16 and 2.6.20 made the kernel flush memory a LOT more. There's details in this kernel mailing list thread: L In most cases, people are not actually concerned about the persistence of data in the cache, and so are happy to disable writing of any cache data back to disk at all. Baically what they want is an in memory only shared cache. The best way to do that is to use a "tmpfs" filesystem and put all cache files on there. For instance, all our machines have a /tmpfs mount point that we create in /etc/fstab as: none /tmpfs tmpfs defaults,noatime,size=1000M 0 0 And we put all our cache files on there. The tmpfs filesystem is smart enough to only use memory as required by files actually on the tmpfs, so making it 1G in size doesn't actually use 1G of memory, it only uses as much as the cache files we put on it. In all cases, we ensure that we never run out of real memory, so the cache files effectively act just as named access points to shared memory. Some people have suggested using anonymous mmaped memory. Unfortunately we need a file descriptor to do the fcntl locking on, so we'd have to create a separate file on a filesystem somewhere anyway. It seems easier to just create an explicit "tmpfs" filesystem. =head1 PAGE SIZE AND KEY/VALUE LIMITS To reduce lock contention, Cache::FastMmap breaks up the file into pages. When you get/set a value, it hashes the key to get a page, then locks that page, and uses a hash table within the page to get/store the actual key/value pair. One consequence of this is that you cannot store values larger than a page in the cache at all. Attempting to store values larger than a page size will fail (the set() function will return false). Also keep in mind that each page has it's own hash table, and that we store the key and value data of each item. So if you are expecting to store large values and/or keys in the cache, you should use page sizes that are definitely larger than your largest key + value size + a few kbytes for the overhead. =head1 USAGE Because the cache uses shared memory through an mmap'd file, you have to make sure each process connects up to the file. There's probably two main ways to do this: =over 4 =item * Create the cache in the parent process, and then when it forks, each child will inherit the same file descriptor, mmap'ed memory, etc and just work. This is the recommended way. (BEWARE: This only works under UNIX as Win32 has no concept of forking) =item * Explicitly connect up in each forked child to the share file. In this case, make sure the file already exists and the children connect with init_file => 0 to avoid deleting the cache contents and possible race corruption conditions. Also be careful that multiple children may race to create the file at the same time, each overwriting and corrupting content. Use a separate lock file if you must to ensure only one child creates the file. (This is the only possible way under Win32) =back The first way is usually the easiest. If you're using the cache in a Net::Server based module, you'll want to open the cache in the C, because that's executed before the fork, but after the process ownership has changed and any chroot has been done. In mod_perl, just open the cache at the global level in the appropriate module, which is executed as the server is starting and before it starts forking children, but you'll probably want to chmod or chown the file to the permissions of the apache process. =head1 METHODS =over 4 =cut # Modules/Export/XSLoader {{{ use 5.006; use strict; use warnings; use bytes; our $VERSION = '1.44'; require XSLoader; XSLoader::load('Cache::FastMmap', $VERSION); # Track currently live caches so we can cleanup in END {} # if we have empty_on_exit set our %LiveCaches; use constant FC_ISDIRTY => 1; # }}} =item I Create a new Cache::FastMmap object. Basic global parameters are: =over 4 =item * B File to mmap for sharing of data. default on unix: /tmp/sharefile-$pid-$time-$random default on windows: %TEMP%\sharefile-$pid-$time-$random =item * B Clear any existing values and re-initialise file. Useful to do in a parent that forks off children to ensure that file is empty at the start (default: 0) B This is quite important to do in the parent to ensure a consistent file structure. The shared file is not perfectly transaction safe, and so if a child is killed at the wrong instant, it might leave the cache file in an inconsistent state. =item * B Store values as raw binary data rather than using Storable to free/thaw data structures (default: 0) =item * B Compress the value (but not the key) before storing into the cache, using the compression package identified by the value of the parameter. Supported values are: 'zlib' for 'Compress::Zlib' 'lz4' for 'Compress::LZ4' 'snappy' for 'Compress:Snappy' If this parameter has a value the module will attempt to load the associated package and then use the API of that package to compress data before storing in the cache, and uncompress it upon retrieval from the cache. (default: undef) ( Note: Historically this module only supported a boolean value for the `compress` parameter and defaulted to use Compress::Zlib. The note for the old `compress` parameter stated: "Some initial testing shows that the uncompressing tends to be very fast, though the compressing can be quite slow, so it's probably best to use this option only if you know values in the cache are long-lived and have a high hit rate." Comparable test results for the other compression tools are not yet available; submission of benchmarks welcome. However, the documentation for the 'Snappy' library (http://google.github.io/snappy/) states: For instance, compared to the fastest mode of zlib, Snappy is an order of magnitude faster for most inputs, but the resulting compressed files are anywhere from 20% to 100% bigger. ) =item * B Deprecated. Please use B, see above. =item * B Enable some basic statistics capturing. When enabled, every read to the cache is counted, and every read to the cache that finds a value in the cache is also counted. You can then retrieve these values via the get_statistics() call. This causes every read action to do a write on a page, which can cause some more IO, so it's disabled by default. (default: 0) =item * B Maximum time to hold values in the cache in seconds. A value of 0 means does no explicit expiry time, and values are expired only based on LRU usage. Can be expressed as 1m, 1h, 1d for minutes/hours/days respectively. (default: 0) =back You may specify the cache size as: =over 4 =item * B Size of cache. Can be expresses as 1k, 1m for kilobytes or megabytes respectively. Automatically guesses page size/page count values. =back Or specify explicit page size/page count values. If none of these are specified, the values page_size = 64k and num_pages = 89 are used. =over 4 =item * B Size of each page. Must be a power of 2 between 4k and 1024k. If not, is rounded to the nearest value. =item * B Number of pages. Should be a prime number for best hashing =back The cache allows the use of callbacks for reading/writing data to an underlying data store. =over 4 =item * B Opaque reference passed as the first parameter to any callback function if specified =item * B Callback to read data from the underlying data store. Called as: $read_cb->($context, $Key) Should return the value to use. This value will be saved in the cache for future retrievals. Return undef if there is no value for the given key =item * B Callback to write data to the underlying data store. Called as: $write_cb->($context, $Key, $Value, $ExpiryTime) In 'write_through' mode, it's always called as soon as a I is called on the Cache::FastMmap class. In 'write_back' mode, it's called when a value is expunged from the cache if it's been changed by a I rather than read from the underlying store with the I above. Note: Expired items do result in the I being called if 'write_back' caching is enabled and the item has been changed. You can check the $ExpiryTime against C if you only want to write back values which aren't expired. Also remember that I may be called in a different process to the one that placed the data in the cache in the first place =item * B Callback to delete data from the underlying data store. Called as: $delete_cb->($context, $Key) Called as soon as I is called on the Cache::FastMmap class =item * B If set to true, then if the I is called and it returns undef to say nothing was found, then that information is stored in the cache, so that next time a I is called on that key, undef is returned immediately rather than again calling the I =item * B Either 'write_back' or 'write_through'. (default: write_through) =item * B If you're using a callback function, then normally the cache is not re-enterable, and attempting to call a get/set on the cache will cause an error. By setting this to one, the cache will unlock any pages before calling the callback. During the unlock time, other processes may change data in current cache page, causing possible unexpected effects. You shouldn't set this unless you know you want to be able to recall to the cache within a callback. (default: 0) =item * B When you have 'write_back' mode enabled, then you really want to make sure all values from the cache are expunged when your program exits so any changes are written back. The trick is that we only want to do this in the parent process, we don't want any child processes to empty the cache when they exit. So if you set this, it takes the PID via $$, and only calls empty in the DESTROY method if $$ matches the pid we captured at the start. (default: 0) =item * B Unlink the share file when the cache is destroyed. As with empty_on_exit, this will only unlink the file if the DESTROY occurs in the same PID that the cache was created in so that any forked children don't unlink the file. This value defaults to 1 if the share_file specified does not already exist. If the share_file specified does already exist, it defaults to 0. =item * B Sets an alarm(10) before each page is locked via fcntl(F_SETLKW) to catch any deadlock. This used to be the default behaviour, but it's not really needed in the default case and could clobber sub-second Time::HiRes alarms setup by other code. Defaults to 0. =back =cut sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; # If first item is a hash ref, use it as arguments my %Args = ref($_[0]) eq 'HASH' ? %{shift()} : @_; my $Self = {}; bless ($Self, $Class); # Work out cache file and whether to init my $share_file = $Args{share_file}; if (!$share_file) { my $tmp_dir = $ENV{TMPDIR} || "/tmp"; my $win_tmp_dir = $ENV{TEMP} || "c:\\"; $share_file = ($^O eq "MSWin32" ? "$win_tmp_dir\\sharefile" : "$tmp_dir/sharefile"); $share_file .= "-" . $$ . "-" . time . "-" . int(rand(100000)); } !ref($share_file) || die "share_file argument was a reference"; $Self->{share_file} = $share_file; my $init_file = $Args{init_file} ? 1 : 0; my $test_file = $Args{test_file} ? 1 : 0; my $enable_stats = $Args{enable_stats} ? 1 : 0; my $catch_deadlocks = $Args{catch_deadlocks} ? 1 : 0; # Worth out unlink default if not specified if (!exists $Args{unlink_on_exit}) { $Args{unlink_on_exit} = -f($share_file) ? 0 : 1; } # Storing raw/storable values? my $raw_values = $Self->{raw_values} = int($Args{raw_values} || 0); # Need storable module if not using raw values if (!$raw_values) { eval "use Storable qw(freeze thaw); 1;" || die "Could not load Storable module: $@"; } # Compress stored values? my $compressor = $Args{compressor} || 0; # Also support legacy boolean argument which forced use of Compress::Zlib $compressor ||= $Args{compress} ? 'zlib' : 0; my %known_compressors = ( zlib => 'Compress::Zlib', lz4 => 'Compress::LZ4', snappy => 'Compress::Snappy', ); if ( $compressor ) { if ( ! $known_compressors{ $compressor } ) { die "Unrecognized value >$compressor< for `compressor` parameter"; } $compressor = $known_compressors{ $compressor }; if ( ! eval "require $compressor;" ) { die "Could not load compression package: $compressor : $@"; } else { # LZ4 and Snappy use same API if ($compressor eq 'Compress::LZ4' || $compressor eq 'Compress::Snappy') { $Self->{compress} = $compressor->can("compress"); $Self->{uncompress} = $compressor->can("uncompress"); } elsif ($compressor eq 'Compress::Zlib') { $Self->{compress} = $compressor->can("memGzip"); # (gunzip from tmp var: https://rt.cpan.org/Ticket/Display.html?id=72945) my $uncompress = $compressor->can("memGunzip"); $Self->{uncompress} = sub { &$uncompress(my $Tmp = shift) }; } } } # 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 my $expire_time = $Self->{expire_time} = parse_expire_time($Args{expire_time}); # Function rounds to the nearest power of 2 sub RoundPow2 { return int(2 ** int(log($_[0])/log(2)) + 0.1); } # Work out cache size my ($cache_size, $num_pages, $page_size); my %Sizes = (k => 1024, m => 1024*1024); if ($cache_size = $Args{cache_size}) { $cache_size *= $Sizes{lc($1)} if $cache_size =~ s/([km])$//i; if ($num_pages = $Args{num_pages}) { $page_size = RoundPow2($cache_size / $num_pages); $page_size = 4096 if $page_size < 4096; } else { $page_size = $Args{page_size} || 65536; $page_size *= $Sizes{lc($1)} if $page_size =~ s/([km])$//i; $page_size = 4096 if $page_size < 4096; # Increase num_pages till we exceed $num_pages = 89; if ($num_pages * $page_size <= $cache_size) { while ($num_pages * $page_size <= $cache_size) { $num_pages = $num_pages * 2 + 1; } } else { while ($num_pages * $page_size > $cache_size) { $num_pages = int(($num_pages-1) / 2); } $num_pages = $num_pages * 2 + 1; } } } else { ($num_pages, $page_size) = @Args{qw(num_pages page_size)}; $num_pages ||= 89; $page_size ||= 65536; $page_size *= $Sizes{lc($1)} if $page_size =~ s/([km])$//i; $page_size = RoundPow2($page_size); } $cache_size = $num_pages * $page_size; @$Self{qw(cache_size num_pages page_size)} = ($cache_size, $num_pages, $page_size); # Number of slots to start in each page my $start_slots = int($Args{start_slots} || 0) || 89; # Save read through/write back/write through details my $write_back = ($Args{write_action} || 'write_through') eq 'write_back'; @$Self{qw(context read_cb write_cb delete_cb)} = @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(unlink_on_exit enable_stats)} = (@Args{qw(unlink_on_exit)}, $enable_stats); # Save pid $Self->{pid} = $$; # Initialise C cache code my $Cache = fc_new(); $Self->{Cache} = $Cache; # Setup cache parameters fc_set_param($Cache, 'init_file', $init_file); fc_set_param($Cache, 'init_file', $init_file); fc_set_param($Cache, 'test_file', $test_file); fc_set_param($Cache, 'page_size', $page_size); fc_set_param($Cache, 'num_pages', $num_pages); fc_set_param($Cache, 'expire_time', $expire_time); fc_set_param($Cache, 'share_file', $share_file); fc_set_param($Cache, 'start_slots', $start_slots); fc_set_param($Cache, 'catch_deadlocks', $catch_deadlocks); fc_set_param($Cache, 'enable_stats', $enable_stats); # And initialise it fc_init($Cache); # 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; } =item I Search cache for given Key. Returns undef if not found. If I specified and not found, calls the callback to try and find the value for the key, and if found (or 'cache_not_found' is set), stores it into the cache and returns the found value. I<%Options> is optional, and is used by get_and_set() to control the locking behaviour. For now, you should probably ignore it unless you read the code to understand how it works =cut sub get { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); # Hash value, lock page, read result my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); my $Unlock = $Self->_lock_page($HashPage); my ($Val, $Flags, $Found) = fc_read($Cache, $HashSlot, $_[1]); # Value not found, check underlying data store if (!$Found && (my $read_cb = $Self->{read_cb})) { # Callback to read from underlying data store # (unlock page first if we allow recursive calls $Unlock = undef if $Self->{allow_recursive}; $Val = eval { $read_cb->($Self->{context}, $_[1]); }; my $Err = $@; $Unlock = $Self->_lock_page($HashPage) if $Self->{allow_recursive}; # Pass on any error if ($Err) { die $Err; } # If we found it, or want to cache not-found, store back into our cache if (defined $Val || $Self->{cache_not_found}) { # Are we doing writeback's? If so, need to mark as dirty in cache my $write_back = $Self->{write_back}; # If not using raw values, use freeze() to turn data $Val = freeze(\$Val) if !$Self->{raw_values}; $Val = $Self->{compress}($Val) if $Self->{compress}; # Get key/value len (we've got 'use bytes'), and do expunge check to # create space if needed my $KVLen = length($_[1]) + (defined($Val) ? length($Val) : 0); $Self->_expunge_page(2, 1, $KVLen); fc_write($Cache, $HashSlot, $_[1], $Val, -1, 0); } } # Unlock page and return any found value # Unlock is done only if we're not in the middle of a get_set() operation. my $SkipUnlock = $_[2] && $_[2]->{skip_unlock}; $Unlock = undef unless $SkipUnlock; # If not using raw values, use thaw() to turn data back into object $Val = $Self->{uncompress}($Val) if defined($Val) && $Self->{compress}; $Val = ${thaw($Val)} if defined($Val) && !$Self->{raw_values}; # If explicitly asked to skip unlocking, we return the reference to the unlocker return ($Val, $Unlock) if $SkipUnlock; return $Val; } =item I Store specified key/value pair into cache I<%Options> is optional, and is used by get_and_set() to control the locking behaviour. For now, you should probably ignore it unless you read the code to understand how it works This method returns true if the value was stored in the cache, false otherwise. See the PAGE SIZE AND KEY/VALUE LIMITS section for more details. =cut sub set { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); # If not using raw values, use freeze() to turn data my $Val = $Self->{raw_values} ? $_[2] : freeze(\$_[2]); $Val = $Self->{compress}($Val) if $Self->{compress}; # Get opts, make compatible with Cache::Cache interface my $Opts = defined($_[3]) ? (ref($_[3]) ? $_[3] : { expire_time => $_[3] }) : undef; my $expire_seconds = defined($Opts && $Opts->{expire_time}) ? parse_expire_time($Opts->{expire_time}) : -1; # Hash value, lock page my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); # If skip_lock is passed, it's a *reference* to an existing lock we # have to take and delete so we can cleanup below before calling # the callback my $Unlock = $Opts && $Opts->{skip_lock}; if ($Unlock) { ($Unlock, $$Unlock) = ($$Unlock, undef); } else { $Unlock = $Self->_lock_page($HashPage); } # Are we doing writeback's? If so, need to mark as dirty in cache my $write_back = $Self->{write_back}; # Get key/value len (we've got 'use bytes'), and do expunge check to # create space if needed my $KVLen = length($_[1]) + (defined($Val) ? length($Val) : 0); $Self->_expunge_page(2, 1, $KVLen); # Now store into cache my $DidStore = fc_write($Cache, $HashSlot, $_[1], $Val, $expire_seconds, $write_back ? FC_ISDIRTY : 0); # Unlock page $Unlock = undef; # If we're doing write-through, or write-back and didn't get into cache, # write back to the underlying store if ((!$write_back || !$DidStore) && (my $write_cb = $Self->{write_cb})) { eval { $write_cb->($Self->{context}, $_[1], $_[2]); }; } return $DidStore; } =item I Atomically retrieve and set the value of a Key. The page is locked while retrieving the $Key and is unlocked only after the value is set, thus guaranteeing the value does not change between the get and set operations. $Sub is a reference to a subroutine that is called to calculate the new value to store. $Sub gets $Key and the current value as parameters, and should return the new value to set in the cache for the given $Key. If the subroutine returns an empty list, no value is stored back in the cache. This avoids updating the expiry time on an entry if you want to do a "get if in cache, store if not present" type callback. For example, to atomically increment a value in the cache, you can just use: $Cache->get_and_set($Key, sub { return ++$_[1]; }); In scalar context, the return value from this function is the *new* value stored back into the cache. In list context, a two item array is returned; the new value stored back into the cache and a boolean that's true if the value was stored in the cache, false otherwise. See the PAGE SIZE AND KEY/VALUE LIMITS section for more details. Notes: =over 4 =item * Do not perform any get/set operations from the callback sub, as these operations lock the page and you may end up with a dead lock! =item * If your sub does a die/throws an exception, the page will correctly be unlocked (1.15 onwards) =back =cut sub get_and_set { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); my ($Value, $Unlock) = $Self->get($_[1], { skip_unlock => 1 }); # If this throws an error, $Unlock ref will still unlock page my @NewValue = $_[2]->($_[1], $Value); my $DidStore = 0; if (@NewValue) { ($Value) = @NewValue; my $DidStore = $Self->set($_[1], $Value, { skip_lock => \$Unlock }); } return wantarray ? ($Value, $DidStore) : $Value; } =item I Delete the given key from the cache I<%Options> is optional, and is used by get_and_remove() to control the locking behaviour. For now, you should probably ignore it unless you read the code to understand how it works =cut sub remove { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); # Hash value, lock page, read result my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); # If skip_lock is passed, it's a *reference* to an existing lock we # have to take and delete so we can cleanup below before calling # the callback my $Unlock = $_[2] && $_[2]->{skip_lock}; if ($Unlock) { ($Unlock, $$Unlock) = ($$Unlock, undef); } else { $Unlock = $Self->_lock_page($HashPage); } my ($DidDel, $Flags) = fc_delete($Cache, $HashSlot, $_[1]); $Unlock = undef; # If we deleted from the cache, and it's not dirty, also delete # from underlying store if ((!$DidDel || ($DidDel && !($Flags & FC_ISDIRTY))) && (my $delete_cb = $Self->{delete_cb})) { eval { $delete_cb->($Self->{context}, $_[1]); }; } return $DidDel; } =item I Atomically retrieve value of a Key while removing it from the cache. The page is locked while retrieving the $Key and is unlocked only after the value is removed, thus guaranteeing the value stored by someone else isn't removed by us. =cut sub get_and_remove { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); my ($Value, $Unlock) = $Self->get($_[1], { skip_unlock => 1 }); my $DidDel = $Self->remove($_[1], { skip_lock => \$Unlock }); return wantarray ? ($Value, $DidDel) : $Value; } =item I Clear all items from the cache Note: If you're using callbacks, this has no effect on items in the underlying data store. No delete callbacks are made =cut sub clear { my $Self = shift; $Self->_expunge_all(1, 0); } =item I Clear all expired items from the cache Note: If you're using callbacks, this has no effect on items in the underlying data store. No delete callbacks are made, and no write callbacks are made for the expired data =cut sub purge { my $Self = shift; $Self->_expunge_all(0, 0); } =item I Empty all items from the cache, or if $OnlyExpired is true, only expired items. Note: If 'write_back' mode is enabled, any changed items are written back to the underlying store. Expired items are written back to the underlying store as well. =cut sub empty { my $Self = shift; $Self->_expunge_all($_[0] ? 0 : 1, 1); } =item I Get a list of keys/values held in the cache. May immediately be out of date because of the shared access nature of the cache If $Mode == 0, an array of keys is returned If $Mode == 1, then an array of hashrefs, with 'key', 'last_access', 'expire_time' and 'flags' keys is returned If $Mode == 2, then hashrefs also contain 'value' key =cut sub get_keys { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); my $Mode = $_[1] || 0; my ($Compress, $RawValues) = @$Self{qw(compress raw_values)}; return fc_get_keys($Cache, $Mode) if $Mode <= 1 || ($Mode == 2 && $RawValues && !$Compress); # If we're getting values as well, and they're not raw, unfreeze them my @Details = fc_get_keys($Cache, 2); for (@Details) { my $Val = $_->{value}; if (defined $Val) { $Val = $Self->{uncompress}($Val) if $Compress; if (!$RawValues) { $Val = eval { thaw($Val) }; $Val = $$Val if ref($Val); } $_->{value} = $Val; } } return @Details; } =item I Returns a two value list of (nreads, nreadhits). This only works if you passed enable_stats in the constructor nreads is the total number of read attempts done on the cache since it was created nreadhits is the total number of read attempts done on the cache since it was created that found the key/value in the cache If $Clear is true, the values are reset immediately after they are retrieved =cut sub get_statistics { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); my $Clear = $_[1]; my ($NReads, $NReadHits) = (0, 0); for (0 .. $Self->{num_pages}-1) { my $Unlock = $Self->_lock_page($_); my ($PNReads, $PNReadHits) = fc_get_page_details($Cache); $NReads += $PNReads; $NReadHits += $PNReadHits; fc_reset_page_details($Cache) if $Clear; $Unlock = undef; } return ($NReads, $NReadHits); } =item I The two multi_xxx routines act a bit differently to the other routines. With the multi_get, you pass a separate PageKey value and then multiple keys. The PageKey value is hashed, and that page locked. Then that page is searched for each key. It returns a hash ref of Key => Value items found in that page in the cache. The main advantage of this is just a speed one, if you happen to need to search for a lot of items on each call. For instance, say you have users and a bunch of pieces of separate information for each user. On a particular run, you need to retrieve a sub-set of that information for a user. You could do lots of get() calls, or you could use the 'username' as the page key, and just use one multi_get() and multi_set() call instead. A couple of things to note: =over 4 =item 1. This makes multi_get()/multi_set() and get()/set() incompatible. Don't mix calls to the two, because you won't find the data you're expecting =item 2. The writeback and callback modes of operation do not work with multi_get()/multi_set(). Don't attempt to use them together. =back =cut sub multi_get { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); # Hash value page key, lock page my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); my $Unlock = $Self->_lock_page($HashPage); # For each key to find my ($Keys, %KVs) = ($_[2]); for (@$Keys) { # Hash key to get slot in this page and read my $FinalKey = "$_[1]-$_"; (undef, $HashSlot) = fc_hash($Cache, $FinalKey); my ($Val, $Flags, $Found) = fc_read($Cache, $HashSlot, $FinalKey); next unless $Found; # If not using raw values, use thaw() to turn data back into object $Val = $Self->{uncompress}($Val) if defined($Val) && $Self->{compress}; $Val = ${thaw($Val)} if defined($Val) && !$Self->{raw_values}; # Save to return $KVs{$_} = $Val; } # Unlock page and return any found value $Unlock = undef; return \%KVs; } =item I $Value1, $Key2 => $Value2, ... }, [ \%Options ])> Store specified key/value pair into cache =cut sub multi_set { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); # Get opts, make compatible with Cache::Cache interface my $Opts = defined($_[3]) ? (ref($_[3]) ? $_[3] : { expire_time => $_[3] }) : undef; my $expire_seconds = defined($Opts && $Opts->{expire_time}) ? parse_expire_time($Opts->{expire_time}) : -1; # Hash page key value, lock page my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); my $Unlock = $Self->_lock_page($HashPage); # Loop over each key/value storing into this page my $KVs = $_[2]; while (my ($Key, $Val) = each %$KVs) { # If not using raw values, use freeze() to turn data $Val = freeze(\$Val) unless $Self->{raw_values}; $Val = $Self->{compress}($Val) if $Self->{compress}; # Get key/value len (we've got 'use bytes'), and do expunge check to # create space if needed my $FinalKey = "$_[1]-$Key"; my $KVLen = length($FinalKey) + length($Val); $Self->_expunge_page(2, 1, $KVLen); # Now hash key and store into page (undef, $HashSlot) = fc_hash($Cache, $FinalKey); my $DidStore = fc_write($Cache, $HashSlot, $FinalKey, $Val, $expire_seconds, 0); } # Unlock page $Unlock = undef; return 1; } =back =cut =head1 INTERNAL METHODS =over 4 =cut =item I<_expunge_all($Mode, $WB)> Expunge all items from the cache Expunged items (that have not expired) are written back to the underlying store if write_back is enabled =cut sub _expunge_all { my ($Self, $Cache, $Mode, $WB) = ($_[0], $_[0]->{Cache}, $_[1], $_[2]); # Repeat expunge for each page for (0 .. $Self->{num_pages}-1) { my $Unlock = $Self->_lock_page($_); $Self->_expunge_page($Mode, $WB, -1); $Unlock = undef; } } =item I<_expunge_page($Mode, $WB, $Len)> Expunge items from the current page to make space for $Len bytes key/value items Expunged items (that have not expired) are written back to the underlying store if write_back is enabled =cut sub _expunge_page { my ($Self, $Cache, $Mode, $WB, $Len) = ($_[0], $_[0]->{Cache}, @_[1 .. 3]); # If writeback mode, need to get expunged items to write back my $write_cb = $Self->{write_back} && $WB ? $Self->{write_cb} : undef; my @WBItems = fc_expunge($Cache, $Mode, $write_cb ? 1 : 0, $Len); my ($Compress, $RawValues) = @$Self{qw(compress raw_values)}; for (@WBItems) { next if !($_->{flags} & FC_ISDIRTY); 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}); }; } } =item I<_lock_page($Page)> Lock a given page in the cache, and return an object reference that when DESTROYed, unlocks the page =cut sub _lock_page { my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); my $Unlock = Cache::FastMmap::OnLeave->new(sub { fc_unlock($Cache) if fc_is_locked($Cache); }); fc_lock($Cache, $_[1]); return $Unlock; } sub parse_expire_time { my $expire_time = shift || ''; return 1 if $expire_time eq 'now'; return 0 if $expire_time eq 'never'; my %Times = ('' => 1, s => 1, m => 60, h => 60*60, d => 24*60*60, w => 7*24*60*60); return $expire_time =~ /^(\d+)\s*([mhdws]?)/i ? $1 * $Times{lc($2)} : 0; } 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} == $$) { $Self->empty(); } if ($Cache) { fc_close($Cache); $Cache = undef; delete $Self->{Cache}; } 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 { die "Cache::FastMmap does not support threads sorry"; } 1; package Cache::FastMmap::OnLeave; use strict; sub new { my $Class = shift; my $Ref = \$_[0]; bless $Ref, $Class; return $Ref; } sub disable { ${$_[0]} = undef; } sub DESTROY { my $e = $@; # Save errors from code calling us eval { my $Ref = shift; $$Ref->() if $$Ref; }; # $e .= " (in cleanup) $@" if $@; $@ = $e; } 1; __END__ =back =cut =head1 INCOMPATIBLE CHANGES =over 4 =item * From 1.15 =over 4 =item * Default share_file name is no-longer /tmp/sharefile, but /tmp/sharefile-$pid-$time. This ensures that different runs/processes don't interfere with each other, but means you may not connect up to the file you expect. You should be choosing an explicit name in most cases. On Unix systems, you can pass in the environment variable TMPDIR to override the default directory of /tmp =item * The new option unlink_on_exit defaults to true if you pass a filename for the share_file which doesn't already exist. This means if you have one process that creates the file, and another that expects the file to be there, by default it won't be. Otherwise the defaults seem sensible to cleanup unneeded share files rather than leaving them around to accumulate. =back =item * From 1.29 =over 4 =item * Default share_file name is no longer /tmp/sharefile-$pid-$time but /tmp/sharefile-$pid-$time-$random. =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 =item * From 1.36 =over 4 =item * Before 1.36, an alarm(10) would be set before each attempt to lock a page. The only purpose of this was to detect deadlocks, which should only happen if the Cache::FastMmap code was buggy, or a callback function in get_and_set() made another call into Cache::FastMmap. However this added unnecessary extra system calls for every lookup, and for users using Time::HiRes, it could clobber any existing alarms that had been set with sub-second resolution. So this has now been made an optional feature via the catch_deadlocks option passed to new. =back =back =cut =head1 SEE ALSO L, L, L, L, L, L, L Latest news/details can also be found at: L Available on github at: L =cut =head1 AUTHOR Rob Mueller L =cut =head1 COPYRIGHT AND LICENSE Copyright (C) 2003-2015 by FastMail Pty Ltd This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Cache-FastMmap-1.44/mmap_cache.h0000644000000000000000000001647112612316360015110 0ustar rootroot /* * AUTHOR * * Rob Mueller * * COPYRIGHT AND LICENSE * * Copyright (C) 2003 by FastMail IP Partners * * This library is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * * mmap_cache * * Uses an mmap'ed file to act as a shared memory interprocess cache * * The C interface is quite explicit in it's use, in that you have to * call individual functions to hash a key, lock a page, and find a * value. This allows a simpler higher level interface to be written * * #include * * mmap_cache * cache = mmc_new(); * cache->param = val; * mmc_init(cache); * * // Read a key * * // Hash get to find page and slot * mmc_hash(cache, (void *)key_ptr, (int)key_len, &hash_page, &hash_slot); * // Lock page * mmc_lock(cache, hash_page); * // Get pointer to value data * mmc_read(cache, hash_slot, (void *)key_ptr, (int)key_len, (void **)&val_ptr, (int *)val_len, &flags); * // Unlock page * mmc_unlock(cache); * * // Write a key * * // Hash get to find page and slot * mmc_hash(cache, (void *)key_ptr, (int)key_len, &hash_page, &hash_slot); * // Lock page * mmc_lock(cache, hash_page); * // Get pointer to value data * mmc_write(cache, hash_slot, (void *)key_ptr, (int)key_len, (void *)val_ptr, (int)val_len); * // Unlock page * mmc_unlock(cache); * * DESCRIPTION * * This class implements a shared memory cache through an mmap'ed file. It * uses locking to ensure multiple processes can safely access the cache * at the same time. It uses a basic LRU algorithm to keep the most used * entries in the cache. * * It tries to be quite efficient through a number of means: * * It uses multiple pages within a file, and uses Fcntl to only lock * a page at a time to reduce contention when multiple processes access * the cache. * * It uses a dual level hashing system (hash to find page, then hash * within each page to find a slot) to make most I calls O(1) and * fast * * On each I, if there are slots and page space available, only * the slot has to be updated and the data written at the end of the used * data space. If either runs out, a re-organisation of the page is * performed to create new slots/space which is done in an efficient way * * The locking is explicitly done in the C interface, so you can create * a 'read_many' or 'write_many' function that reduces the number of * locks required * * * IMPLEMENTATION * * Each file is made up of a number of 'pages'. The number of * pages and size of each page is specified when the class is * constructed. These values are stored in the cache class * and must be the same for each class connecting to the cache * file. * * NumPages - Number of 'pages' in the cache * PageSize - Size of each 'page' in the cache * * The layout of each page is: * * - Magic (4 bytes) - 0x92f7e3b1 magic page start marker * * - NumSlots (4 bytes) - Number of hash slots in this page * * - FreeSlots (4 bytes) - Number of free slots left in this page. * This includes all slots with a last access time of 0 * (empty and don't search past) or 1 (empty, but keep searching * because deleted slot) * * - OldSlots (4 bytes) - Of all the free slots, how many were in use * and are now deleted. This is slots with a last access time of 1 * * - FreeData (4 bytes) - Offset to free data area to place next item * * - FreeBytes (4 bytes) - Bytes left in free data area * * - N Reads (4 bytes) - Number of reads performed on this page * * - N Read Hits (4 bytes) - Number of reads on this page that have hit * something in the cache * * - Slots (4 bytes * NumSlots) - Hash slots * * - Data (to end of page) - Key/value data * * Each slot is made of: * * - Offset (4 bytes) - offset from start of page to actual data. This * is 0 if slot is empty, 1 if was used but now empty. This is needed * so deletes don't require a complete rehash with the linear * searching method we use * * Each data item is made of: * * - LastAccess (4 bytes) - Unix time data was last accessed * * - ExpireTime (4 bytes) - Unix time data should expire. This is 0 if it * should never expire * * - HashValue (4 bytes) - Value key was hashed to, so we don't have to * rehash on a re-organisation of the hash table * * - Flags (4 bytes) - Various flags * * - KeyLen (4 bytes) - Length of key * * - ValueLen (4 bytes) - Length of value * * - Key (KeyLen bytes) - Key data * * - Value (ValueLen bytes) - Value data * * Each set/get/delete operation involves: * * - Find the page for the key * - Lock the page * - Read the page header * - Find the hash slot for the key * * For get's: * * - Use linear probing to find correct key, or empty slot * * For set's: * * - Use linear probing to find empty slot * - If not enough free slots, do an 'expunge' run * - Store key/value at FreeData offset, update, and store in slot * - If not enough space at FreeData offset, do an 'expunge' run * then store data * * For delete's: * * - Use linear probing to find correct key, or empty slot * - Set slot to empty (data cleaned up in expunge run) * * An expunge run consists of: * * - Scan slots to find used key/value parts. Remove older items * - If ratio used/free slots too high, increase slot count * - Compact key/value data into one memory block * - Restore and update offsets in slots * */ /* Main cache structure passed as a pointer to each function */ typedef struct mmap_cache mmap_cache; /* Iterator structure for iterating over items in cache */ typedef struct mmap_cache_it mmap_cache_it; /* Unsigned 32 bit integer */ typedef unsigned int MU32; /* Initialisation/closing/error functions */ mmap_cache * mmc_new(); int mmc_init(mmap_cache *); int mmc_set_param(mmap_cache *, char *, char *); int mmc_get_param(mmap_cache *, char *); int mmc_close(mmap_cache *); char * mmc_error(mmap_cache *); /* Functions for find/locking a page */ int mmc_hash(mmap_cache *, void *, int, MU32 *, MU32 *); int mmc_lock(mmap_cache *, MU32); int mmc_unlock(mmap_cache *); int mmc_is_locked(mmap_cache *); /* Functions for getting/setting/deleting values in current page */ int mmc_read(mmap_cache *, MU32, void *, int, void **, int *, MU32 *); int mmc_write(mmap_cache *, MU32, void *, int, void *, int, MU32, MU32); int mmc_delete(mmap_cache *, MU32, void *, int, MU32 *); /* Functions of expunging values in current page */ int mmc_calc_expunge(mmap_cache *, int, int, MU32 *, MU32 ***); int mmc_do_expunge(mmap_cache *, int, MU32, MU32 **); /* Functions for iterating over items in a cache */ mmap_cache_it * mmc_iterate_new(mmap_cache *); MU32 * mmc_iterate_next(mmap_cache_it *); void mmc_iterate_close(mmap_cache_it *); /* Retrieve details of a cache page/entry */ void mmc_get_details(mmap_cache *, MU32 *, void **, int *, void **, int *, MU32 *, MU32 *, MU32 *); void mmc_get_page_details(mmap_cache * cache, MU32 * nreads, MU32 * nreadhits); void mmc_reset_page_details(mmap_cache * cache); /* Internal functions */ int _mmc_set_error(mmap_cache *, int, char *, ...); void _mmc_init_page(mmap_cache *, MU32); MU32 * _mmc_find_slot(mmap_cache * , MU32 , void *, int, int ); void _mmc_delete_slot(mmap_cache * , MU32 *); int _mmc_check_expunge(mmap_cache * , int); int _mmc_test_page(mmap_cache *); int _mmc_dump_page(mmap_cache *);