Cache-BDB-0.04/0000755000076500007650000000000010460246673012777 5ustar joshjosh00000000000000Cache-BDB-0.04/bench.t0000644000076500007650000002731410450271456014246 0ustar joshjosh00000000000000#!/opt/blocperl/bin/perl -w # # This is a stripped down version of cacheperl.pl from # http://cpan.robm.fastmail.fm/cache_perf.html that just compares # Cache::BDB, Cache::BerkeleyDB, Cache::FileCache, and # Cache::Memcached. See the included patch to add Cache::BDB to the # version of cacheperl.pl available from that site if you want to # benchmark a more complete set of options. If you want to disable a # few of these, see the @Packages array below and just comment out the # ones you don't want run. # use Time::HiRes qw(gettimeofday tv_interval); use Storable qw(freeze thaw); use Data::Dumper; use strict; #----- Setup stuff srand(1); # Number of runs to perform my $Runs = 1; # Maximum number of values to generate to store in cache my $MaxVals = 1000; # Number of times to get/set in each run my $NSetItems = 500; my $NGetItems = 500; my $NMixItems = 500; # When getting, pick definitely stored keys this often my $TestHitRate = 0.85; # If mix mode, make reads this often my $MixReadRatio = 0.85; # Build data sets of various complexity my (@DataComplex, @DataBin); for my $Depth (0 .. 2) { my @Structs = map { BuildStruct($Depth, $Depth+5) } 1 .. $MaxVals; push @DataComplex, \@Structs; my @Frozen = map { freeze($_) } @Structs; push @DataBin, \@Frozen; } # Recursive helper call sub BuildStruct { my ($Depth, $NItems) = @_; my $Struct = {}; # Alter slightly from base number of items passed $NItems += int(rand(3))-1; # Generate given number of items in hash struct for (my $i = 0; $i < $NItems; $i++) { my $Key = RandVal(1); my $Type = int(rand(10)); if ($Type < 4) { $Struct->{$Key} = RandVal(); } elsif ($Type < 7) { $Struct->{$Key} = [ map { RandVal() } 1 .. int(rand($NItems)) ]; } else { $Struct->{$Key} = $Depth ? BuildStruct($Depth-1, $NItems) : RandVal(); } } return $Struct; } # Generate random perl value (either int, float, string or undef) sub RandVal { my $NotUndef = shift; my $Type = int(rand(10)); if ($Type < 3) { return rand(100); } elsif ($Type < 6) { return int(rand(1000000)); } elsif ($Type < 9 || $NotUndef) { return join '', map { chr(ord('A') + int(rand(26))) } 1 .. int(rand(20)); } else { return undef; } } sub CheckComplex { keys %{$_[0]} == keys %{$_[1]} || die "Mismatch for package - " . $_[2]; } sub CheckBin { $_[0] eq $_[1] || die "Mismatch for package - " . $_[2]; } # Packages to run through my @Packages = ( CC5_CacheCacheBerkeleyDBStorable => [ 'complex', { namespace => 'testcache_cache_cache_berkeleydb', cache_root => '/tmp' } ], CC5_CacheFileCacheStorable => [ 'complex', { cache_root => "/tmp", namespace => "testcache_filecache", } ], CC6_CacheFileStorable => [ 'complex', cache_root => "/tmp", namespace => "testcache_file", ], CC6_CacheBDBStorable => [ 'complex', cache_root => "/tmp", namespace => "testcache_cache_bdb", ], CC3_Memcached_Local => [ 'complex', { 'servers' => [ "localhost:11211",], 'debug' => 0, 'compress_threshold' => 100000, } ], ); #----- Now do runs # Repeat each package type while (my ($Package, $PackageOpts) = splice @Packages, 0, 2) { # eval { require $Package };# # print $@; # next if $@; # Get package options my ($DataType, @Params) = @$PackageOpts; my ($Check, $Data); # Set data and check routine based on data type if ($DataType eq 'bin') { $Check = \&CheckBin; $Data = \@DataBin; } else { $Check = \&CheckComplex; $Data = \@DataComplex; } my $Name = $Package->name(); print "\nPackage: $Name\nData type: $DataType\nParams: @Params\n"; printf(" %5s | %6s | %6s | %6s | %5s | %5s\n", qw(Cmplx Set/S Get/S Mix/S GHitR MHitR)); printf("-------|--------|--------|--------|-------|------\n"); # Run for each data set size for my $DataSet (@$Data) { # Basic data complexity metric my $Complexity; for (@$DataSet) { if (ref $_) { my @Hashes = $_; while (my $Hash = shift @Hashes) { $Complexity += keys %$Hash; push @Hashes, grep { ref($_) eq 'HASH' } values %$Hash; } } else { $Complexity += length($_); } } $Complexity /= scalar(@$DataSet); # Store times my ($SetTime, $GetTime, $MixTime, $Name); # And hit rate my (%StoreData, $GetRead, $GetHit, $MixRead, $MixHit); # Do runs for (my $Run = 0; $Run < $Runs; $Run++) { my $c = $Package->new(@Params); # Store keys my $t0 = [gettimeofday]; for (my $i = 0; $i < $NSetItems; $i++) { my $k = "abc" . ($i * 103) . "defg"; my $x = $i % $MaxVals; $c->set($k, $DataSet->[$x]); $StoreData{$k} = $x; } my $t1 = [gettimeofday]; my @SetKeys = keys %StoreData; # Get keys for (my $i = $NGetItems-1; $i >= 0; $i--) { my $k; if (rand() < $TestHitRate) { $k = $SetKeys[rand(@SetKeys)]; $GetRead++; } else { $k = "abcd" . ($i * 103) . "efg"; } my $y = $c->get($k); if (defined $y) { $GetHit++; } else { my $o = $StoreData{$k}; defined $o || next; $y = $DataSet->[$o]; } # Reality check, not much of a check... $Check->($y, $DataSet->[$StoreData{$k}]); } my $t2 = [gettimeofday]; # Now do mix for (my $i = 0; $i < $NMixItems; $i++) { my $k; if (rand() < $MixReadRatio) { if (rand() < $TestHitRate) { $k = $SetKeys[rand(@SetKeys)]; $MixRead++; } else { $k = "abcd" . ($i * 103) . "efg"; } my $y = $c->get($k); if (defined $y) { $MixHit++; } else { my $o = $StoreData{$k}; defined $o || next; $y = $DataSet->[$o]; } # Reality check, not much of a check... $Check->($y, $DataSet->[$StoreData{$k}]); } else { $k = $SetKeys[rand(@SetKeys)]; $c->set($k, $DataSet->[$StoreData{$k}]); } } my $t3 = [gettimeofday]; # Add to run times $SetTime += tv_interval($t0, $t1); $GetTime += tv_interval($t1, $t2); $MixTime += tv_interval($t2, $t3); } my $SetRate = int ($NSetItems*$Runs / $SetTime); my $GetRate = int ($NGetItems*$Runs / $GetTime); my $MixRate = int ($NMixItems*$Runs / $MixTime); my $GHitRate = $GetHit/$GetRead; my $MHitRate = $MixHit/$MixRead; printf(" %5d | %6d | %6d | %6d | %5.3f | %5.3f\n", $Complexity, $SetRate, $GetRate, $MixRate, $GHitRate, $MHitRate); } print "\n"; } exit(0); package CB0_InProcHash; sub name { return "In process hash"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; my $Self = {}; bless ($Self, $Class); return $Self; } sub set { $_[0]->{$_[1]} = $_[2]; } sub get { return $_[0]->{$_[1]}; } 1; package CC0_InProcHashStorable; use Storable qw(freeze thaw); sub name { return "Storable freeze/thaw"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; my $Self = {}; bless ($Self, $Class); return $Self; } sub set { $_[0]->{$_[1]} = freeze($_[2]); } sub get { return thaw($_[0]->{$_[1]}); } 1; package CC3_Memcached_Local; use Cache::Memcached; use base 'Cache::Memcached'; sub name { return "Memcached Local Storable"; } 1; package CC3_BerkeleyDB_Hash_Storable; use Storable qw(freeze thaw); use BerkeleyDB; use Fcntl qw(:DEFAULT); sub name { return "BerkeleyDB Hash Storable"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; unlink glob('/tmp/bdbfile*'); my %Cache; my $env = new BerkeleyDB::Env( -Home => '/tmp', -Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL, #-Cachesize => 23152000, ) or die "can't create BerkelyDB::Env: $!"; my $Obj = tie %Cache, 'BerkeleyDB::Hash', -Filename => '/tmp/bdbfile', -Flags => DB_CREATE, -Mode => 0640, -Env => $env or die ("Can't tie to /tmp/bdbdfile: $!"); my $Self = { Cache => \%Cache, Obj => $Obj }; bless ($Self, $Class); return $Self; } sub set { # $_[0]->{Cache}->{$_[1]} = freeze($_[2]); $_[0]->{Obj}->db_put( $_[1], freeze($_[2]) ); } sub get { # return thaw($_[0]->{Cache}->{$_[1]}); my $value; $_[0]->{Obj}->db_get( $_[1], $value ); return thaw( $value ); } 1; package CC3_BerkeleyDB_Btree_Storable; use Storable qw(freeze thaw); use BerkeleyDB; use Fcntl qw(:DEFAULT); sub name { return "BerkeleyDB Btree Storable"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; unlink glob('/tmp/bdbfile*'); my %Cache; my $env = new BerkeleyDB::Env( -Home => '/tmp', -Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL, #-Cachesize => 23152000, ) or die "can't create BerkelyDB::Env: $!"; my $Obj = tie %Cache, 'BerkeleyDB::Btree', -Filename => '/tmp/bdbfile', -Flags => DB_CREATE, -Mode => 0640, -Env => $env or die ("Can't tie to /tmp/bdbdfile: $!"); my $Self = { Cache => \%Cache, Obj => $Obj }; bless ($Self, $Class); return $Self; } sub set { $_[0]->{Obj}->db_put( $_[1], freeze($_[2]) ); } sub get { my $value; $_[0]->{Obj}->db_get( $_[1], $value ); return thaw( $value ); } 1; package CC3_BerkeleyDB_Hash; use BerkeleyDB; use Fcntl qw(:DEFAULT); sub name { return "BerkeleyDB Hash"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; unlink glob('/tmp/bdbfile*'); my %Cache; my $env = new BerkeleyDB::Env( -Home => '/tmp', -Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL, #-Cachesize => 23152000, ) or die "can't create BerkelyDB::Env: $!"; my $Obj = tie %Cache, 'BerkeleyDB::Hash', -Filename => '/tmp/bdbfile', -Flags => DB_CREATE, -Mode => 0640, -Env => $env or die ("Can't tie to /tmp/bdbdfile: $!"); my $Self = { Cache => \%Cache, Obj => $Obj }; bless ($Self, $Class); return $Self; } sub set { # $_[0]->{Obj}->db_put( $_[1], $_[2] ); $_[0]->{Cache}->{ $_[1]} = $_[2]; } sub get { return $_[0]->{Cache}->{$_[1]}; my $value; $_[0]->{Obj}->db_get( $_[1], $value ); return $value; } package CC3_BerkeleyDB_Btree; use BerkeleyDB; use Fcntl qw(:DEFAULT); sub name { return "BerkeleyDB Btree"; } sub new { my $Proto = shift; my $Class = ref($Proto) || $Proto; unlink glob('/tmp/bdbfile*'); my %Cache; my $env = new BerkeleyDB::Env( -Home => '/tmp', -Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL, #-Cachesize => 23152000, ) or die "can't create BerkelyDB::Env: $!"; my $Obj = tie %Cache, 'BerkeleyDB::Btree', -Filename => '/tmp/bdbfile', -Flags => DB_CREATE, -Mode => 0640, -Env => $env or die ("Can't tie to /tmp/bdbdfile: $!"); my $Self = { Cache => \%Cache, Obj => $Obj }; bless ($Self, $Class); return $Self; } sub set { $_[0]->{Obj}->db_put( $_[1], $_[2] ); } sub get { my $value; $_[0]->{Obj}->db_get( $_[1], $value ); return $value; } 1; package CC5_CacheCacheBerkeleyDBStorable; use Cache::BerkeleyDB; use base 'Cache::BerkeleyDB'; sub name { return "Cache::BerkeleyDB Storable"; } 1; package CC5_CacheFileCacheStorable; use Cache::FileCache; use base 'Cache::FileCache'; sub name { return "Cache::FileCache Storable"; } 1; package CC6_CacheBDBStorable; use Cache::BDB; use base 'Cache::BDB'; sub name { return "Cache::BDB Storable"; } 1; package CC6_CacheFileStorable; use Cache::File; use base 'Cache::File'; sub name { return "Cache::File Storable"; } sub get { shift->thaw(@_); } sub set { shift->freeze(@_); } 1; Cache-BDB-0.04/cacheperl.patch0000644000076500007650000000044110426542357015745 0ustar joshjosh00000000000000115a116,119 > CC7_CacheBDBStorable => [ 'complex', > cache_root => "/tmp", > namespace => "testcache_cache_bdb", > ], 723a728,734 > package CC6_CacheBDBStorable; > use Cache::BDB; > use base 'Cache::BDB'; > > sub name { return "Cache::BDB Storable"; } > 1; > Cache-BDB-0.04/Changes0000644000076500007650000000176610460246666014306 0ustar joshjosh00000000000000Revision history for Cache-BDB 0.04 2006-07-14 Added support for db->compact, freeing unused space from cache db files. Requires BerkeleyDB.pm 0.29 and Berkeley DB 4.4. Added delete alias for remove. Added get_bulk() method. Added close() method. Enabled size() method if Devel::Size is available. Added disable_auto_purge option. Separated pod into BDB.pod. 0.03 2006-06-21 Changed default type to Btree in preparation for the addition of DB->compact to the BerkeleyDB perl wrapper. Chances are good I'll add this functionality with some kind of options as soon as its available to keep cache file sizes to a minimum. Added mkpath() so that a cache_root will be created several directories deep if it doesn't yet exist. Fixed a bug related to opening an existing physical db file with a new logical db. Some other minor cleanup here and there. 0.02 2006-06-04 Added some documentaion 0.01 2006-05-02 First version, released on an unsuspecting world. Cache-BDB-0.04/lib/0000755000076500007650000000000010460246673013545 5ustar joshjosh00000000000000Cache-BDB-0.04/lib/Cache/0000755000076500007650000000000010460246673014550 5ustar joshjosh00000000000000Cache-BDB-0.04/lib/Cache/BDB.pm0000644000076500007650000002233410460245375015477 0ustar joshjosh00000000000000package Cache::BDB; use strict; use warnings; use BerkeleyDB; use Storable; use File::Path qw(mkpath); our $VERSION = '0.04'; use constant DEFAULT_DB_TYPE => 'Btree'; ############################# # Construction/Destruction. # ############################# sub new { my ($proto, %params) = @_; my $class = ref($proto) || $proto; die "$class requires Berkeley DB version 3 or greater" unless $BerkeleyDB::db_version >= 3; # can't do anything without at least these params die "$class: cache_root not specified" unless($params{cache_root}); die "$class: namespace not specified" unless($params{namespace}); my $cache_root = $params{cache_root}; unless(-d $cache_root) { eval { mkpath($cache_root, 0, 0777); }; if($@) { die "$class: cache_root '$cache_root' unavailable: $@"; } } my $env = BerkeleyDB::Env->new( -Home => $cache_root, -Flags => (DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL), -ErrPrefix => $class, -ErrFile => *STDERR, -SetFlags => $params{env_lock} ? DB_CDB_ALLDB : 0, -Verbose => 1, ) or die "$class: Unable to create env: $BerkeleyDB::Error"; my $type = join('::', 'BerkeleyDB', ($params{type} && ($params{type} eq 'Btree' || $params{type} eq 'Hash' || $params{type} eq 'Recno')) ? $params{type} : DEFAULT_DB_TYPE); my $fname = $params{cache_file} || join('.', $params{namespace}, "db"); my $db = $type->new( -Env => $env, -Subname => $params{namespace}, -Filename => $fname, -Flags => DB_CREATE, # -Pagesize => 8192, ); # make a second attempt to connect to the db. this should handle # the case where a cache was created with one type and connected # to again with a different type. should probably just be an # error, but just in case ... unless(defined $db ) { $db = BerkeleyDB::Unknown->new( -Env => $env, -Subname => $params{namespace}, -Filename => $fname, #-Pagesize => 8192, ); } die "$class: Unable to open db: $BerkeleyDB::Error" unless defined $db; # eventually these should support user defined subs and/or # options as well. $db->filter_store_value( sub { $_ = Storable::freeze($_) }); $db->filter_fetch_value( sub { $_ = Storable::thaw($_) }); # sync the db for good measure. $db->db_sync(); my $self = { # private stuff __env => $env, __last_purge_time => time(), __type => $type, __db => $db, # expiry/purge default_expires_in => $params{default_expires_in} || 0, auto_purge_interval => $params{auto_purge_interval} || 0, auto_purge_on_set => $params{auto_purge_on_set} || 0, auto_purge_on_get => $params{auto_purge_on_get} || 0, purge_on_init => $params{purge_on_init} || 0, purge_on_destroy => $params{purge_on_destroy} || 0, clear_on_init => $params{clear_on_init} || 0, clear_on_destroy => $params{clear_on_destroy} || 0, disable_auto_purge => $params{disable_auto_purge} || 0, # file/namespace namespace => $params{namespace}, cache_root => $params{cache_root}, # options disable_compact => $params{disable_compact}, }; bless $self, $class; $self->clear() if $self->{clear_on_init}; $self->purge() if $self->{purge_on_init}; return $self; } sub DESTROY { my $self = shift; $self->clear() if $self->{clear_on_destroy}; $self->purge() if $self->{purge_on_destroy}; undef $self->{__db}; undef $self->{__env}; } *close = \&DESTROY; ############################################## # Instance options and expiry configuration. # ############################################## sub namespace { my $self = shift; warn "namespace is read only" if shift; return $self->{namespace}; } sub auto_purge_interval { my ($self, $interval) = @_; if(defined($interval)) { return undef unless $interval =~ /^\d+$/; $self->{auto_purge_interval} = $interval; } return $self->{auto_purge_interval}; } sub auto_purge_on_set { my ($self, $v) = @_; if(defined($v)) { $self->{auto_purge_on_set} = $v; } return $self->{auto_purge_on_set}; } sub auto_purge_on_get { my ($self, $v) = @_; if(defined($v)) { $self->{auto_purge_on_get} = $v; } return $self->{auto_purge_on_get}; } ################################################# # Methods for setting and getting cached items. # ################################################# sub set { my ($self, $key, $value, $ttl) = @_; return 0 unless ($key && $value); my $db = $self->{__db}; my $rv; my $now = time(); if($self->{auto_purge_on_set}) { my $interval = $self->{auto_purge_interval}; if($now > ($self->{__last_purge_time} + $interval)) { $self->purge(); $self->{__last_purge_time} = $now; } } $ttl ||= $self->{default_expires_in}; my $expires = ($ttl) ? $now + $ttl : 0; my $data = {__expires => $expires, __set_time => $now, __last_access_time => $now, __version => $Cache::BDB::VERSION, __data => $value}; $rv = $db->db_put($key, $data); return $rv ? 0 : 1; } sub add { my ($self, $key, $value, $ttl) = @_; return $self->get($key) ? 0 : $self->set($key, $value, $ttl); } sub replace { my ($self, $key, $value, $ttl) = @_; return $self->get($key) ? $self->set($key, $value, $ttl) : 0; } sub get { my ($self, $key) = @_; return undef unless $key; my $db = $self->{__db}; my $t = time(); my $data; if($self->{auto_purge_on_get}) { my $interval = $self->{auto_purge_interval}; if($t > ($self->{__last_purge_time} + $interval)) { $self->purge(); $self->{__last_purge_time} = $t; } } my $rv = $db->db_get($key, $data); return undef if $rv == DB_NOTFOUND; return undef unless $data->{__data}; if($self->__is_expired($data, $t)) { $self->remove($key) unless $self->{disable_auto_purge}; return undef; } # this is pretty slow, leaving it out for now. if i start supporting # access time related stuff i'll need to work on it. # $self->_update_access_time($key, $data, $t); return $data->{__data}; } sub get_bulk { my $self = shift; my $t = time(); my $count = 0; my $db = $self->{__db}; my $cursor = $db->db_cursor(); my %ret; my ($k, $v) = ('',''); while($cursor->c_get($k, $v, DB_NEXT) == 0) { my $d = $self->get($k); $ret{$k} = $d if $d; } $cursor->c_close(); return \%ret; } sub _update_access_time { my ($self, $key, $data, $t) = @_; my $db = $self->{__db}; $t ||= time(); $data->{__last_access_time} = $t; my $rv = $db->db_put($key, $data); return $rv; } ########################### # Cache meta information. # ########################### sub count { my $self = shift; my $total = 0; my $db = $self->{__db}; my $stats = $db->db_stat; my $type = $db->type; $total = ($type == DB_HASH) ? $stats->{hash_ndata} : $stats->{bt_ndata}; return $total; } sub size { my $self = shift; my $db = $self->{__db}; eval { require Devel::Size }; if($@) { warn "size() currently requires Devel::Size"; return 0; } else { import Devel::Size qw(total_size); } my ($k, $v) = ('',''); my $size = 0; my $cursor = $self->{__db}->db_cursor(); while($cursor->c_get($k, $v, DB_NEXT) == 0) { $size += total_size($v->{__data}); } $cursor->c_close(); return $size; } ############################################## # Methods for removing items from the cache. # ############################################## sub remove { my ($self, $key) = @_; my $rv; my $v = ''; my $db = $self->{__db}; $rv = $db->db_del($key); warn "compaction failed!" if $self->_compact(); return $rv ? 0 : 1; } *delete = \&remove; sub clear { my $self = shift; my $rv; my $count = 0; my $db = $self->{__db}; $rv = $db->truncate($count); warn "compaction failed!" if $self->_compact(); return $count; } sub purge { my $self = shift; my $t = time(); my $count = 0; my $db = $self->{__db}; my $cursor = $db->db_cursor(DB_WRITECURSOR); my ($k, $v) = ('',''); while($cursor->c_get($k, $v, DB_NEXT) == 0) { if($self->__is_expired($v, $t)) { $cursor->c_del(); $count++; } } $cursor->c_close(); warn "compaction failed!" if $self->_compact(); return $count; } sub __is_expired { my ($self, $data, $t) = @_; $t ||= time(); return 1 if($data->{__expires} && $data->{__expires} < $t); return 0; } sub is_expired { my ($self, $key) = @_; my $data; my $t = time(); return 0 unless $key; my $db = $self->{__db}; my $rv = $db->db_get($key, $data); return 0 unless $data; return $self->__is_expired($data, $t); } sub _compact { my $self = shift; my $rv = 0; # assume success, if compact isn't available pretend its cool my $db = $self->{__db}; if($db->can('compact') && $db->type == DB_BTREE && !$self->{disable_compact}) { $rv = $db->compact(undef, undef, undef, DB_FREE_SPACE, undef); } return $rv; } 1; Cache-BDB-0.04/lib/Cache/BDB.pod0000644000076500007650000003700310460246627015645 0ustar joshjosh00000000000000=head1 NAME Cache::BDB - An object caching wrapper around BerkeleyDB =head1 SYNOPSIS use Cache::BDB; my %options = ( cache_root => "/tmp/caches", namespace => "Some::Namespace", default_expires_in => 300, # seconds ); my $cache = Cache::BDB->new(%options); # # [myshellprompt:~]$ find /tmp/caches # /tmp/caches/Some::Namespace/ # /tmp/caches/Some::Namespace/Some::Namespace.db # /tmp/caches/Some::Namespace/__db.001 # /tmp/caches/Some::Namespace/__db.002 # /tmp/caches/Some::Namespace/__db.003 # $cache->namespace(); # returns "Some::Namespace", read only $cache->default_expires_in(); # returns 300 $cache->default_expires_in(600); # change it to 600 $cache->set(1, \%some_hash); $cache->set('foo', 'bar'); $cache->set(20, $obj, 10); $cache->add(21, 'whatever'); # works, nothing with the key '21' set yet. $cache->add(21, 'coffeepot'); # fails, can only add() something that hasn't # yet been set $cache->replace(21, 'shoelace'); # replaces the data 'whatever' with # 'shoelace' $cache->replace(7, 'tattoo'); # fails key/value pair was never set() or # add()ed previously my $h = $cache->get(1); # $h and \%some_hash contain the same data my $bar = $cache->get('foo'); # $bar eq 'bar'; my $obj = $cache->get(20); # returns the blessed object $cache->count() == 3; # assuming 10 seconds has passed ... $cache->is_expired(20); # returns true .. $cache->purge(); $cache->get(20); # returns undef $cache->count() == 2; my $hr = $cache->get_bulk(); # $hr = {1 => {contents_of => '%some_hash'}, # 21 => 'shoelace' }; $cache->close(); # close the cache object =head1 DESCRIPTION This module implements a caching layer around BerkeleyDB for object persistence. It implements the basic methods necessary to add, retrieve, and remove objects. The main advantage over other caching modules is performance. I've attempted to stick with a B-like interface as much as possible, though it may differ here and there. =head1 DEPENDENCIES I've been developing using a very recent version of Berkeley DB (v4.4.20) and BerkeleyDB (v0.27). I'm pretty sure that most of the functionality the module relies on is available in Berkeley DB version 3 and higher, but so far I have not tested with older versions. I'm open to making version specific concessions if necessary. If at all possible, I would advise you to upgrade both Berkeley DB and BerkeleyDB to their latest respective versions. Cache::BDB currently serializes everything it stores with Storable. =head1 PERFORMANCE The intent of this module is to supply great performance with a reasonably feature rich API. There is no way this module can compete with, say, using BerkeleyDB directly, and if you don't need any kind of expiration, automatic purging, etc, that will more than likely be much faster. If you'd like to compare the speed of some other caching modules, have a look at B. I've included a patch which adds Cache::BDB to the benchmark. =head1 LOCKING All Cache::BDB environments are opened with the DB_INIT_CDB flag. This enables multiple-reader/single-writer locking handled entirely by the Berkeley DB internals at either the database or environment level. See http://www.sleepycat.com/docs/ref/cam/intro.html for more information on what this means for locking. Important: it is a bad idea to share a single Cache::BDB object across multiple processes or threads. Doing so is bound to cause you pain. Instead, have your thread/process instantiate its own Cache::BDB object. It is safe to have them all pointing at the same cache file. =head1 CACHE FILES For every new B object, a Berkeley DB Environment is created (or reused if it already exists). This means that even for a single cache object, at least 4 files need to be created, three for the environment and at least one for the actual data in the cache. Its possible for mutliple cache database files to share a single environment, and its also possible for multiple cache databases to share a single database file. See the SYNOPSIS above for a quick view of what you are likeley to find on the filesystem for a cache. Cache::BDB uses BerkeleyDB exclusively with regard to files, so if you have questions about whats in those files, you might familiarize yourself further with Berkeley DB. =head1 USAGE =over 4 =item B(%options) =item * cache_root Specify the top level directory to store cache and related files in. This parameter is required. Keep in mind that B uses a B environment object so more than one file will be written for each cache. =item * cache_file If you want to tell B exactly which file to use for your cache, specify it here. This paramater is required if you plan to use the env_lock option and/or if you want to have multiple logical databases (namespaces) in a single physical file. If unspecified, B will create its database file using the B. B should be relative to your cache_root, not fully-qualified, i.e. my %options = ( cache_root => '/some/location/for/caching/', cache_file => 'whatever.db', namespace => 'MyObjects'); This gives you, among other files, /some/location/for/caching/whatever.db. Your logical database inside of 'whatever.db' will be named with 'MyObject'. If you were to then instantiate another Cache::BDB with the following: my %options = ( cache_root => '/some/location/for/caching/', cache_file => 'whatever.db', namespace => 'MyOtherObjects'); You would now have two logical caches in one physical file, which is ok, but see B below for a better idea. =item * namespace Your B tells B where to store cache data under the B if no B is specified or what to call the database in the multi-database file if B is specified. It is a required parameter. For clarity, it might be best to instantiate B objects like so: my $namespace = 'MyObjects'; my %options = ( cache_root => "/some/location/for/caching/$namespace", namespace => $namespace ); Unlike the examples given above under cache_file, this allows you to locate a single cache type in its own directory, which gives you more flexibility to nuke it wholesale or move things around a little. =item * type Cache::BDB allows you to select the type of Berkeley DB storage mechanism to use. Your choices are Hash, Btree, and Recno. Queue isn't supported. I haven't tested the three supported types extensively. The default, if unspecified, is Btree, and this is probably good enough for most applications. Note that if a cache is created as one type it must remain that type. If you instantiate a Cache::BDB object with one type (or use the default), and then attempt to connect to the same cache with a newly instantiated object that uses a different type, you will get a warning, and Cache::BDB will be nice and connect you to the cache with its original type. Important: up until Berkeley DB 4.4.x, it has not been possible to shrink the physical size of a database file, which means that, technically, your cache files will never get smaller even if you delete everything from them. HOWEVER, with 4.4.x this functionality is now possiblye but it will only work with the Btree type. As soon as this is available in the BerkeleyDB.pm wrapper (soon I'm told), I'll be releasing a version with some options to allow this. Point being, this may be a good reason to stick with Btree. For more info, see http://www.sleepycat.com/docs/ref/am_conf/intro.html. =item * env_lock If multiple databases (same or different files) are opened using the same Berkeley DB environment, its possible to turn on environment level locking rather than file level locking. This may be advantageous if you have two separate but related caches. By passing in the env_lock parameter with any true value, the environment will be created in such a way that any databases created under its control will all lock whenever Berkeley DB attempts a read/write lock. This flag must be specified for every database opened under this environment. Note: this is very untested in Cache::BDB, and I don't know how necessary it is. =item * default_expires_in Time (in seconds) that cached objects should live. If set to 0, objects never expire. See B to enable a per-object value. =item * auto_purge_interval Time (in seconds) that the cached objects will be purged by one or both of the B types (get/set). If set to 0, auto purge is disabled. Note, of course, that objects won't actually be purged until some event actually takes place that will call purge (set or get), so if this is set to 300 but no gets or sets are called for more than 300 seconds, the items haven't actually been purged yet. =item * auto_purge_on_set If this item is true and B is greater than 0, calling the B method will first purge any expired records from the cache. =item * auto_purge_on_get If this item is true and B is greater than 0, calling the B method will first purge any expired records from the cache. =item * purge_on_init If set to a true value, purge will be called before the constructor returns. =item * purge_on_destroy If set to a true value, purge will be called before the object goes out of scope. =item * clear_on_init If set to a true value, clear will be called before the constructor returns. =item * clear_on_destroy If set to a true value, clear will be called before the object goes out of scope. =item * disable_compact Disable database compactions for clear, purge, delete and remove methods. See B below for more information on database compaction. =item * disable_auto_purge As a courtesy, Cache::BDB will automatically remove() any expired cache item you get() before returning undef. This is handy if you don't feel the need to do a lot of explicit cache purging, but if you only want purge, remove, delete or clear to actually delete cache items, you can disable this functionality by passing in disable_auto_purge with any true value. =back =over 4 =item B() Explicitly close the connection to the cache. A good idea. Essentially the same as undef'ing the object (explicitly calls DESTROY). =item B() This read only method returns the namespace that the cache object is currently associated with. =item B($seconds) Set/get the length of time (in seconds) that the cache object will wait before calling one or both of the B methodss. If set to 0, automatic purging is disabled. =item B(1/0) Enable/disable auto purge when B is called. =item B(1/0) Enable/disable auto purge when B is called. =item B($key, $value, [$seconds]) Store an item ($value) with the associated $key. Time to live (in seconds) can be optionally set with a third argument. Returns true on success. =item B($key, $value, [$seconds]) Only B in the cache if the key doesn't already exist. =item B($key, $value, [$seconds]) Only B in the cache if the key does exist. =item B($key) Locate and return the data associated with $key. Returns the object associated with $key or undef if the data doesn't exist. If B is enabled, the cache will be purged before attempting to locate the item. =item B() Returns a hash reference containing every unexpired item from the cache key'ed on their cache id. This can be useful if your keys aren't always available or if you just want to use the cache as a convenient way to dump data in chunks. The result looks something like this: my $h = $cache->get_bulk(); # $h = { 123 => "bird and bee", # 456 => "monkeys with sticks", # 789 => "take whats mine", # }; =item B($key) Removes the cache element specified by $key if it exists. Returns true for success. =item B($key) Same as remove() =item B() Completely clear out the cache and compact the underlying database. Returns the number of cached items removed. =item B() Returns the number of items in the cache. =item B() Return the size (in bytes) of all the cached items. This call relies on the availability of B. If its not found, you'll get a warning and size() will simply return 0. Currently the size is calculated every time this is called by using B, so it may be expensive for large caches. In the future size-aware options and functionality may be available, but for now you'll need to implement this outside of Cache::BDB if you need it. =item B() Purge expired items from the cache. Returns the number of items purged. =item B($key) Returns true if the data pointed to by $key is expired based on its stored expiration time. Returns false if the data isn't expired *or* if the data doesn't exist. =back =head1 DATABASE SIZE (See http://www.sleepycat.com/docs/ref/am_misc/diskspace.html) Before Berkeley DB release 4.4 it was not possible to return freed space in a database file. This means that no matter how many items you delete, your file will still retain its size, and continue to grow as you add more items. The only way to get the file size back down was to dump the database to a file and reload it into a new database file. This may or may not be a problem for your application, but keep in mind that your cache will continue to get bigger and, for example, your operating system may have a maximum file size limit. In 4.4, Sleepycat introduced the ability to free unused space. BerkeleyDB 0.29 exposes this functionality in the perl wrapper. If you are using these versions or better and have chosen the Btree database type (the default for Cache::BDB), your caches will automatically be compacted when items are purged, removed/deleted, or if clear is called. You can disable the automatic compaction of cache files by initializing your Cache::BDB object with the disable_compact parameter set to any true value. In my tests so far, however, database compaction does not appear to affect performance significantly, and may save you from a headache down the road. =head1 AUTHOR Josh Rotenberg, C<< >> =head1 TODO * Make data storage scheme configurable (Storable, YAML, Data::Dumper, or callback based) * Split storage between meta and data for faster operations on meta data. * Add some size/count aware features. * Create some examples. * Fix fork()'ing tests. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Cache::BDB You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 SEE ALSO BerkeleyDB =head1 ACKNOWLEDGEMENTS Baldur Kristinsson Sandy Jensen =head1 COPYRIGHT & LICENSE Copyright 2006 Josh Rotenberg, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Cache-BDB-0.04/Makefile.PL0000644000076500007650000000106110456256753014754 0ustar joshjosh00000000000000use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Cache::BDB', AUTHOR => 'Josh Rotenberg ', VERSION_FROM => 'lib/Cache/BDB.pm', ABSTRACT_FROM => 'lib/Cache/BDB.pod', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'BerkeleyDB' => '0.27', 'Storable' => 0, 'File::Path' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Cache-BDB-*' }, ); Cache-BDB-0.04/MANIFEST0000644000076500007650000000036110456256606014132 0ustar joshjosh00000000000000Changes MANIFEST META.yml # Will be created by "make dist" Makefile.PL README cacheperl.patch bench.t lib/Cache/BDB.pm lib/Cache/BDB.pod t/00-load.t t/01-load.t t/02-api.t t/03-lock.t t/03-lock-env.t t/boilerplate.t t/pod-coverage.t t/pod.t Cache-BDB-0.04/META.yml0000644000076500007650000000070510460246672014251 0ustar joshjosh00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Cache-BDB version: 0.04 version_from: lib/Cache/BDB.pm installdirs: site requires: BerkeleyDB: 0.27 File::Path: 0 Storable: 0 Test::More: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Cache-BDB-0.04/README0000644000076500007650000000151010426542357013654 0ustar joshjosh00000000000000Cache-BDB Cache-BDB - A caching module based on BerkeleyDB INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Cache::BDB You can also look for information at: Search CPAN http://search.cpan.org/dist/Cache-BDB CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Cache-BDB AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Cache-BDB CPAN Ratings: http://cpanratings.perl.org/d/Cache-BDB COPYRIGHT AND LICENCE Copyright (C) 2006 Josh Rotenberg This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Cache-BDB-0.04/t/0000755000076500007650000000000010460246673013242 5ustar joshjosh00000000000000Cache-BDB-0.04/t/00-load.t0000644000076500007650000000021410426542357014560 0ustar joshjosh00000000000000#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Cache::BDB' ); } diag( "Testing Cache::BDB $Cache::BDB::VERSION, Perl $], $^X" ); Cache-BDB-0.04/t/01-load.t0000644000076500007650000000337510460244261014563 0ustar joshjosh00000000000000use Test::More tests => 73; use Cwd; use File::Path qw(rmtree); use_ok('Cache::BDB'); use Cache::BDB; my $cache_root_base = './t/01'; END { rmtree($cache_root_base); } # verify that we can create a cache with no explicit file name and that its # db file will web named $namespace.db my $c = Cache::BDB->new(cache_root => $cache_root_base, namespace => 'test', default_expires_in => 10, type => 'Btree'); ok(-e join('/', $cache_root_base, 'test.db')); # verify that we'll create a full path if need be my $f = Cache::BDB->new(cache_root => join('/', $cache_root_base, 'Cache::BDB', $$, 'test'), namespace => 'whatever'); ok(-e join('/', $cache_root_base, 'Cache::BDB', $$, 'test', 'whatever.db')); # verify that we can create a single file with multiple dbs my @names = qw(one two three four five six seven eight nine ten); for my $name (@names) { my %options = ( cache_root => $cache_root_base, namespace => $name, default_expires_in => 10, ); $options{type} = 'Hash' if $name eq 'two'; # diag("\ncreating namespace $name in db one.db"); my $c = Cache::BDB->new(%options); isa_ok($c, 'Cache::BDB'); is($c->set('namespace', $name),1); is($c->count(), 1); is($c->close(), undef); } # verify that those databases can be connected to and contain what we # put in them for my $name (@names) { my %options = ( cache_root => $cache_root_base, namespace => $name, default_expires_in => 10, ); # diag("connecting to namespace $name in db one.db"); diag("expect a warning here") if $name eq 'two'; my $c = Cache::BDB->new(%options); isa_ok($c, 'Cache::BDB'); is($c->get('namespace'), $name); is($c->count(), 1); undef $c; } Cache-BDB-0.04/t/02-api.t0000644000076500007650000000605710460245217014420 0ustar joshjosh00000000000000use Test::More tests => 60; use Cache::BDB; use BerkeleyDB; use File::Path qw(rmtree); my %options = ( cache_root => './t/02', namespace => "Cache::BDB::02", default_expires_in => 10, ); END { rmtree($options{cache_root}); } my $hash1 = {foo=>'bar'}; my $hash2 = {bleh => 'blah', doof => [4,6,9]}; my $array1 = [1, 'two', 3]; my $array2 = [3,12,123,213,213213,4354356,565465,'das1', 'two', 3]; my $obj1 = bless ( {foo => $hash1, bleh => $hash2, moobie => $array2}, 'Some::Class'); my $c = Cache::BDB->new(%options); ok(-e join('/', $options{cache_root}, 'Cache::BDB::02.db')); isa_ok($c, 'Cache::BDB'); can_ok($c, qw(set get remove purge size count namespace)); is($c->set(1, $hash1), 1); is_deeply($c->get(1), $hash1); is($c->count, 1); is($c->set(2, $hash2),1); is_deeply($c->get(2), $hash2); is($c->count, 2); is($c->set(3, $array1),1); is_deeply($c->get(3), $array1); is($c->count, 3); is($c->set(4, $obj1),1); is_deeply($c->get(4), $obj1); is($c->count, 4); is($c->count, scalar(keys %{$c->get_bulk})); is($c->remove(1), 1); is($c->get(1),undef); is($c->count, 3); is($c->set(5, $array2,2),1); is($c->count, 4); is($c->set(6, $hash1,5),1); is($c->count, 5); sleep 3; is($c->is_expired(5), 1, "expired? (should be)"); is($c->purge(), 1); is($c->is_expired(6), 0, "expired? (shouldn't be)"); is($c->get(5),undef); is($c->count, 4); is_deeply($c->get(6),$hash1); is($c->clear(), 4); is($c->get(2),undef); is($c->get(3),undef); is($c->count, 0); is($c->set(7, $hash1),1); is($c->set(8, $hash2),1); is($c->set(9, $array1),1); is($c->set(10, $array2),1); is($c->count, 4); is($c->set(10, $hash2), 1); is_deeply($c->get(10), $hash2); undef $c; is(undef, $c); my $c2 = Cache::BDB->new(%options); is_deeply($c2->get(7), $hash1); is_deeply($c2->get(8), $hash2); is_deeply($c2->get(9), $array1); is_deeply($c2->get(10), $hash2); is($c2->set('foo', 'bar'),1); is($c2->get('foo'), 'bar'); my %h = (some => 'data', goes => 'here'); is($c2->set(100, \%h), 1); is_deeply(\%h, $c2->get(100)); is($c2->add(100, \%h), 0, "Can't add, already exists"); is($c2->replace(100, \%h), 1, 'Can replace, already exists'); is($c2->add(101, \%h), 1, "Can add, doesn't exist yet"); is($c2->replace(102, \%h), 0, "Can't replace, doesn't exist"); is($c2->is_expired(6), 0, "expired? (should be by now)"); SKIP: { eval { require Devel::Size }; skip "Devel::Size note available", 3 if $@; ok($c2->size > 0); ok($c2->clear()); ok($c2->size == 0); } SKIP: { skip "db->compact not available", 2 unless ($BerkeleyDB::VERSION >= 0.29 && $BerkeleyDB::db_version >= 4.4); # add a bunch of data map { $c2->set($_, $_ * rand(int(20))) } (1 .. 12345); my $h = $c2->get_bulk(); is(scalar(keys %$h), $c2->count); # and see how big the file is my $size_before = (stat(join('/', $options{cache_root}, 'Cache::BDB::02.db')))[7]; my $count_before = $c2->count(); # clear it out is($c2->clear(), $count_before); # and check again. my $size_after = (stat(join('/', $options{cache_root}, 'Cache::BDB::02.db')))[7]; ok($size_before > $size_after); } Cache-BDB-0.04/t/03-lock-env.t0000644000076500007650000000406410455757024015372 0ustar joshjosh00000000000000use Time::HiRes qw(tv_interval gettimeofday); use Test::More skip_all => "need to deal with forking tests"; use Cache::BDB; use strict; my $kids = 5; # number of children to spawn my $iterations = 1; # number of times each kid should do its thing my $rows = 10; # number of rows each child should write, then read my %options1 = ( cache_root => './t/03', cache_file => "two.db", namespace => "Cache::BDB::envlock1", env_lock => 1, default_expires_in => 100, ); my %options2 = ( cache_root => "./t/03", cache_file => "two.db", namespace => "Cache::BDB::envlock2", env_lock => 1, default_expires_in => 100, ); my @pids = (); for(my $i = 0; $i <= $kids; $i++) { if(my $pid = fork() ) { push @pids, $pid; } else { run_child(); } } diag("spawned $kids children " . join(', ', @pids)); foreach my $kid (@pids) { waitpid($kid, 0); diag("$kid done"); } my $c = Cache::BDB->new(%options2); diag("found " . $c->count() . " records"); is($c->count(), $rows); sub run_child { my %options1 = ( cache_root => "./t/03", cache_file => "two.db", namespace => "Cache::BDB::envlock1", env_lock => 1, default_expires_in => 100, ); my %options2 = ( cache_root => "./t/03", cache_file => "two.db", namespace => "Cache::BDB::envlock2", env_lock => 1, default_expires_in => 100, ); my $t0 = [gettimeofday]; my $c1 = Cache::BDB->new(%options1); my $c2 = Cache::BDB->new(%options2); for (0 .. $iterations) { for (my $j = 1; $j <= $rows; $j++) { my $r = $j x 4; my $rv1 = $c1->set($j, { $j => $r} ); diag("$$ faild to write $j => $r") if $rv1; is($rv1, ''); my $rv2 = $c2->set($j, { $j => $r} ); diag("$$ faild to write $j => $r") if $rv2; is($rv2, ''); $rv1 = $c1->get($j); diag("$$ faild to read $j => $r") unless is_deeply($rv1, { $j => $r}); $rv2 = $c2->get($j); diag("$$ faild to read $j => $r") unless is_deeply($rv2, { $j => $r}); } } my $t1 = [gettimeofday]; diag("$$: " . tv_interval($t0, $t1) . " seconds"); exit; } Cache-BDB-0.04/t/03-lock.t0000644000076500007650000000351210455756765014614 0ustar joshjosh00000000000000 use Time::HiRes qw(tv_interval gettimeofday); use Test::More skip_all => "need to deal with forking tests"; use Data::Dumper; use Cache::BDB; use File::Path qw(rmtree); use strict; my $kids = 15; # number of children to spawn my $iterations = 15; # number of times each kid should do its thing my $rows = 120; # number of rows each child should write, then read my %options = ( cache_root => './t/03', cache_file => "one.db", namespace => "Cache::BDB::lock", # default_expires_in => 10, ); END { } # create a cache object so the environment is already in place, but then undef # it so we don't give each child multiple handles my @pids = (); for(my $i = 0; $i <= $kids; $i++) { if(my $pid = fork() ) { push @pids, $pid; } else { run_child(); } } diag("spawned $kids children " . join(', ', @pids)); foreach my $kid (@pids) { waitpid($kid, 0); diag("$kid done"); } my $r = Cache::BDB->new(%options); diag("found " . $r->count() . " records"); is($r->count(), $rows); sub run_child { my $t0 = [gettimeofday]; my %results; my $c = Cache::BDB->new(%options); my @ids; for my $it (0 .. $iterations) { for (my $j = 1; $j <= $rows; $j++) { # my $r = ($j ** $it) x 4; # sleep 1 if $$ % 2 == 0; my $lk = $c->{__db}->cds_lock; # diag("$$: locked, setting row $j"); my $rv = $c->set($j, $$); $lk->cds_unlock(); # diag("$$: unlocked"); #diag("$$: set $j"); push @ids, $j; } } diag("$$: getting $rows rows $iterations times"); for(0 .. $iterations) { for(@ids) { my $rv = $c->get($_); #diag("$$: got $rv for $_") unless $$ eq $rv; $results{$$}->{$_} = $rv; } } my $t1 = [gettimeofday]; diag("$$: finished in " . tv_interval($t0, $t1) . " seconds"); # diag(Dumper \%results); exit 0; } Cache-BDB-0.04/t/boilerplate.t0000644000076500007650000000232010426542357015726 0ustar joshjosh00000000000000#!perl -T use strict; use warnings; use Test::More tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open my $fh, "<", $filename or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } module_boilerplate_ok('lib/Cache/BDB.pm'); Cache-BDB-0.04/t/pod-coverage.t0000644000076500007650000000025410426542357016003 0ustar joshjosh00000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Cache-BDB-0.04/t/pod.t0000644000076500007650000000021410426542357014206 0ustar joshjosh00000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();