Refactored to _descend to fix the recursion bug

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine / DBI.pm

diff --git a/lib/DBM/Deep/Engine/DBI.pm b/lib/DBM/Deep/Engine/DBI.pm
index 7d28615..845771b 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({
@@ -96,17 +97,60 @@ sub read_value {
     return $value_sector->data;
 }
 
-=pod
 sub get_classname {
     my $self = shift;
     my ($obj) = @_;
+
+    my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+        or return;
+
+    return $sector->get_classname;
 }
 
 sub make_reference {
     my $self = shift;
     my ($obj, $old_key, $new_key) = @_;
+
+    my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+        or return;
+
+#    if ( $sector->staleness != $obj->_staleness ) {
+#        return;
+#    }
+
+    my $value_sector = $sector->get_data_for({
+        key        => $old_key,
+        allow_head => 1,
+    });
+
+    unless ( $value_sector ) {
+        $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
+            engine => $self,
+            data   => undef,
+        });
+
+        $sector->write_data({
+            key     => $old_key,
+            value   => $value_sector,
+        });
+    }
+
+    if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
+        $sector->write_data({
+            key     => $new_key,
+            value   => $value_sector,
+        });
+        $value_sector->increment_refcount;
+    }
+    else {
+        $sector->write_data({
+            key     => $new_key,
+            value   => $value_sector->clone,
+        });
+    }
+
+    return;
 }
-=cut
 
 # exists returns '', not undefined.
 sub key_exists {
@@ -197,10 +241,10 @@ sub write_value {
             
             # See whether or not we are storing ourselves to ourself.
             # Write the sector as data in this reference (keyed by $key)
-            my $value_sector = $self->load_sector( $tmpvar->_base_offset );
+            my $value_sector = $self->load_sector( $tmpvar->_base_offset, 'refs' );
             $sector->write_data({
                 key     => $key,
-                key_md5 => $self->_apply_digest( $key ),
+#                key_md5 => $self->_apply_digest( $key ),
                 value   => $value_sector,
             });
             $value_sector->increment_refcount;
@@ -234,54 +278,75 @@ sub write_value {
         value   => $value_sector,
     });
 
-    # This code is to make sure we write all the values in the $value to the
-    # disk and to make sure all changes to $value after the assignment are
-    # reflected on disk. This may be counter-intuitive at first, but it is
-    # correct dwimmery.
-    #   NOTE - simply tying $value won't perform a STORE on each value. Hence,
-    # the copy to a temp value.
-    if ( $r eq 'ARRAY' ) {
-        my @temp = @$value;
-        tie @$value, 'DBM::Deep', {
-            base_offset => $value_sector->offset,
-#            staleness   => $value_sector->staleness,
-            storage     => $self->storage,
-            engine      => $self,
-        };
-        @$value = @temp;
-        bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
-    }
-    elsif ( $r eq 'HASH' ) {
-        my %temp = %$value;
-        tie %$value, 'DBM::Deep', {
-            base_offset => $value_sector->offset,
-#            staleness   => $value_sector->staleness,
-            storage     => $self->storage,
-            engine      => $self,
-        };
-
-        %$value = %temp;
-        bless $value, 'DBM::Deep::Hash' unless Scalar::Util::blessed( $value );
-    }
+    $self->_descend( $value, $value_sector );
 
     return 1;
 }
 
 sub begin_work {
     my $self = shift;
-    my ($obj) = @_;
-}
+    die "Transactions are not supported by this engine"
+        unless $self->supports('transactions');
+
+    if ( $self->in_txn ) {
+        DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
+    }
+
+    $self->storage->begin_work;
+
+    $self->in_txn( 1 );
+
+    return 1;
+} 
 
 sub rollback {
     my $self = shift;
-    my ($obj) = @_;
-}
+    die "Transactions are not supported by this engine"
+        unless $self->supports('transactions');
+
+    if ( !$self->in_txn ) {
+        DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
+    }
+
+    $self->storage->rollback;
+
+    $self->in_txn( 0 );
+
+    return 1;
+} 
 
 sub commit {
     my $self = shift;
-    my ($obj) = @_;
+    die "Transactions are not supported by this engine"
+        unless $self->supports('transactions');
+
+    if ( !$self->in_txn ) {
+        DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
+    }
+
+    $self->storage->commit;
+
+    $self->in_txn( 0 );
+
+    return 1;
+}
+
+sub in_txn {
+    my $self = shift;
+    $self->{in_txn} = shift if @_;
+    $self->{in_txn};
 }
 
+sub supports {
+    my $self = shift;
+    my ($feature) = @_;
+
+    if ( $feature eq 'transactions' ) {
+#        return 1 if $self->storage->driver eq 'sqlite';
+        return;
+    }
+    return;
+}
 
 1;
 __END__