From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Sat, 18 Mar 2006 05:33:45 +0000 (+0000)
Subject: Converted some calls to new() into tie()
X-Git-Tag: 0-99_01~55
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=685e40f18f1db4af458a45cb50171b34493b6e82;p=dbsrgits%2FDBM-Deep.git

Converted some calls to new() into tie()
---

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index eb89315..f1b0406 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -381,12 +381,12 @@ sub SPLICE {
 
 #XXX We don't need to define it, yet.
 #XXX It will be useful, though, when we split out HASH and ARRAY
-#sub EXTEND {
+sub EXTEND {
 	##
 	# Perl will call EXTEND() when the array is likely to grow.
 	# We don't care, but include it for compatibility.
 	##
-#}
+}
 
 sub _copy_node {
     my $self = shift;
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 0cc4bcb..36480c9 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -418,13 +418,13 @@ sub write_value {
         $self->write_tag( $obj, undef, SIG_INTERNAL,pack($self->{long_pack}, $value->_base_offset) );
     }
     elsif ($r eq 'HASH') {
-        if ( tied( %{$value} ) ) {
+        if ( !$is_dbm_deep && tied %{$value} ) {
             $obj->_throw_error( "Cannot store something that is tied" );
         }
         $self->write_tag( $obj, undef, SIG_HASH, chr(0)x$self->{index_size} );
     }
     elsif ($r eq 'ARRAY') {
-        if ( tied( @{$value} ) ) {
+        if ( !$is_dbm_deep && tied @{$value} ) {
             $obj->_throw_error( "Cannot store something that is tied" );
         }
         $self->write_tag( $obj, undef, SIG_ARRAY, chr(0)x$self->{index_size} );
@@ -464,26 +464,20 @@ sub write_value {
     ##
     if ( !$is_internal_ref ) {
         if ($r eq 'HASH') {
-            my $branch = DBM::Deep->new(
-                type => DBM::Deep->TYPE_HASH,
+            my %x = %$value;
+            tie %$value, 'DBM::Deep', {
                 base_offset => $location,
                 root => $root,
-            );
-            foreach my $key (keys %{$value}) {
-                $branch->STORE( $key, $value->{$key} );
-            }
+            };
+            %$value = %x;
         }
         elsif ($r eq 'ARRAY') {
-            my $branch = DBM::Deep->new(
-                type => DBM::Deep->TYPE_ARRAY,
+            my @x = @$value;
+            tie @$value, 'DBM::Deep', {
                 base_offset => $location,
                 root => $root,
-            );
-            my $index = 0;
-            foreach my $element (@{$value}) {
-                $branch->STORE( $index, $element );
-                $index++;
-            }
+            };
+            @$value = @x;
         }
     }
 
@@ -587,13 +581,13 @@ sub read_from_loc {
     # If value is a hash or array, return new DBM::Deep object with correct offset
     ##
     if (($signature eq SIG_HASH) || ($signature eq SIG_ARRAY)) {
-        my $obj = DBM::Deep->new(
+        my $new_obj = DBM::Deep->new({
             type => $signature,
             base_offset => $subloc,
             root => $obj->_root,
-        );
+        });
 
-        if ($obj->_root->{autobless}) {
+        if ($new_obj->_root->{autobless}) {
             ##
             # Skip over value and plain key to see if object needs
             # to be re-blessed
@@ -613,11 +607,11 @@ sub read_from_loc {
                 my $class_name;
                 read( $fh, $size, $self->{data_size}); $size = unpack($self->{data_pack}, $size);
                 if ($size) { read( $fh, $class_name, $size); }
-                if ($class_name) { $obj = bless( $obj, $class_name ); }
+                if ($class_name) { $new_obj = bless( $new_obj, $class_name ); }
             }
         }
 
-        return $obj;
+        return $new_obj;
     }
     elsif ( $signature eq SIG_INTERNAL ) {
         my $size;
diff --git a/t/31_references.t b/t/31_references.t
index 7aa23c6..9833faf 100644
--- a/t/31_references.t
+++ b/t/31_references.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 5;
+use Test::More tests => 6;
 use Test::Exception;
 use File::Temp qw( tempfile tempdir );
 use Fcntl qw( :flock );
@@ -21,6 +21,7 @@ my %hash = (
 );
 
 $db->{hash} = \%hash;
+isa_ok( tied(%hash), 'DBM::Deep::Hash' );
 
 is( $db->{hash}{foo}, 1 );
 is_deeply( $db->{hash}{bar}, [ 1 .. 3 ] );