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 (file)
--- a/lib/DBM/Deep.pod
+++ b/lib/DBM/Deep.pod
@@ -1069,12 +1069,12 @@ B<Devel::Cover> 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 (file)
--- 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 (file)
--- 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" );
+}