Merge cd5303b: RT# 50541: Fix for clear bug. Introduces a speed regression

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine / Sector / Reference.pm

diff --git a/lib/DBM/Deep/Engine/Sector/Reference.pm b/lib/DBM/Deep/Engine/Sector/Reference.pm
index 0fd782a..c681cda 100644 (file)
--- a/lib/DBM/Deep/Engine/Sector/Reference.pm
+++ b/lib/DBM/Deep/Engine/Sector/Reference.pm
@@ -1,4 +1,3 @@
-#TODO: Convert this to a string
 package DBM::Deep::Engine::Sector::Reference;
 
 use 5.006_000;
@@ -6,12 +5,17 @@ use 5.006_000;
 use strict;
 use warnings FATAL => 'all';
 
-use Scalar::Util ();
+use base qw( DBM::Deep::Engine::Sector::Data );
 
-use DBM::Deep::Null;
+my $STALE_SIZE = 2;
 
-use DBM::Deep::Engine::Sector::Data;
-our @ISA = qw( DBM::Deep::Engine::Sector::Data );
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
 
 sub _init {
     my $self = shift;
@@ -19,11 +23,10 @@ sub _init {
     my $e = $self->engine;
 
     unless ( $self->offset ) {
-        $self->{staleness} = 0;
-        $self->{offset} = $e->_request_data_sector( $self->size );
+        my $classname = Scalar::Util::blessed( delete $self->{data} );
+        my $leftover = $self->size - $self->base_size - 3 * $e->byte_size;
 
         my $class_offset = 0;
-        my $classname = Scalar::Util::blessed( delete $self->{data} );
         if ( defined $classname ) {
             my $class_sector = DBM::Deep::Engine::Sector::Scalar->new({
                 engine => $e,
@@ -32,24 +35,25 @@ sub _init {
             $class_offset = $class_sector->offset;
         }
 
-        my $string = chr(0) x $self->size;
-        substr( $string, 0, 1, $self->type );
-        substr( $string, $self->base_size, 3 * $e->byte_size,
-            pack( $e->StP($e->byte_size), 0 )             # Index/BList loc
-          . pack( $e->StP($e->byte_size), $class_offset ) # Classname loc
-          . pack( $e->StP($e->byte_size), 1 )             # Initial refcount
+        $self->{offset} = $e->_request_data_sector( $self->size );
+        $e->storage->print_at( $self->offset, $self->type ); # Sector type
+        # Skip staleness counter
+        $e->storage->print_at( $self->offset + $self->base_size,
+            pack( $StP{$e->byte_size}, 0 ),             # Index/BList loc
+            pack( $StP{$e->byte_size}, $class_offset ), # Classname loc
+            pack( $StP{$e->byte_size}, 1 ),             # Initial refcount
+            chr(0) x $leftover,                         # Zero-fill the rest
         );
-        $e->storage->print_at( $self->offset, $string );
     }
     else {
         $self->{type} = $e->storage->read_at( $self->offset, 1 );
-
-        $self->{staleness} = unpack(
-            $e->StP($DBM::Deep::Engine::STALE_SIZE),
-            $e->storage->read_at( $self->offset + $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ),
-        );
     }
 
+    $self->{staleness} = unpack(
+        $StP{$STALE_SIZE},
+        $e->storage->read_at( $self->offset + $e->SIG_SIZE, $STALE_SIZE ),
+    );
+
     return;
 }
 
@@ -159,10 +163,13 @@ sub delete_key {
     my $self = shift;
     my ($args) = @_;
 
-    # XXX What should happen if this fails?
+    # This can return nothing if we are deleting an entry in a hashref that was
+    # auto-vivified as part of the delete process. For example:
+    #     my $x = {};
+    #     delete $x->{foo}{bar};
     my $blist = $self->get_bucket_list({
         key_md5 => $args->{key_md5},
-    }) or DBM::Deep->_throw_error( "How did delete_key fail (no blist)?!" );
+    }) or return;
 
     # Save the location so that we can free the data
     my $location = $blist->get_data_location_for({
@@ -209,7 +216,7 @@ sub get_blist_loc {
 
     my $e = $self->engine;
     my $blist_loc = $e->storage->read_at( $self->offset + $self->base_size, $e->byte_size );
-    return unpack( $e->StP($e->byte_size), $blist_loc );
+    return unpack( $StP{$e->byte_size}, $blist_loc );
 }
 
 sub get_bucket_list {
@@ -233,7 +240,7 @@ sub get_bucket_list {
         });
 
         $engine->storage->print_at( $self->offset + $self->base_size,
-            pack( $engine->StP($engine->byte_size), $blist->offset ),
+            pack( $StP{$engine->byte_size}, $blist->offset ),
         );
 
         return $blist;
@@ -276,9 +283,10 @@ sub get_bucket_list {
     $sector->find_md5( $args->{key_md5} );
 
     # See whether or not we need to reindex the bucketlist
-    # Yes, the double-braces are there for a reason. if() doesn't create a redo-able block,
-    # so we have to create a bare block within the if() for redo-purposes. Patch and idea
-    # submitted by sprout@cpan.org. -RobK, 2008-01-09
+    # Yes, the double-braces are there for a reason. if() doesn't create a
+    # redo-able block, so we have to create a bare block within the if() for
+    # redo-purposes.
+    # Patch and idea submitted by sprout@cpan.org. -RobK, 2008-01-09
     if ( !$sector->has_md5 && $args->{create} && $sector->{idx} == -1 ) {{
         my $redo;
 
@@ -358,7 +366,7 @@ sub get_bucket_list {
             );
         } else {
             $engine->storage->print_at( $self->offset + $self->base_size,
-                pack( $engine->StP($engine->byte_size), $new_index->offset ),
+                pack( $StP{$engine->byte_size}, $new_index->offset ),
             );
         }
 
@@ -383,7 +391,7 @@ sub get_class_offset {
 
     my $e = $self->engine;
     return unpack(
-        $e->StP($e->byte_size),
+        $StP{$e->byte_size},
         $e->storage->read_at(
             $self->offset + $self->base_size + 1 * $e->byte_size, $e->byte_size,
         ),
@@ -490,7 +498,7 @@ sub get_refcount {
 
     my $e = $self->engine;
     return unpack(
-        $e->StP($e->byte_size),
+        $StP{$e->byte_size},
         $e->storage->read_at(
             $self->offset + $self->base_size + 2 * $e->byte_size, $e->byte_size,
         ),
@@ -504,11 +512,9 @@ sub write_refcount {
     my $e = $self->engine;
     $e->storage->print_at(
         $self->offset + $self->base_size + 2 * $e->byte_size,
-        pack( $e->StP($e->byte_size), $num ),
+        pack( $StP{$e->byte_size}, $num ),
     );
 }
 
-
 1;
 __END__
-