From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Mon, 27 Feb 2006 14:06:16 +0000 (+0000)
Subject: export() now works with autobless
X-Git-Tag: 0-98~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=906c8e0107e7c00110cd1a9e6283546091ccae37;p=dbsrgits%2FDBM-Deep.git

export() now works with autobless
---

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 512ba56..8794317 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -971,27 +971,47 @@ sub unlock {
     return;
 }
 
-#XXX These uses of ref() need verified
+sub _copy_value {
+    my $self = shift->_get_self;
+    my ($spot, $value) = @_;
+
+    if ( !ref $value ) {
+        ${$spot} = $value;
+    }
+    elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) {
+        my $type = $value->_type;
+        ${$spot} = $type eq TYPE_HASH ? {} : [];
+        $value->_copy_node( ${$spot} );
+    }
+    else {
+        my $r = Scalar::Util::reftype( $value );
+        my $c = Scalar::Util::blessed( $value );
+        if ( $r eq 'ARRAY' ) {
+            ${$spot} = [ @{$value} ];
+        }
+        else {
+            ${$spot} = { %{$value} };
+        }
+        $$spot = bless $$spot, $c
+            if defined $c;
+    }
+
+    return 1;
+}
+
 sub _copy_node {
 	##
 	# Copy single level of keys or elements to new DB handle.
 	# Recurse for nested structures
 	##
-    my $self = $_[0]->_get_self;
-	my $db_temp = $_[1];
+    my $self = shift->_get_self;
+	my ($db_temp) = @_;
 
 	if ($self->_type eq TYPE_HASH) {
 		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;
-				if ($type eq TYPE_HASH) { $db_temp->{$key} = {}; }
-				else { $db_temp->{$key} = []; }
-				$value->_copy_node( $db_temp->{$key} );
-			}
+            $self->_copy_value( \$db_temp->{$key}, $value );
 			$key = $self->next_key($key);
 		}
 	}
@@ -999,16 +1019,11 @@ sub _copy_node {
 		my $length = $self->length();
 		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] = {}; }
-				else { $db_temp->[$index] = []; }
-				$value->_copy_node( $db_temp->[$index] );
-			}
+            $self->_copy_value( \$db_temp->[$index], $value );
 		}
 	}
+
+    return 1;
 }
 
 sub export {
diff --git a/t/24_autobless.t b/t/24_autobless.t
index 9016288..81952e4 100644
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -7,7 +7,7 @@ use strict;
     sub foo { 'foo' };
 }
 
-use Test::More tests => 29;
+use Test::More tests => 39;
 
 use_ok( 'DBM::Deep' );
 
@@ -70,10 +70,23 @@ $db2 = DBM::Deep->new(
 );
 is( $db2->{blessed}{c}, 'new' );
 
-TODO: {
-    todo_skip "_copy_node() doesn't work with autobless", 1;
+{
     my $structure = $db2->export();
-    ok( 1 );
+    
+    my $obj2 = $structure->{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( $structure->{unblessed}{a}, 1 );
+    is( $structure->{unblessed}{b}[0], 1 );
+    is( $structure->{unblessed}{b}[1], 2 );
+    is( $structure->{unblessed}{b}[2], 3 );
 }
 
 my $db3 = DBM::Deep->new(