r11683@rob-kinyons-powerbook58: rob | 2006-04-28 20:54:09 -0400

 Fixed export() so that it works on blessed root values

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 908fe01..373fd84 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -205,6 +205,16 @@ sub export {
     $self->_copy_node( $temp );
     $self->unlock();
 
+    # This will always work because $self, after _get_self() is a HASH
+    if ( $self->{parent} ) {
+        my $c = Scalar::Util::blessed(
+            $self->{parent}->get($self->{parent_key})
+        );
+        if ( $c ) {
+            bless $temp, $c;
+        }
+    }
+
     return $temp;
 }
 
@@ -1190,11 +1200,12 @@ then incremented, then stored again.
     $db->unlock();
 
 You can pass C<lock()> an optional argument, which specifies which mode to use
-(exclusive or shared).  Use one of these two constants: C<DBM::Deep-E<gt>LOCK_EX>
-or C<DBM::Deep-E<gt>LOCK_SH>.  These are passed directly to C<flock()>, and are the
-same as the constants defined in Perl's C<Fcntl> module.
+(exclusive or shared).  Use one of these two constants:
+C<DBM::Deep-E<gt>LOCK_EX> or C<DBM::Deep-E<gt>LOCK_SH>.  These are passed
+directly to C<flock()>, and are the same as the constants defined in Perl's
+L<Fcntl/> module.
 
-    $db->lock( DBM::Deep->LOCK_SH );
+    $db->lock( $db->LOCK_SH );
     # something here
     $db->unlock();
 

diff --git a/t/18_export.t b/t/18_export.t
index 75da3d4..9cca868 100644 (file)
--- a/t/18_export.t
+++ b/t/18_export.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 2;
+use Test::More tests => 6;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -15,27 +15,30 @@ my %struct = (
     hash1 => {
         subkey1 => "subvalue1",
         subkey2 => "subvalue2",
-        subkey3 => bless( {}, 'Foo' ),
+        subkey3 => bless( {
+            sub_obj => bless([
+                bless([], 'Foo'),
+            ], 'Foo'),
+            sub_obj2 => bless([], 'Foo'),
+        }, 'Foo' ),
     },
 );
 
-my $compare = do {
-    my ($fh, $filename) = new_fh();
-    my $db = DBM::Deep->new({
-        file      => $filename,
-        autobless => 1,
-    });
+my ($fh, $filename) = new_fh();
+my $db = DBM::Deep->new({
+    file      => $filename,
+    autobless => 1,
+});
 
-    ##
-    # Create structure in DB
-    ##
-    $db->import( %struct );
+##
+# Create structure in DB
+##
+$db->import( %struct );
 
-    ##
-    # Export entire thing
-    ##
-    $db->export();
-};
+##
+# Export entire thing
+##
+my $compare = $db->export();
 
 cmp_deeply(
     $compare,
@@ -46,8 +49,18 @@ cmp_deeply(
         hash1 => {
             subkey1 => "subvalue1",
             subkey2 => "subvalue2",
-            subkey3 => bless( {}, 'Foo' ),
+            subkey3 => bless( {
+                sub_obj => bless([
+                    bless([], 'Foo'),
+                ], 'Foo'),
+                sub_obj2 => bless([], 'Foo'),
+            }, 'Foo' ),
         },
     },
     "Everything matches",
 );
+
+isa_ok( tied(%{$db->{hash1}{subkey3}})->export, 'Foo' );
+isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj}})->export, 'Foo' );
+isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj}[0]})->export, 'Foo' );
+isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj2}})->export, 'Foo' );