1use Test::More tests => 60; 2use Cache::BDB; 3use BerkeleyDB; 4use File::Path qw(rmtree); 5 6my %options = ( 7 cache_root => './t/02', 8 namespace => "Cache::BDB::02", 9 default_expires_in => 10, 10); 11 12END { 13 rmtree($options{cache_root}); 14} 15 16my $hash1 = {foo=>'bar'}; 17my $hash2 = {bleh => 'blah', doof => [4,6,9]}; 18my $array1 = [1, 'two', 3]; 19my $array2 = [3,12,123,213,213213,4354356,565465,'das1', 'two', 3]; 20my $obj1 = bless ( {foo => $hash1, bleh => $hash2, moobie => $array2}, 'Some::Class'); 21my $c = Cache::BDB->new(%options); 22 23ok(-e join('/', 24 $options{cache_root}, 25 'Cache::BDB::02.db')); 26 27isa_ok($c, 'Cache::BDB'); 28can_ok($c, qw(set get remove purge size count namespace)); 29 30is($c->set(1, $hash1), 1); 31is_deeply($c->get(1), $hash1); 32is($c->count, 1); 33 34is($c->set(2, $hash2),1); 35is_deeply($c->get(2), $hash2); 36is($c->count, 2); 37 38is($c->set(3, $array1),1); 39is_deeply($c->get(3), $array1); 40is($c->count, 3); 41 42is($c->set(4, $obj1),1); 43is_deeply($c->get(4), $obj1); 44is($c->count, 4); 45is($c->count, scalar(keys %{$c->get_bulk})); 46 47is($c->remove(1), 1); 48is($c->get(1),undef); 49is($c->count, 3); 50 51is($c->set(5, $array2,2),1); 52is($c->count, 4); 53 54is($c->set(6, $hash1,5),1); 55is($c->count, 5); 56 57sleep 3; 58 59is($c->is_expired(5), 1, "expired? (should be)"); 60is($c->purge(), 1); 61 62is($c->is_expired(6), 0, "expired? (shouldn't be)"); 63is($c->get(5),undef); 64 65is($c->count, 4); 66is_deeply($c->get(6),$hash1); 67 68is($c->clear(), 4); 69is($c->get(2),undef); 70is($c->get(3),undef); 71 72is($c->count, 0); 73 74is($c->set(7, $hash1),1); 75is($c->set(8, $hash2),1); 76is($c->set(9, $array1),1); 77is($c->set(10, $array2),1); 78 79is($c->count, 4); 80 81is($c->set(10, $hash2), 1); 82 83is_deeply($c->get(10), $hash2); 84 85undef $c; 86is(undef, $c); 87my $c2 = Cache::BDB->new(%options); 88 89is_deeply($c2->get(7), $hash1); 90is_deeply($c2->get(8), $hash2); 91is_deeply($c2->get(9), $array1); 92is_deeply($c2->get(10), $hash2); 93 94is($c2->set('foo', 'bar'),1); 95is($c2->get('foo'), 'bar'); 96 97my %h = (some => 'data', goes => 'here'); 98is($c2->set(100, \%h), 1); 99 100is_deeply(\%h, $c2->get(100)); 101 102is($c2->add(100, \%h), 0, "Can't add, already exists"); 103is($c2->replace(100, \%h), 1, 'Can replace, already exists'); 104 105is($c2->add(101, \%h), 1, "Can add, doesn't exist yet"); 106is($c2->replace(102, \%h), 0, "Can't replace, doesn't exist"); 107 108is($c2->is_expired(6), 0, "expired? (should be by now)"); 109 110SKIP: { 111 eval { require Devel::Size }; 112 skip "Devel::Size note available", 3 if $@; 113 114 ok($c2->size > 0); 115 ok($c2->clear()); 116 ok($c2->size == 0); 117 118} 119 120SKIP: { 121 skip "db->compact not available", 2 unless 122 ($BerkeleyDB::VERSION >= 0.29 && $BerkeleyDB::db_version >= 4.4); 123 # add a bunch of data 124 map { $c2->set($_, $_ * rand(int(20))) } (1 .. 12345); 125 126 my $h = $c2->get_bulk(); 127 is(scalar(keys %$h), $c2->count); 128 # and see how big the file is 129 my $size_before = (stat(join('/', $options{cache_root}, 130 'Cache::BDB::02.db')))[7]; 131 132 my $count_before = $c2->count(); 133 134 # clear it out 135 is($c2->clear(), $count_before); 136 137 # and check again. 138 my $size_after = (stat(join('/', $options{cache_root}, 139 'Cache::BDB::02.db')))[7]; 140 141 ok($size_before > $size_after); 142} 143 144