Tagged 0.981_01 (experimental auditlog)

diff --git a/Build.PL b/Build.PL
index 18173d8..db016d0 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -17,7 +17,8 @@ my $build = Module::Build->new(
     },
     create_makefile_pl => 'traditional',
     add_to_cleanup => [
-        'META.yml', '*.bak', '*.gz', 'Makefile.PL', 't/test*.db', 'cover_db'
+        'META.yml', '*.bak', '*.gz', 'Makefile.PL', 't/test*.db', 'cover_db',
+        't/*.txt',
     ],
     test_files => 't/??_*.t',
 );

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 6b7197f..c51fe40 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -1483,9 +1483,25 @@ sub DELETE {
        ##
        # Delete single key/value pair or element given plain key or array index
        ##
-    my $self = $_[0]->_get_self;
-       my $key = $_[1];
+    my $self = shift->_get_self;
+       my ($key, $orig_key) = @_;
        
+    if ( my $afh = $self->_root->{audit_fh} ) {
+        unless ( $self->_type eq SIG_ARRAY && $key eq 'length' ) {
+            my $lhs = $self->_find_parent;
+            if ( $self->_type eq SIG_HASH ) {
+                $lhs .= "\{$key\}";
+            }
+            else {
+                $lhs .= "\[$_[3]\]";
+            }
+
+            flock( $afh, LOCK_EX );
+            print( $afh "delete $lhs; # " . localtime(time) . "\n" );
+            flock( $afh, LOCK_UN );
+        }
+    }
+
        my $md5 = $DIGEST_FUNC->($key);
 
        ##
@@ -1569,6 +1585,22 @@ sub CLEAR {
        ##
     my $self = $_[0]->_get_self;
 
+    if ( my $afh = $self->_root->{audit_fh} ) {
+        my $lhs = $self->_find_parent;
+
+        my $rhs;
+        if ( $self->_type eq SIG_HASH ) {
+            $rhs = '{}';
+        }
+        elsif ( $self->_type eq SIG_ARRAY ) {
+            $rhs = '[]';
+        }
+
+        flock( $afh, LOCK_EX );
+        print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
+        flock( $afh, LOCK_UN );
+    }
+
        ##
        # Make sure file is open
        ##

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 23189b9..614290e 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -136,7 +136,7 @@ sub DELETE {
         $key = pack($DBM::Deep::LONG_PACK, $key);
     }
 
-    my $rv = $self->SUPER::DELETE( $key );
+    my $rv = $self->SUPER::DELETE( $key, $unpacked_key );
 
        if ($rv && $unpacked_key == $size - 1) {
                $self->STORESIZE( $unpacked_key );

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 0c0e909..31af528 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -36,7 +36,7 @@ sub STORE {
         : $_[0];
     my $value = $_[1];
 
-    return $self->SUPER::STORE( $key, $value );
+    return $self->SUPER::STORE( $key, $value, $_[0] );
 }
 
 sub EXISTS {
@@ -54,7 +54,7 @@ sub DELETE {
         ? $self->_root->{filter_store_key}->($_[0])
         : $_[0];
 
-    return $self->SUPER::DELETE( $key );
+    return $self->SUPER::DELETE( $key, $_[0] );
 }
 
 sub FIRSTKEY {

diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t
index 1042504..230b5d2 100644 (file)
--- a/t/50_audit_trail.t
+++ b/t/50_audit_trail.t
@@ -38,7 +38,7 @@ $|=1;
     sub STORESIZE {}
 }
 
-use Test::More tests => 16;
+use Test::More tests => 20;
 
 use_ok( 'DBM::Deep' );
 
@@ -113,3 +113,59 @@ undef $db;
 
     is_deeply( $export2, $export, "And recovery works" );
 }
+
+{
+    $db = DBM::Deep->new({
+        file => 't/test.db',
+        audit_file => $audit_file,
+    });
+
+    delete $db->{baz};
+    like( $audit[13], qr{delete \$db->{baz};}, "Deleting works" );
+
+    $export = $db->export;
+}
+
+{
+    unlink 't/test2.db';
+    my $db = DBM::Deep->new({
+        file => 't/test2.db',
+    });
+
+    for ( @audit ) {
+        eval "$_";
+    }
+
+    my $export2 = $db->export;
+
+    is_deeply( $export2, $export, "And recovery works" );
+}
+
+{
+    $db = DBM::Deep->new({
+        file => 't/test.db',
+        audit_file => $audit_file,
+    });
+
+    $db->{bar}->clear;
+    like( $audit[14], qr{\$db->{bar} = \{\};}, "Clearing works" );
+
+    $export = $db->export;
+}
+
+{
+    unlink 't/test2.db';
+    my $db = DBM::Deep->new({
+        file => 't/test2.db',
+    });
+
+    for ( @audit ) {
+        eval "$_";
+    }
+
+    my $export2 = $db->export;
+
+    is_deeply( $export2, $export, "And recovery works" );
+}
+
+