A few more fixes, bringing stmt to 94.9% and overall to 88.5%

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 9216b94..8a86fd6 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -441,8 +441,9 @@ sub add_bucket {
        # If this is an internal reference, return now.
        # No need to write value or plain key
        ##
-#YYY
-       if ($internal_ref) { return $result; }
+       if ($internal_ref) {
+        return $result;
+    }
        
        ##
        # If bucket didn't fit into list, split into a new index level
@@ -454,12 +455,6 @@ sub add_bucket {
                my $index_tag = $self->create_tag($self->root->{end}, SIG_INDEX, chr(0) x $INDEX_SIZE);
                my @offsets = ();
                
-#XXX We've already guaranteed that this cannot be true at YYY
-#              if ($internal_ref) {
-#                      $keys .= $md5 . pack($LONG_PACK, $value->base_offset);
-#                      $location = $value->base_offset;
-#              }
-#              else { $keys .= $md5 . pack($LONG_PACK, 0); }
                $keys .= $md5 . pack($LONG_PACK, 0);
                
                for (my $i=0; $i<=$MAX_BUCKETS; $i++) {
@@ -540,24 +535,14 @@ sub add_bucket {
                # If value is blessed, preserve class name
                ##
                my $value_class = Scalar::Util::blessed($value);
-#XXX NO tests for this
-               if ($self->root->{autobless} && defined $value_class) {
-                       if ($value_class ne 'DBM::Deep') {
-                               ##
-                               # Blessed ref -- will restore later
-                               ##
-                               $self->fh->print( chr(1) );
-                               $self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
-                               $content_length += 1;
-                               $content_length += $DATA_LENGTH_SIZE + length($value_class);
-                       }
-                       else {
-                               ##
-                               # Simple unblessed ref -- no restore needed
-                               ##
-                               $self->fh->print( chr(0) );
-                               $content_length += 1;
-                       }
+               if ($self->root->{autobless} && defined $value_class && $value_class ne 'DBM::Deep' ) {
+            ##
+            # Blessed ref -- will restore later
+            ##
+            $self->fh->print( chr(1) );
+            $self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
+            $content_length += 1;
+            $content_length += $DATA_LENGTH_SIZE + length($value_class);
                }
                
                ##
@@ -646,7 +631,6 @@ sub get_bucket_value {
                 root => $self->root
             );
             
-#XXX NO tests for this
             if ($self->root->{autobless}) {
                 ##
                 # Skip over value and plain key to see if object needs
@@ -902,7 +886,7 @@ sub lock {
        # be called before the lock is released.
        ##
     my $self = _get_self($_[0]);
-       my ($type) = @_;
+       my $type = $_[1];
     $type = LOCK_EX unless defined $type;
        
        if ($self->root->{locking}) {
@@ -917,7 +901,6 @@ sub unlock {
        # regarding calling lock() multiple times.
        ##
     my $self = _get_self($_[0]);
-#      my $type = $_[1];
        
        if ($self->root->{locking} && $self->root->{locked} > 0) {
                $self->root->{locked}--;
@@ -933,8 +916,8 @@ sub copy_node {
        ##
     my $self = _get_self($_[0]);
        my $db_temp = $_[1];
-       
-       if ($self->{type} eq TYPE_HASH) {
+
+       if ($self->type eq TYPE_HASH) {
                my $key = $self->first_key();
                while ($key) {
                        my $value = $self->get($key);
@@ -953,6 +936,7 @@ sub copy_node {
                for (my $index = 0; $index < $length; $index++) {
                        my $value = $self->get($index);
                        if (!ref($value)) { $db_temp->[$index] = $value; }
+            #XXX NO tests for this code
                        else {
                                my $type = $value->type;
                                if ($type eq TYPE_HASH) { $db_temp->[$index] = {}; }
@@ -1126,6 +1110,7 @@ sub fh {
        ##
        # Get access to the raw FileHandle
        ##
+    #XXX It will be useful, though, when we split out HASH and ARRAY
     my $self = _get_self($_[0]);
        return $self->root->{fh};
 }
@@ -1726,6 +1711,7 @@ sub SPLICE {
 }
 
 #XXX We don't need to define it.
+#XXX It will be useful, though, when we split out HASH and ARRAY
 #sub EXTEND {
        ##
        # Perl will call EXTEND() when the array is likely to grow.

diff --git a/t/autobless_2.t b/t/autobless_2.t
index f4151af..0a3337c 100644 (file)
--- a/t/autobless_2.t
+++ b/t/autobless_2.t
@@ -14,19 +14,12 @@ use_ok( 'DBM::Deep' );
 unlink 't/test.db';
 my $db = DBM::Deep->new(
     file     => "t/test.db",
-    autobless => 1,
+    autobless => 0,
 );
 if ($db->error()) {
        die "ERROR: " . $db->error();
 }
 
-my $obj = bless {
-    a => 1,
-    b => [ 1 .. 3 ],
-}, 'Foo';
-
-$db->{blessed} = $obj;
-
 $db->{unblessed} = {};
 $db->{unblessed}{a} = 1;
 $db->{unblessed}{b} = [];
@@ -38,48 +31,30 @@ undef $db;
 
 my $db2 = DBM::Deep->new(
     file     => 't/test.db',
-    autoflush => 1,
     autobless => 1,
 );
 if ($db2->error()) {
        die "ERROR: " . $db2->error();
 }
 
-my $obj2 = $db2->{blessed};
-isa_ok( $obj2, 'Foo' );
-can_ok( $obj2, 'export', 'foo' );
-ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
-
-is( $obj2->{a}, 1 );
-is( $obj2->{b}[0], 1 );
-is( $obj2->{b}[1], 2 );
-is( $obj2->{b}[2], 3 );
-
 is( $db2->{unblessed}{a}, 1 );
 is( $db2->{unblessed}{b}[0], 1 );
 is( $db2->{unblessed}{b}[1], 2 );
 is( $db2->{unblessed}{b}[2], 3 );
 
+$db2->{unblessed}{a} = 2;
+
+undef $db2;
+
 my $db3 = DBM::Deep->new(
-    file     => 't/test.db',
-    autoflush => 1,
-#    autobless => 0,
+    file     => "t/test.db",
+    autobless => 0,
 );
 if ($db3->error()) {
-       die "ERROR: " . $db3->error();
+       die "ERROR: " . $db->error();
 }
 
-my $obj3 = $db3->{blessed};
-isa_ok( $obj3, 'DBM::Deep' );
-can_ok( $obj3, 'export', 'STORE' );
-ok( !$obj3->can( 'foo' ), "... but it cannot 'foo'" );
-
-is( $obj3->{a}, 1 );
-is( $obj3->{b}[0], 1 );
-is( $obj3->{b}[1], 2 );
-is( $obj3->{b}[2], 3 );
-
-is( $db3->{unblessed}{a}, 1 );
+is( $db3->{unblessed}{a}, 2 );
 is( $db3->{unblessed}{b}[0], 1 );
 is( $db3->{unblessed}{b}[1], 2 );
 is( $db3->{unblessed}{b}[2], 3 );