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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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