export() now works with autobless

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 512ba56..8794317 100644 (file)
--- 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 (file)
--- 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(