Added staleness checking

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index bf71625..b1441d6 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -119,6 +119,7 @@ sub _init {
     my $self = bless {
         type        => TYPE_HASH,
         base_offset => undef,
+        staleness   => undef,
 
         storage     => undef,
         engine      => undef,
@@ -324,6 +325,7 @@ sub clone {
     return DBM::Deep->new(
         type        => $self->_type,
         base_offset => $self->_base_offset,
+        staleness   => $self->_staleness,
         storage     => $self->_storage,
         engine      => $self->_engine,
     );
@@ -393,6 +395,11 @@ sub _base_offset {
     return $self->{base_offset};
 }
 
+sub _staleness {
+    my $self = $_[0]->_get_self;
+    return $self->{staleness};
+}
+
 sub _fh {
     my $self = $_[0]->_get_self;
     return $self->_storage->{fh};

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 5c61d37..7bddf2d 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -107,6 +107,10 @@ sub read_value {
     my $sector = $self->_load_sector( $obj->_base_offset )
         or return;
 
+    if ( $sector->staleness != $obj->_staleness ) {
+        return;
+    }
+
     my $key_md5 = $self->_apply_digest( $key );
 
     my $value_sector = $sector->get_data_for({
@@ -138,6 +142,10 @@ sub get_classname {
     my $sector = $self->_load_sector( $obj->_base_offset )
         or die "How did get_classname fail (no sector for '$obj')?!\n";
 
+    if ( $sector->staleness != $obj->_staleness ) {
+        return;
+    }
+
     return $sector->get_classname;
 }
 
@@ -149,6 +157,10 @@ sub key_exists {
     my $sector = $self->_load_sector( $obj->_base_offset )
         or return '';
 
+    if ( $sector->staleness != $obj->_staleness ) {
+        return '';
+    }
+
     my $data = $sector->get_data_for({
         key_md5    => $self->_apply_digest( $key ),
         allow_head => 1,
@@ -165,6 +177,10 @@ sub delete_key {
     my $sector = $self->_load_sector( $obj->_base_offset )
         or return;
 
+    if ( $sector->staleness != $obj->_staleness ) {
+        return;
+    }
+
     return $sector->delete_key({
         key_md5    => $self->_apply_digest( $key ),
         allow_head => 0,
@@ -208,6 +224,10 @@ sub write_value {
     my $sector = $self->_load_sector( $obj->_base_offset )
         or die "Cannot write to a deleted spot in DBM::Deep.\n";
 
+    if ( $sector->staleness != $obj->_staleness ) {
+        die "Cannot write to a deleted spot in DBM::Deep.\n";
+    }
+
     # Create this after loading the reference sector in case something bad happens.
     # This way, we won't allocate value sector(s) needlessly.
     my $value_sector = $class->new({
@@ -231,6 +251,7 @@ sub write_value {
         my @temp = @$value;
         tie @$value, 'DBM::Deep', {
             base_offset => $value_sector->offset,
+            staleness   => $value_sector->staleness,
             storage     => $self->storage,
             engine      => $self,
         };
@@ -241,6 +262,7 @@ sub write_value {
         my %temp = %$value;
         tie %$value, 'DBM::Deep', {
             base_offset => $value_sector->offset,
+            staleness   => $value_sector->staleness,
             storage     => $self->storage,
             engine      => $self,
         };
@@ -252,6 +274,7 @@ sub write_value {
     return 1;
 }
 
+# XXX Add staleness here
 sub get_next_key {
     my $self = shift;
     my ($obj, $prev_key) = @_;
@@ -264,7 +287,7 @@ sub get_next_key {
         });
     }
 
-    return $obj->{iterator}->get_next_key;
+    return $obj->{iterator}->get_next_key( $obj );
 }
 
 ################################################################################
@@ -287,6 +310,7 @@ sub setup_fh {
                 type   => $obj->_type,
             });
             $obj->{base_offset} = $initial_reference->offset;
+            $obj->{staleness} = $initial_reference->staleness;
 
             $self->storage->flush;
         }
@@ -304,6 +328,8 @@ sub setup_fh {
             unless ($obj->_type eq $initial_reference->type) {
                 DBM::Deep->_throw_error("File type mismatch");
             }
+
+            $obj->{staleness} = $initial_reference->staleness;
         }
     }
 
@@ -621,14 +647,21 @@ sub _add_free_sector {
         $chains_offset = 0;
     }
 
-    my $old_head = $self->storage->read_at( $self->chains_loc + $chains_offset, $self->byte_size );
+    my $storage = $self->storage;
+
+    # Increment staleness.
+    my $staleness = unpack( $StP{1}, $storage->read_at( $offset + 1, 1 ) );
+    $staleness = ($staleness + 1 ) % ( 2 ** ( 8 * 1 ) );
+    $storage->print_at( $offset + 1, pack( $StP{1}, $staleness ) );
 
-    $self->storage->print_at( $self->chains_loc + $chains_offset,
+    my $old_head = $storage->read_at( $self->chains_loc + $chains_offset, $self->byte_size );
+
+    $storage->print_at( $self->chains_loc + $chains_offset,
         pack( $StP{$self->byte_size}, $offset ),
     );
 
-    # Record the old head in the new sector after the signature
-    $self->storage->print_at( $offset + 1, $old_head );
+    # Record the old head in the new sector after the signature and staleness counter
+    $storage->print_at( $offset + 1 + 1, $old_head );
 }
 
 sub _request_sector {
@@ -650,10 +683,17 @@ sub _request_sector {
 
     # We don't have any free sectors of the right size, so allocate a new one.
     unless ( $loc ) {
-        return $self->storage->request_space( $size );
+        my $offset = $self->storage->request_space( $size );
+
+        # Zero out the new sector. This also guarantees correct increases
+        # in the filesize.
+        $self->storage->print_at( $offset, chr(0) x $size );
+
+        return $offset;
     }
 
-    my $new_head = $self->storage->read_at( $loc + 1, $self->byte_size );
+    # Read the new head after the signature and the staleness counter
+    my $new_head = $self->storage->read_at( $loc + 1 + 1, $self->byte_size );
     $self->storage->print_at( $self->chains_loc + $chains_offset, $new_head );
 
     return $loc;
@@ -703,6 +743,7 @@ sub reset {
 
 sub get_next_key {
     my $self = shift;
+    my ($obj) = @_;
 
     my $crumbs = $self->{breadcrumbs};
 
@@ -712,6 +753,11 @@ sub get_next_key {
             # or die "Iterator: How did this fail (no ref sector for '$self->{base_offset}')?!\n";
             # If no sector is found, thist must have been deleted from under us.
             or return;
+
+        if ( $sector->staleness != $obj->_staleness ) {
+            return;
+        }
+
         push @$crumbs, [ $sector->get_blist_loc, 0 ];
     }
 
@@ -773,9 +819,10 @@ sub type   { $_[0]{type} }
 sub free {
     my $self = shift;
 
-    $self->engine->storage->print_at( $self->offset,
-        $self->engine->SIG_FREE,
-        chr(0) x ($self->size - 1),
+    $self->engine->storage->print_at( $self->offset, $self->engine->SIG_FREE );
+    # Skip staleness counter
+    $self->engine->storage->print_at( $self->offset + 1 + 1,
+        chr(0) x ($self->size - 2),
     );
 
     $self->engine->_add_free_sector(
@@ -856,9 +903,9 @@ sub _init {
                 $continue = 0;
             }
 
-            $engine->storage->print_at( $curr_offset,
-                $self->type,                                     # Sector type
-                pack( $StP{1}, 0 ),                              # Recycled counter
+            $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
+            # Skip staleness
+            $engine->storage->print_at( $curr_offset + 1 + 1,
                 pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
                 pack( $StP{1}, $this_len ),                      # Data length
                 $chunk,                                          # Data to be stored in this sector
@@ -926,9 +973,9 @@ sub _init {
         my $leftover = $self->size - 3 - 1 * $engine->byte_size;
 
         $self->{offset} = $engine->_request_sector( $self->size );
-        $engine->storage->print_at( $self->offset,
-            $self->type,                          # Sector type
-            pack( $StP{1}, 0 ),                   # Recycled counter
+        $engine->storage->print_at( $self->offset, $self->type ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + 1 + 1,
             pack( $StP{$engine->byte_size}, 0 ),  # Chain loc
             pack( $StP{1}, $self->data_length ),  # Data length
             chr(0) x $leftover,                   # Zero-fill the rest
@@ -961,22 +1008,27 @@ sub _init {
         }
 
         $self->{offset} = $engine->_request_sector( $self->size );
-        $engine->storage->print_at( $self->offset,
-            $self->type,                                     # Sector type
-            pack( $StP{1}, 0 ),                              # Recycled counter
+        $engine->storage->print_at( $self->offset, $self->type ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + 1 + 1,
             pack( $StP{$engine->byte_size}, 0 ),             # Index/BList loc
             pack( $StP{$engine->byte_size}, $class_offset ), # Classname loc
             chr(0) x $leftover,                              # Zero-fill the rest
         );
-
-        return;
+    }
+    else {
+        $self->{type} = $engine->storage->read_at( $self->offset, 1 );
     }
 
-    $self->{type} = $engine->storage->read_at( $self->offset, 1 );
+    $self->{staleness} = unpack(
+        $StP{1}, $engine->storage->read_at( $self->offset + 1, 1 ),
+    );
 
     return;
 }
 
+sub staleness { $_[0]{staleness} }
+
 sub get_data_for {
     my $self = shift;
     my ($args) = @_;
@@ -1166,6 +1218,7 @@ sub data {
     my $new_obj = DBM::Deep->new({
         type        => $self->type,
         base_offset => $self->offset,
+        staleness   => $self->staleness,
         storage     => $self->engine->storage,
         engine      => $self->engine,
     });
@@ -1193,9 +1246,9 @@ sub _init {
         my $leftover = $self->size - $self->base_size;
 
         $self->{offset} = $engine->_request_sector( $self->size );
-        $engine->storage->print_at( $self->offset,
-            $engine->SIG_BLIST, # Sector type
-            pack( $StP{1}, 0 ), # Recycled counter
+        $engine->storage->print_at( $self->offset, $engine->SIG_BLIST ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + 1 + 1,
             chr(0) x $leftover, # Zero-fill the data
         );
     }
@@ -1436,7 +1489,7 @@ sub get_key_for {
 1;
 __END__
 
-package DBM::Deep::Engine::Sector::BucketList;
+package DBM::Deep::Engine::Sector::Index;
 
 our @ISA = qw( DBM::Deep::Engine::Sector );
 
@@ -1449,9 +1502,9 @@ sub _init {
         my $leftover = $self->size - $self->base_size;
 
         $self->{offset} = $engine->_request_sector( $self->size );
-        $engine->storage->print_at( $self->offset,
-            $engine->SIG_BLIST, # Sector type
-            pack( $StP{1}, 0 ), # Recycled counter
+        $engine->storage->print_at( $self->offset, $engine->SIG_BLIST ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + 1 + 1,
             chr(0) x $leftover, # Zero-fill the data
         );
     }

diff --git a/t/40_freespace.t b/t/40_freespace.t
index f8a9f09..280fdfe 100644 (file)
--- a/t/40_freespace.t
+++ b/t/40_freespace.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 11;
+use Test::More tests => 16;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -53,6 +53,15 @@ is( delete $x->{foo}, undef, "Deleting floober makes \$x empty (delete)" );
 eval { $x->{foo} = 'bar'; };
 is( $@, "Cannot write to a deleted spot in DBM::Deep.\n", "Exception thrown when writing" );
 
+cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after deletion" );
+
 $db->{buzzer} = { foo => 'baz' };
 
 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" );
+
+eval { $x->{foo} = 'bar'; };
+is( $@, "Cannot write to a deleted spot in DBM::Deep.\n", "Exception thrown when writing" );
+
+cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after space reuse" );