From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Fri, 17 Feb 2006 01:56:34 +0000 (+0000)
Subject: Fixed my autobless stupidity and added a test demonstrating how _copy_node() borks... 
X-Git-Tag: 0-97~58
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=30c9584739c2898b4aa06ef4c8dafede5dff2bdc;p=dbsrgits%2FDBM-Deep.git

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

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index e10a6aa..b1c862f 100644
--- 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
--- 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();