Fixed my autobless stupidity and added a test demonstrating how _copy_node() borks...

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index e10a6aa..b1c862f 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -543,17 +543,23 @@ sub _add_bucket {
                ##
                # If value is blessed, preserve class name
                ##
-               my $value_class = Scalar::Util::blessed($value);
-               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);
-               }
-               
+               if ( $self->root->{autobless} ) {
+            my $value_class = Scalar::Util::blessed($value);
+            if ( 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);
+            }
+            else {
+                $self->fh->print( chr(0) );
+                $content_length += 1;
+            }
+        }
+            
                ##
                # If this is a new content area, advance EOF counter
                ##
@@ -930,6 +936,7 @@ sub _copy_node {
                my $key = $self->first_key();
                while ($key) {
                        my $value = $self->get($key);
+#XXX This doesn't work with autobless
                        if (!ref($value)) { $db_temp->{$key} = $value; }
                        else {
                                my $type = $value->type;

diff --git a/t/24_autobless.t b/t/24_autobless.t
index f4151af..ecd1935 100644 (file)
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -7,7 +7,7 @@ use strict;
     sub foo { 'foo' };
 }
 
-use Test::More no_plan => 1;
+use Test::More tests => 24;
 
 use_ok( 'DBM::Deep' );
 
@@ -38,7 +38,6 @@ undef $db;
 
 my $db2 = DBM::Deep->new(
     file     => 't/test.db',
-    autoflush => 1,
     autobless => 1,
 );
 if ($db2->error()) {
@@ -60,10 +59,14 @@ is( $db2->{unblessed}{b}[0], 1 );
 is( $db2->{unblessed}{b}[1], 2 );
 is( $db2->{unblessed}{b}[2], 3 );
 
+TODO: {
+    todo_skip "_copy_node() doesn't work with autobless", 1;
+    my $structure = $db2->export();
+    ok( 1 );
+}
+
 my $db3 = DBM::Deep->new(
     file     => 't/test.db',
-    autoflush => 1,
-#    autobless => 0,
 );
 if ($db3->error()) {
        die "ERROR: " . $db3->error();