Auditing has been ported save for blessed objects and clear

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index dbb9a9e..2576ac0 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -406,7 +406,7 @@ sub STORE {
     }
 
     if ( my $afh = $self->_fileobj->{audit_fh} ) {
-        unless ( $self->_type eq TYPE_ARRAY && $orig_key eq 'length' ) {
+        if ( defined $orig_key ) {
             my $lhs = $self->_find_parent;
             if ( $self->_type eq TYPE_HASH ) {
                 $lhs .= "\{$orig_key\}";
@@ -468,7 +468,7 @@ sub FETCH {
     # Fetch single value or element given plain key or array index
     ##
     my $self = shift->_get_self;
-    my ($key) = @_;
+    my ($key, $orig_key) = @_;
 
     my $md5 = $self->{engine}{digest}->($key);
 
@@ -486,7 +486,7 @@ sub FETCH {
     ##
     # Get value from bucket list
     ##
-    my $result = $self->{engine}->get_bucket_value( $tag, $md5 );
+    my $result = $self->{engine}->get_bucket_value( $tag, $md5, $orig_key );
 
     $self->unlock();
 
@@ -501,13 +501,29 @@ 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 ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
+    if ( my $afh = $self->_fileobj->{audit_fh} ) {
+        if ( defined $orig_key ) {
+            my $lhs = $self->_find_parent;
+            if ( $self->_type eq TYPE_HASH ) {
+                $lhs .= "\{$orig_key\}";
+            }
+            else {
+                $lhs .= "\[$orig_key]\]";
+            }
+
+            flock( $afh, LOCK_EX );
+            print( $afh "delete $lhs; # " . localtime(time) . "\n" );
+            flock( $afh, LOCK_UN );
+        }
+    }
+
     ##
     # Request exclusive lock for writing
     ##
@@ -530,7 +546,7 @@ sub DELETE {
         $value = $self->_fileobj->{filter_fetch_value}->($value);
     }
 
-    my $result = $self->{engine}->delete_bucket( $tag, $md5 );
+    my $result = $self->{engine}->delete_bucket( $tag, $md5, $orig_key );
 
     ##
     # If this object is an array and the key deleted was on the end of the stack,
@@ -546,8 +562,8 @@ sub EXISTS {
     ##
     # Check if a single key or element exists given plain key or array index
     ##
-    my $self = $_[0]->_get_self;
-    my $key = $_[1];
+    my $self = shift->_get_self;
+    my ($key) = @_;
 
     my $md5 = $self->{engine}{digest}->($key);
 
@@ -580,12 +596,28 @@ sub CLEAR {
     ##
     # Clear all keys from hash, or all elements from array.
     ##
-    my $self = $_[0]->_get_self;
+    my $self = shift->_get_self;
 
     if ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
+    if ( my $afh = $self->_fileobj->{audit_fh} && 0 ) {
+        my $lhs = $self->_find_parent;
+
+        my $rhs;
+        if ( $self->_type eq TYPE_HASH ) {
+            $rhs = '{}';
+        }
+        else {
+            $rhs = '[]';
+        }
+
+        flock( $afh, LOCK_EX );
+        print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
+        flock( $afh, LOCK_UN );
+    }
+
     ##
     # Request exclusive lock for writing
     ##

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 8270a22..a15f871 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -134,6 +134,7 @@ sub DELETE {
     my ($key) = @_;
 
     my $unpacked_key = $key;
+    my $orig = $key eq 'length' ? undef : $key;
 
     $self->lock( $self->LOCK_EX );
 
@@ -150,7 +151,7 @@ sub DELETE {
         $key = pack($self->{engine}{long_pack}, $key);
     }
 
-    my $rv = $self->SUPER::DELETE( $key );
+    my $rv = $self->SUPER::DELETE( $key, $orig );
 
        if ($rv && $unpacked_key == $size - 1) {
                $self->STORESIZE( $unpacked_key );

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 983b3e9..6c8e959 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -774,7 +774,7 @@ sub delete_bucket {
     # Delete single key/value pair given tag and MD5 digested key.
     ##
     my $self = shift;
-    my ($tag, $md5) = @_;
+    my ($tag, $md5, $orig_key) = @_;
 
     local($/,$\);
 

diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t
index 4824226..af28ce5 100644 (file)
--- a/t/50_audit_trail.t
+++ b/t/50_audit_trail.t
@@ -64,8 +64,6 @@ like(
 $db->{foo} = 'bar';
 like( $audit[1], qr{^\$db->{foo} = 'bar';}, "Basic assignment correct" );
 
-SKIP: {
-    skip 'Not done yet', 20;
 $db->{foo} = 'baz';
 like( $audit[2], qr{^\$db->{foo} = 'baz';}, "Basic update correct" );
 
@@ -142,7 +140,8 @@ undef $db;
     is_deeply( $export2, $export, "And recovery works" );
 }
 
-{
+SKIP: {
+    skip 'Not done yet', 1;
     $db = DBM::Deep->new({
         file => $filename,
         audit_file => $audit_file,
@@ -169,7 +168,8 @@ undef $db;
     is_deeply( $export2, $export, "And recovery works" );
 }
 
-{
+SKIP: {
+    skip "Not working", 3;
     $db = DBM::Deep->new({
         file => $filename,
         audit_file => $audit_file,
@@ -198,4 +198,3 @@ undef $db;
 
     is_deeply( $export2, $export, "And recovery works" );
 }
-}