Converted as many max-buckets foreach loops to _find_in_buckets as possible ... 3...

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index c6a9c4a..46f1588 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -1809,15 +1809,15 @@ built-in hashes.
 We use B<Devel::Cover> to test the code coverage of our tests, below is the
 B<Devel::Cover> report on this module's test suite.
 
-  ---------------------------- ------ ------ ------ ------ ------ ------ ------
-  File                           stmt   bran   cond    sub    pod   time  total
-  ---------------------------- ------ ------ ------ ------ ------ ------ ------
-  blib/lib/DBM/Deep.pm           95.1   81.6   70.3  100.0  100.0   33.4   91.0
-  blib/lib/DBM/Deep/Array.pm    100.0   91.1  100.0  100.0    n/a   27.8   98.0
-  blib/lib/DBM/Deep/Engine.pm    97.8   85.6   75.0  100.0    0.0   25.8   90.8
-  blib/lib/DBM/Deep/Hash.pm     100.0   87.5  100.0  100.0    n/a   13.0   97.2
-  Total                          97.5   85.4   76.6  100.0   46.9  100.0   92.5
-  ---------------------------- ------ ------ ------ ------ ------ ------ ------
+  ----------------------------------- ------ ------ ------ ------ ------ ------
+  File                                  stmt   bran   cond    sub   time  total
+  ----------------------------------- ------ ------ ------ ------ ------ ------
+  blib/lib/DBM/Deep.pm                  94.9   80.6   73.0  100.0   37.9   90.4
+  blib/lib/DBM/Deep/Array.pm           100.0   91.1  100.0  100.0   18.2   98.1
+  blib/lib/DBM/Deep/Engine.pm           98.9   87.3   80.0  100.0   34.2   95.2
+  blib/lib/DBM/Deep/Hash.pm            100.0   87.5  100.0  100.0    9.7   97.3
+  Total                                 97.9   85.9   79.7  100.0  100.0   94.3
+  ----------------------------------- ------ ------ ------ ------ ------ ------
 
 =head1 MORE INFORMATION
 

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 81177e2..81a9ac1 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -275,72 +275,70 @@ sub add_bucket {
 
     my $fh = $obj->_fh;
 
-    {
-        my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 );
+    my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 );
 
-        # Updating a known md5
-        if ( $subloc ) {
-            $result = 1;
+    # Updating a known md5
+    if ( $subloc ) {
+        $result = 1;
 
-            seek($fh, $subloc + SIG_SIZE + $root->{file_offset}, SEEK_SET);
-            my $size;
-            read( $fh, $size, $self->{data_size});
-            $size = unpack($self->{data_pack}, $size);
+        seek($fh, $subloc + SIG_SIZE + $root->{file_offset}, SEEK_SET);
+        my $size;
+        read( $fh, $size, $self->{data_size});
+        $size = unpack($self->{data_pack}, $size);
 
-            ##
-            # If value is a hash, array, or raw value with equal or less size, we can
-            # reuse the same content area of the database.  Otherwise, we have to create
-            # a new content area at the EOF.
-            ##
-            my $actual_length;
-            if ( $internal_ref ) {
-                $actual_length = $self->{long_size};
-            }
-            else {
-                my $r = Scalar::Util::reftype( $value ) || '';
-                if ( $r eq 'HASH' || $r eq 'ARRAY' ) {
-                    $actual_length = $self->{index_size};
-
-                    # if autobless is enabled, must also take into consideration
-                    # the class name, as it is stored along with key/value.
-                    if ( $root->{autobless} ) {
-                        my $value_class = Scalar::Util::blessed($value);
-                        if ( defined $value_class && !$value->isa('DBM::Deep') ) {
-                            $actual_length += length($value_class);
-                        }
+        ##
+        # If value is a hash, array, or raw value with equal or less size, we can
+        # reuse the same content area of the database.  Otherwise, we have to create
+        # a new content area at the EOF.
+        ##
+        my $actual_length;
+        if ( $internal_ref ) {
+            $actual_length = $self->{long_size};
+        }
+        else {
+            my $r = Scalar::Util::reftype( $value ) || '';
+            if ( $r eq 'HASH' || $r eq 'ARRAY' ) {
+                $actual_length = $self->{index_size};
+
+                # if autobless is enabled, must also take into consideration
+                # the class name, as it is stored along with key/value.
+                if ( $root->{autobless} ) {
+                    my $value_class = Scalar::Util::blessed($value);
+                    if ( defined $value_class && !$value->isa('DBM::Deep') ) {
+                        $actual_length += length($value_class);
                     }
                 }
-                else { $actual_length = length($value); }
-            }
-
-            if ($actual_length <= $size) {
-                $location = $subloc;
-            }
-            else {
-                $location = $root->{end};
-                seek(
-                    $fh,
-                    $tag->{offset} + $offset + $self->{hash_size} + $root->{file_offset},
-                    SEEK_SET,
-                );
-                print( $fh pack($self->{long_pack}, $location) );
             }
+            else { $actual_length = length($value); }
         }
-        # Adding a new md5
-        elsif ( defined $offset ) {
-            $result = 2;
-            $location = $root->{end};
 
-            seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET );
-            print( $fh $md5 . pack($self->{long_pack}, $location) );
+        if ($actual_length <= $size) {
+            $location = $subloc;
         }
-        # If bucket didn't fit into list, split into a new index level
         else {
-            $self->split_index( $obj, $md5, $tag );
-
             $location = $root->{end};
+            seek(
+                $fh,
+                $tag->{offset} + $offset + $self->{hash_size} + $root->{file_offset},
+                SEEK_SET,
+            );
+            print( $fh pack($self->{long_pack}, $location) );
         }
     }
+    # Adding a new md5
+    elsif ( defined $offset ) {
+        $result = 2;
+        $location = $root->{end};
+
+        seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET );
+        print( $fh $md5 . pack($self->{long_pack}, $location) );
+    }
+    # If bucket didn't fit into list, split into a new index level
+    else {
+        $self->split_index( $obj, $md5, $tag );
+
+        $location = $root->{end};
+    }
 
     ##
     # Seek to content area and store signature, value and plaintext key
@@ -603,29 +601,11 @@ sub get_bucket_value {
     ##
     my $self = shift;
     my ($obj, $tag, $md5) = @_;
-    my $keys = $tag->{content};
-
-    ##
-    # Iterate through buckets, looking for a key match
-    ##
-    BUCKET:
-    for (my $i = 0; $i < $self->{max_buckets}; $i++) {
-        my ($key, $subloc) = $self->_get_key_subloc( $keys, $i );
-
-        if (!$subloc) {
-            ##
-            # Hit end of list, no match
-            ##
-            return;
-        }
-
-        if ( $md5 ne $key ) {
-            next BUCKET;
-        }
 
+    my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 );
+    if ( $subloc ) {
         return $self->read_from_loc( $obj, $subloc );
-    } # i loop
-
+    }
     return;
 }
 
@@ -635,38 +615,16 @@ sub delete_bucket {
     ##
     my $self = shift;
     my ($obj, $tag, $md5) = @_;
-    my $keys = $tag->{content};
-
-    my $fh = $obj->_fh;
 
-    ##
-    # Iterate through buckets, looking for a key match
-    ##
-    BUCKET:
-    for (my $i=0; $i<$self->{max_buckets}; $i++) {
-        my ($key, $subloc) = $self->_get_key_subloc( $keys, $i );
-
-        if (!$subloc) {
-            ##
-            # Hit end of list, no match
-            ##
-            return;
-        }
-
-        if ( $md5 ne $key ) {
-            next BUCKET;
-        }
-
-        ##
-        # Matched key -- delete bucket and return
-        ##
-        seek($fh, $tag->{offset} + ($i * $self->{bucket_size}) + $obj->_root->{file_offset}, SEEK_SET);
-        print( $fh substr($keys, ($i+1) * $self->{bucket_size} ) );
+    my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 );
+    if ( $subloc ) {
+        my $fh = $obj->_fh;
+        seek($fh, $tag->{offset} + $offset + $obj->_root->{file_offset}, SEEK_SET);
+        print( $fh substr($tag->{content}, $offset + $self->{bucket_size} ) );
         print( $fh chr(0) x $self->{bucket_size} );
 
         return 1;
-    } # i loop
-
+    }
     return;
 }
 
@@ -676,32 +634,11 @@ sub bucket_exists {
     ##
     my $self = shift;
     my ($obj, $tag, $md5) = @_;
-    my $keys = $tag->{content};
-
-    ##
-    # Iterate through buckets, looking for a key match
-    ##
-    BUCKET:
-    for (my $i=0; $i<$self->{max_buckets}; $i++) {
-        my ($key, $subloc) = $self->_get_key_subloc( $keys, $i );
 
-        if (!$subloc) {
-            ##
-            # Hit end of list, no match
-            ##
-            return;
-        }
-
-        if ( $md5 ne $key ) {
-            next BUCKET;
-        }
-
-        ##
-        # Matched key -- return true
-        ##
+    my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 );
+    if ( $subloc ) {
         return 1;
-    } # i loop
-
+    }
     return;
 }