From: rkinyon 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;hp=13ff93d5830f8585f37688f073c1e91a79e44ade;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