From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Mon, 1 May 2006 19:53:56 +0000 (+0000)
Subject:  r11725@rob-kinyons-powerbook58:  rob | 2006-05-01 15:53:46 -0400
X-Git-Tag: 0-99_03~46
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12b96196fd8fb359b99e6d4d8fde6ef67def1c6b;p=dbsrgits%2FDBM-Deep.git

 r11725@rob-kinyons-powerbook58:  rob | 2006-05-01 15:53:46 -0400
 Fixed import() so that it doesn't tied the data structure that was passed in
---

diff --git a/Build.PL b/Build.PL
index c73c3f1..420b96d 100644
--- a/Build.PL
+++ b/Build.PL
@@ -7,6 +7,7 @@ my $build = Module::Build->new(
     license => 'perl',
     requires => {
         'perl'              => '5.6.0',
+        'Clone::Any'        => '0',
         'Digest::MD5'       => '1.00',
         'Fcntl'             => '0.01',
         'FileHandle::Fmode' => '0.05',
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 887481f..e51b544 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -37,6 +37,8 @@ use warnings;
 our $VERSION = q(0.99_03);
 
 use Fcntl qw( :DEFAULT :flock :seek );
+
+use Clone::Any '_clone_data';
 use Digest::MD5 ();
 use FileHandle::Fmode ();
 use Scalar::Util ();
@@ -233,11 +235,12 @@ sub import {
         $struct = $self->_repr( @_ );
     }
 
-#XXX These are correct, but impossible until the other bug is fixed
+    #XXX This isn't the best solution. Better would be to use Data::Walker,
+    #XXX but that's a lot more thinking than I want to do right now.
     eval {
-#        $self->begin_work;
-        $self->_import( $struct );
-#        $self->commit;
+        $self->begin_work;
+        $self->_import( _clone_data( $struct ) );
+        $self->commit;
     }; if ( $@ ) {
         $self->rollback;
         die $@;
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index bebc926..b9a00cd 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -13,6 +13,7 @@ sub _get_self {
     eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
 }
 
+#XXX Need to add a check here for @_ % 2
 sub _repr { shift;return { @_ } }
 
 sub _import {
diff --git a/t/17_import.t b/t/17_import.t
index 27f469b..eeb8688 100644
--- a/t/17_import.t
+++ b/t/17_import.t
@@ -55,3 +55,9 @@ ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tie
 $struct->{hash1}->{foo} = 'bar';
 is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
 ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
+
+__END__
+
+Need to add tests for:
+    - Failure case (have something tied or a glob or something like that)
+    - Where we already have $db->{hash1} to make sure that it's not overwritten