From: rkinyon Date: Fri, 19 Jan 2007 06:40:04 +0000 (+0000) Subject: r14861@rob-kinyons-computer: rob | 2007-01-18 19:30:04 -0500 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3a91747434ce46b5bd5e784fd1e281cc5c005091;p=dbsrgits%2FDBM-Deep.git r14861@rob-kinyons-computer: rob | 2007-01-18 19:30:04 -0500 Added some code to handling actual deleting of keys, thus being able to reuse that space --- diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod index 4bab964..bf2b48f 100644 --- a/lib/DBM/Deep.pod +++ b/lib/DBM/Deep.pod @@ -1069,12 +1069,12 @@ B report on this distribution's test suite. ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ - blib/lib/DBM/Deep.pm 96.8 87.9 90.5 100.0 89.5 4.6 95.2 - blib/lib/DBM/Deep/Array.pm 100.0 94.3 100.0 100.0 100.0 5.0 98.7 - blib/lib/DBM/Deep/Engine.pm 97.5 86.4 79.7 100.0 0.0 58.6 90.9 - blib/lib/DBM/Deep/File.pm 99.0 88.9 77.8 100.0 0.0 29.3 90.3 - blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 2.5 100.0 - Total 98.0 88.6 84.0 100.0 32.1 100.0 93.2 + blib/lib/DBM/Deep.pm 96.8 87.9 90.5 100.0 89.5 4.5 95.2 + blib/lib/DBM/Deep/Array.pm 100.0 94.3 100.0 100.0 100.0 4.9 98.7 + blib/lib/DBM/Deep/Engine.pm 96.9 85.2 79.7 100.0 0.0 58.2 90.3 + blib/lib/DBM/Deep/File.pm 99.0 88.9 77.8 100.0 0.0 30.0 90.3 + blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 2.4 100.0 + Total 97.6 87.9 84.0 100.0 32.1 100.0 92.8 ---------------------------- ------ ------ ------ ------ ------ ------ ------ =head1 MORE INFORMATION diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 690fff2..c5fca98 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -718,6 +718,10 @@ sub _request_sector { # Read the new head after the signature and the staleness counter my $new_head = $self->storage->read_at( $loc + SIG_SIZE + STALE_SIZE, $self->byte_size ); $self->storage->print_at( $self->chains_loc + $chains_offset, $new_head ); + $self->storage->print_at( + $loc + SIG_SIZE + STALE_SIZE, + pack( $StP{$self->byte_size}, 0 ), + ); return $loc; } @@ -1044,10 +1048,13 @@ sub data_length { sub chain_loc { my $self = shift; - my $chain_loc = $self->engine->storage->read_at( - $self->offset + $self->base_size, $self->engine->byte_size, + return unpack( + $StP{$self->engine->byte_size}, + $self->engine->storage->read_at( + $self->offset + $self->base_size, + $self->engine->byte_size, + ), ); - return unpack( $StP{$self->engine->byte_size}, $chain_loc ); } sub data { @@ -1260,8 +1267,9 @@ sub delete_key { }); my $old_value = $location && $self->engine->_load_sector( $location ); + my @trans_ids = $self->engine->get_running_txn_ids; + if ( $self->engine->trans_id == 0 ) { - my @trans_ids = $self->engine->get_running_txn_ids; if ( @trans_ids ) { foreach my $other_trans_id ( @trans_ids ) { next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 }); @@ -1275,12 +1283,17 @@ sub delete_key { } } - $blist->mark_deleted( $args ); - my $data; - if ( $old_value ) { - $data = $old_value->data; - $old_value->free; + if ( @trans_ids ) { + $blist->mark_deleted( $args ); + + if ( $old_value ) { + $data = $old_value->data; + $old_value->free; + } + } + else { + $data = $blist->delete_md5( $args ); } return $data; @@ -1656,8 +1669,6 @@ sub mark_deleted { ); } -=pod -# This has been commented out until it is used in order to not bring coverage stats down. sub delete_md5 { my $self = shift; my ($args) = @_; @@ -1671,13 +1682,11 @@ sub delete_md5 { }); my $key_sector = $self->get_key_for; - #XXX This isn't going to work right and you know it! This eradicates data - # that we're not ready to eradicate just yet. my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size; $engine->storage->print_at( $spot, $engine->storage->read_at( $spot + $self->bucket_size, - $self->bucket_size * ( $engine->num_txns - $self->{idx} - 1 ), + $self->bucket_size * ( $engine->max_buckets - $self->{idx} - 1 ), ), chr(0) x $self->bucket_size, ); @@ -1690,7 +1699,6 @@ sub delete_md5 { return $data; } -=cut sub get_data_location_for { my $self = shift; diff --git a/t/40_freespace.t b/t/40_freespace.t index a4bfa9a..bc8216d 100644 --- a/t/40_freespace.t +++ b/t/40_freespace.t @@ -2,66 +2,82 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 16; +use Test::More tests => 13; use Test::Exception; use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); -my ($fh, $filename) = new_fh(); -my $db = DBM::Deep->new( $filename ); +{ + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new({ + file => $filename, + autoflush => 1, + }); -$db->{foo} = '1234'; -$db->{foo} = '2345'; + $db->{foo} = '1234'; + $db->{foo} = '2345'; -my $size = -s $filename; -$db->{foo} = '3456'; -cmp_ok( $size, '==', -s $filename, "A second overwrite doesn't change size" ); + my $size = -s $filename; + $db->{foo} = '3456'; + cmp_ok( $size, '==', -s $filename, "A second overwrite doesn't change size" ); -$size = -s $filename; -delete $db->{foo}; -cmp_ok( $size, '==', -s $filename, "Deleted space isn't released" ); + $size = -s $filename; + delete $db->{foo}; + cmp_ok( $size, '==', -s $filename, "Deleted space isn't released" ); -$size = -s $filename; -$db->{bar} = '2345'; -cmp_ok( $size, '==', -s $filename, "Added a new key after a delete reuses space" ); + $db->{bar} = '2345'; + cmp_ok( $size, '==', -s $filename, "Added a new key after a delete reuses space" ); -$db->{baz} = {}; -$size = -s $filename; + $db->{baz} = {}; + $size = -s $filename; -delete $db->{baz}; -$db->{baz} = {}; + delete $db->{baz}; + $db->{baz} = {}; -cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" ); + cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" ); -$db->{baz} = {}; -$size = -s $filename; + $db->{baz} = {}; + $size = -s $filename; -$db->{baz} = {}; + $db->{baz} = {}; -cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" ); + cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" ); -my $x = { foo => 'bar' }; -$db->{floober} = $x; + my $x = { foo => 'bar' }; + $db->{floober} = $x; -delete $db->{floober}; + delete $db->{floober}; -ok( !exists $x->{foo}, "Deleting floober makes \$x empty (exists)" ); -is( $x->{foo}, undef, "Deleting floober makes \$x empty (read)" ); -is( delete $x->{foo}, undef, "Deleting floober makes \$x empty (delete)" ); + ok( !exists $x->{foo}, "Deleting floober makes \$x empty (exists)" ); + is( $x->{foo}, undef, "Deleting floober makes \$x empty (read)" ); + is( delete $x->{foo}, undef, "Deleting floober makes \$x empty (delete)" ); -eval { $x->{foo} = 'bar'; }; -like( $@, qr/Cannot write to a deleted spot in DBM::Deep/, "Exception thrown when writing" ); + eval { $x->{foo} = 'bar'; }; + like( $@, qr/Cannot write to a deleted spot in DBM::Deep/, "Exception thrown when writing" ); -cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after deletion" ); + cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after deletion" ); +} -$db->{buzzer} = { foo => 'baz' }; +{ + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new({ + file => $filename, + autoflush => 1, + }); -ok( !exists $x->{foo}, "Even after the space has been reused, \$x is still empty" ); -is( $x->{foo}, undef, "Even after the space has been reused, \$x is still empty" ); -is( delete $x->{foo}, undef, "Even after the space has been reused, \$x is still empty" ); + $db->{ $_ } = undef for 1 .. 4; + delete $db->{ $_ } for 1 .. 4; + cmp_ok( keys %{ $db }, '==', 0, "We added and removed 4 keys" ); -eval { $x->{foo} = 'bar'; }; -like( $@, qr/Cannot write to a deleted spot in DBM::Deep/, "Exception thrown when writing" ); + # So far, we've written 4 keys. Let's write 13 more keys. This should -not- + # trigger a reindex. This requires knowing how much space is taken. Good thing + # we wrote this dreck ... + my $size = -s $filename; + + my $expected = $size + 9 * ( 256 + 256 ); -cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after space reuse" ); + $db->{ $_ } = undef for 5 .. 17; + + cmp_ok( $expected, '==', -s $filename, "No reindexing after deletion" ); +}