From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Wed, 19 Apr 2006 02:59:22 +0000 (+0000)
Subject: Got auditing all the way brought over. Need to add array tests, but those can wait
X-Git-Tag: 0-99_01~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e82621dd7f8ba5b94df084f3dba82aa98a53ec0c;p=dbsrgits%2FDBM-Deep.git

Got auditing all the way brought over. Need to add array tests, but those can wait
---

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 2576ac0..425012d 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -433,7 +433,7 @@ sub STORE {
             }
 
             flock( $afh, LOCK_EX );
-            print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
+            print( $afh "$lhs = $rhs; # STORE " . localtime(time) . "\n" );
             flock( $afh, LOCK_UN );
         }
     }
@@ -602,15 +602,15 @@ sub CLEAR {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
-    if ( my $afh = $self->_fileobj->{audit_fh} && 0 ) {
+    if ( my $afh = $self->_fileobj->{audit_fh} ) {
         my $lhs = $self->_find_parent;
 
-        my $rhs;
+        my $rhs = '()';
         if ( $self->_type eq TYPE_HASH ) {
-            $rhs = '{}';
+            $lhs = '%{' . $lhs . '}';
         }
         else {
-            $rhs = '[]';
+            $lhs = '@{' . $lhs . '}';
         }
 
         flock( $afh, LOCK_EX );
diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t
index af28ce5..7562c14 100644
--- a/t/50_audit_trail.t
+++ b/t/50_audit_trail.t
@@ -38,7 +38,26 @@ use warnings;
     sub STORESIZE {}
 }
 
-use Test::More tests => 24;
+sub testit {
+    my ($db_orig, $audit) = @_;
+    my $export = $db_orig->export;
+
+    my ($fh2, $file2) = new_fh();
+    my $db = DBM::Deep->new({
+        file => $file2,
+    });
+
+    for ( @$audit ) {
+        eval "$_";
+    }
+
+    my $export2 = $db->export;
+
+    cmp_deeply( $export2, $export, "And recovery works" );
+}
+
+use Test::More tests => 12;
+use Test::Deep;
 use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
@@ -62,27 +81,21 @@ like(
 );
 
 $db->{foo} = 'bar';
-like( $audit[1], qr{^\$db->{foo} = 'bar';}, "Basic assignment correct" );
+testit( $db, \@audit );
 
 $db->{foo} = 'baz';
-like( $audit[2], qr{^\$db->{foo} = 'baz';}, "Basic update correct" );
+testit( $db, \@audit );
 
 $db->{bar} = { a => 1 };
-like( $audit[3], qr{\$db->\{bar\} = \{\};}, "Hash assignment correct" );
-like( $audit[4], qr{\$db->\{bar\}\{a\} = '1';}, "... child 1 good" );
+testit( $db, \@audit );
 
 $db->{baz} = [ 1 .. 2 ];
-like( $audit[5], qr{\$db->{baz} = \[\];}, "Array assignment correct" );
-like( $audit[6], qr{\$db->{baz}\[0\] = '1';}, "... child 1 good" );
-like( $audit[7], qr{\$db->{baz}\[1\] = '2';}, "... child 2 good" );
+testit( $db, \@audit );
 
 {
     my $v = $db->{baz};
     $v->[5] = [ 3 .. 5 ];
-    like( $audit[8], qr{\$db->{baz}\[5\] = \[\];}, "Child array assignment correct" );
-    like( $audit[9], qr{\$db->{baz}\[5\]\[0\] = '3';}, "... child 1 good" );
-    like( $audit[10], qr{\$db->{baz}\[5]\[1] = '4';}, "... child 2 good" );
-    like( $audit[11], qr{\$db->{baz}\[5]\[2] = '5';}, "... child 3 good" );
+    testit( $db, \@audit );
 }
 
 undef $db;
@@ -93,108 +106,13 @@ $db = DBM::Deep->new({
 });
 
 $db->{new} = 9;
-like( $audit[12], qr{\$db->{new} = '9';}, "Writing after closing the file works" );
-
-my $export = $db->export;
-undef $db;
-
-{
-    my ($fh2, $file2) = new_fh();
-    my $db = DBM::Deep->new({
-        file => $file2,
-    });
-
-    for ( @audit ) {
-        eval "$_";
-    }
-
-    my $export2 = $db->export;
-
-    is_deeply( $export2, $export, "And recovery works" );
-}
-
-{
-    $db = DBM::Deep->new({
-        file => $filename,
-        audit_file => $audit_file,
-    });
-
-    delete $db->{baz};
-    like( $audit[13], qr{delete \$db->{baz};}, "Deleting works" );
-
-    $export = $db->export;
-}
-
-{
-    my ($fh2, $file2) = new_fh();
-    my $db = DBM::Deep->new({
-        file => $file2,
-    });
+testit( $db, \@audit );
 
-    for ( @audit ) {
-        eval "$_";
-    }
-
-    my $export2 = $db->export;
-
-    is_deeply( $export2, $export, "And recovery works" );
-}
-
-SKIP: {
-    skip 'Not done yet', 1;
-    $db = DBM::Deep->new({
-        file => $filename,
-        audit_file => $audit_file,
-    });
-
-    $db->{bar}->clear;
-    like( $audit[14], qr{\$db->{bar} = \{\};}, "Clearing works" );
-
-    $export = $db->export;
-}
-
-{
-    my ($fh2, $file2) = new_fh();
-    my $db = DBM::Deep->new({
-        file => $file2,
-    });
-
-    for ( @audit ) {
-        eval "$_";
-    }
+delete $db->{baz};
+testit( $db, \@audit );
 
-    my $export2 = $db->export;
-
-    is_deeply( $export2, $export, "And recovery works" );
-}
-
-SKIP: {
-    skip "Not working", 3;
-    $db = DBM::Deep->new({
-        file => $filename,
-        audit_file => $audit_file,
-    });
-
-    $db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
-    like( $audit[15], qr{\$db->{blessed} = bless {}, 'Floober';},
-            "Assignment of a blessed reference works" );
-    like( $audit[16], qr{\$db->{blessed}{a} = '5';}, "... child 1" );
-    like( $audit[17], qr{\$db->{blessed}{b} = '3';}, "... child 2" );
-
-    $export = $db->export;
-}
-
-{
-    my ($fh2, $file2) = new_fh();
-    my $db = DBM::Deep->new({
-        file => $file2,
-    });
-
-    for ( @audit ) {
-        eval "$_";
-    }
+$db->{bar}->clear;
+testit( $db, \@audit );
 
-    my $export2 = $db->export;
-
-    is_deeply( $export2, $export, "And recovery works" );
-}
+$db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
+testit( $db, \@audit );