rollback and commit both work. Need to add MORE and MORE tests

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index deb56d5..29318f6 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -335,8 +335,7 @@ sub rollback {
 
 sub commit {
     my $self = shift->_get_self;
-    # At this point, we need to replay the actions taken
-    $self->_fileobj->end_transaction;
+    $self->_fileobj->commit_transaction;
     return 1;
 }
 
@@ -388,19 +387,28 @@ sub _find_parent {
     my $base = '';
     if ( my $parent = $self->{parent} ) {
         my $child = $self;
-        while ( 1 ) {
+        while ( $parent->{parent} ) {
             $base = (
                 $parent->_type eq TYPE_HASH
                     ? "\{$child->{parent_key}\}"
                     : "\[$child->{parent_key}\]"
+#                "->get('$child->{parent_key}')"
             ) . $base;
 
             $child = $parent;
             $parent = $parent->{parent};
-            last unless $parent;
+#            last unless $parent;
+        }
+        if ( $base ) {
+            $base = "\$db->get( '$child->{parent_key}' )->" . $base;
+        }
+        else {
+            $base = "\$db->get( '$child->{parent_key}' )";
         }
     }
-    return '$db->' . $base;
+#    return '$db->' . $base;
+#    return '$db' . $base;
+    return $base;
 }
 
 sub STORE {
@@ -416,14 +424,6 @@ sub STORE {
     }
 
     if ( defined $orig_key ) {
-        my $lhs = $self->_find_parent;
-        if ( $self->_type eq TYPE_HASH ) {
-            $lhs .= "\{$orig_key\}";
-        }
-        else {
-            $lhs .= "\[$orig_key\]";
-        }
-
         my $rhs;
 
         my $r = Scalar::Util::reftype( $value ) || '';
@@ -444,7 +444,24 @@ sub STORE {
             $rhs = "bless $rhs, '$c'";
         }
 
-        $self->_fileobj->audit( "$lhs = $rhs;" );
+        my $lhs = $self->_find_parent;
+        if ( $lhs ) {
+            if ( $self->_type eq TYPE_HASH ) {
+                $lhs .= "->\{$orig_key\}";
+            }
+            else {
+                $lhs .= "->\[$orig_key\]";
+            }
+
+            $lhs .= "=$rhs;";
+        }
+        else {
+            $lhs = "\$db->put('$orig_key',$rhs);";
+        }
+
+#        $self->_fileobj->audit( "$lhs = $rhs;" );
+#        $self->_fileobj->audit( "$lhs $rhs);" );
+        $self->_fileobj->audit($lhs);
     }
 
     ##
@@ -519,14 +536,21 @@ sub DELETE {
 
     if ( defined $orig_key ) {
         my $lhs = $self->_find_parent;
-        if ( $self->_type eq TYPE_HASH ) {
-            $lhs .= "\{$orig_key\}";
+#        if ( $self->_type eq TYPE_HASH ) {
+#            $lhs .= "\{$orig_key\}";
+#        }
+#        else {
+#            $lhs .= "\[$orig_key]\]";
+#        }
+
+#        $self->_fileobj->audit( "delete $lhs;" );
+#        $self->_fileobj->audit( "$lhs->delete('$orig_key');" );
+        if ( $lhs ) {
+            $self->_fileobj->audit( "delete $lhs;" );
         }
         else {
-            $lhs .= "\[$orig_key]\]";
+            $self->_fileobj->audit( "\$db->delete('$orig_key');" );
         }
-
-        $self->_fileobj->audit( "delete $lhs;" );
     }
 
     ##

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 687a1c3..3c3d6fc 100644 (file)
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -33,6 +33,7 @@ sub new {
         # $args. They are here for documentation purposes.
         transaction_id     => 0,
         transaction_offset => 0,
+        trans_audit        => undef,
         base_db_obj        => undef,
     }, $class;
 
@@ -68,10 +69,13 @@ sub new {
 }
 
 sub set_db {
-    unless ( $_[0]{base_db_obj} ) {
-        $_[0]{base_db_obj} = $_[1];
-        Scalar::Util::weaken( $_[0]{base_db_obj} );
+    my $self = shift;
+    unless ( $self->{base_db_obj} ) {
+        $self->{base_db_obj} = shift;
+        Scalar::Util::weaken( $self->{base_db_obj} );
     }
+
+    return;
 }
 
 sub open {
@@ -273,10 +277,9 @@ sub set_transaction_offset {
 
 sub audit {
     my $self = shift;
+    my ($string) = @_;
 
     if ( my $afh = $self->{audit_fh} ) {
-        my ($string) = @_;
-
         flock( $afh, LOCK_EX );
 
         if ( $string =~ /^#/ ) {
@@ -289,6 +292,10 @@ sub audit {
         flock( $afh, LOCK_UN );
     }
 
+    if ( $self->{trans_audit} ) {
+        push @{$self->{trans_audit}}, $string;
+    }
+
     return 1;
 }
 
@@ -316,6 +323,8 @@ sub begin_transaction {
 
     $self->unlock;
 
+    $self->{trans_audit} = [];
+
     return $self->{transaction_id};
 }
 
@@ -332,6 +341,7 @@ sub end_transaction {
     $buffer = unpack( 'N', $buffer );
 
     # Unset $self->{transaction_id} bit
+    $buffer ^= (1 << $self->{transaction_id}-1);
 
     seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
     print( $fh pack( 'N', $buffer ) );
@@ -339,6 +349,9 @@ sub end_transaction {
     $self->unlock;
 
     $self->{transaction_id} = 0;
+    $self->{trans_audit} = undef;
+
+    return 1;
 }
 
 sub current_transactions {
@@ -367,8 +380,23 @@ sub current_transactions {
 
 sub transaction_id { return $_[0]->{transaction_id} }
 
-#sub commit {
-#}
+sub commit_transaction {
+    my $self = shift;
+
+    my @audit = @{$self->{trans_audit}};
+
+    $self->end_transaction;
+
+    {
+        my $db = $self->{base_db_obj};
+        for ( @audit ) {
+            eval "$_;";
+            warn "$_: $@\n" if $@;
+        }
+    }
+
+    return 1;
+}
 
 1;
 __END__

diff --git a/t/33_transaction_commit.t b/t/33_transaction_commit.t
index a52d930..36f4226 100644 (file)
--- a/t/33_transaction_commit.t
+++ b/t/33_transaction_commit.t
@@ -37,11 +37,8 @@ is( $db1->{other_x}, undef, "Since other_x was added after the transaction began
 
 $db1->commit;
 
-TODO: {
-    local $TODO = 'Need to finish auditing first before commit will work.';
-    is( $db1->{x}, 'z', "After commit, DB1's X is Y" );
-    is( $db2->{x}, 'z', "After commit, DB2's X is Y" );
-}
+is( $db1->{x}, 'z', "After commit, DB1's X is Y" );
+is( $db2->{x}, 'z', "After commit, DB2's X is Y" );
 
 is( $db1->{other_x}, 'foo', "After DB1 transaction is over, DB1 can see other_x" );
 is( $db2->{other_x}, 'foo', "After DB1 transaction is over, DB2 can still see other_x" );

diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t
index 7562c14..ef1f5cf 100644 (file)
--- a/t/50_audit_trail.t
+++ b/t/50_audit_trail.t
@@ -49,9 +49,11 @@ sub testit {
 
     for ( @$audit ) {
         eval "$_";
+        warn "$_ -> $@\n" if $@;
     }
 
     my $export2 = $db->export;
+#    use Data::Dumper;warn Dumper $export2;
 
     cmp_deeply( $export2, $export, "And recovery works" );
 }