From: Rob Kinyon Date: Sun, 27 Dec 2009 15:06:15 +0000 (-0500) Subject: Fixed problem with second-level values being overwritten when accessed. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf4a1344f9abac96f07d9645244d8dbfad2a873e;p=dbsrgits%2FDBM-Deep.git Fixed problem with second-level values being overwritten when accessed. --- diff --git a/lib/DBM/Deep/Engine/DBI.pm b/lib/DBM/Deep/Engine/DBI.pm index 192af9b..30af59f 100644 --- a/lib/DBM/Deep/Engine/DBI.pm +++ b/lib/DBM/Deep/Engine/DBI.pm @@ -82,8 +82,9 @@ sub read_value { unless ( $value_sector ) { $value_sector = DBM::Deep::Sector::DBI::Scalar->new({ - engine => $self, - data => undef, + engine => $self, + data => undef, + data_type => 'S', }); $sector->write_data({ diff --git a/lib/DBM/Deep/Sector/DBI.pm b/lib/DBM/Deep/Sector/DBI.pm index 8b0765d..a150cc6 100644 --- a/lib/DBM/Deep/Sector/DBI.pm +++ b/lib/DBM/Deep/Sector/DBI.pm @@ -44,7 +44,7 @@ sub load { if ( $sector->{data_type} eq 'R' ) { return $self->load( - $engine, $sector->{offset}, 'refs', + $engine, $sector->{value}, 'refs', ); } diff --git a/lib/DBM/Deep/Sector/DBI/Reference.pm b/lib/DBM/Deep/Sector/DBI/Reference.pm index 98dcfae..7775ce8 100644 --- a/lib/DBM/Deep/Sector/DBI/Reference.pm +++ b/lib/DBM/Deep/Sector/DBI/Reference.pm @@ -55,7 +55,7 @@ sub write_data { my ($args) = @_; if ( ( $args->{value}->type || 'S' ) eq 'S' ) { - $self->engine->storage->write_to( + $args->{value}{offset} = $self->engine->storage->write_to( datas => $args->{value}{offset}, ref_id => $self->offset, data_type => 'S', @@ -63,10 +63,13 @@ sub write_data { value => $args->{value}{data}, class => $args->{value}{class}, ); + + $args->{value}->reload; } else { + # Write the Scalar of the Reference $self->engine->storage->write_to( - datas => $args->{value}{offset}, + datas => undef, ref_id => $self->offset, data_type => 'R', key => $args->{key}, @@ -74,8 +77,6 @@ sub write_data { class => $args->{value}{class}, ); } - - $args->{value}->reload; } sub delete_key { diff --git a/lib/DBM/Deep/Sector/DBI/Scalar.pm b/lib/DBM/Deep/Sector/DBI/Scalar.pm index 3054602..ba22e5b 100644 --- a/lib/DBM/Deep/Sector/DBI/Scalar.pm +++ b/lib/DBM/Deep/Sector/DBI/Scalar.pm @@ -10,17 +10,10 @@ sub table { 'datas' } sub _init { my $self = shift; - my $engine = $self->engine; - unless ( $self->offset ) { -# my ($rows) = $self->engine->storage->write_to( -# datas => undef, -# ( map { $_ => $self->{$_} } qw( ref_id data_type key value class ) ), -# ); - } - else { + if ( $self->offset ) { my ($rows) = $self->engine->storage->read_from( datas => $self->offset, - qw( data_type key value class ), + qw( id data_type key value class ), ); $self->{$_} = $rows->[0]{$_} for qw( data_type key value class ); diff --git a/t/02_hash.t b/t/02_hash.t index a317fa3..c8a0cab 100644 --- a/t/02_hash.t +++ b/t/02_hash.t @@ -4,6 +4,7 @@ use warnings FATAL => 'all'; use Test::More; use Test::Exception; use t::common qw( new_dbm ); +use Scalar::Util qw( reftype ); use_ok( 'DBM::Deep' ); @@ -139,6 +140,7 @@ while ( my $dbm_maker = $dbm_factory->() ) { # Test autovivification $db->{unknown}{bar} = 1; ok( $db->{unknown}, 'Autovivified hash exists' ); + is( reftype($db->{unknown}), 'HASH', "... and it's a HASH" ); cmp_ok( $db->{unknown}{bar}, '==', 1, 'And the value stored is there' ); # Test failures