Fixed a bad dependency version

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

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index dbb9a9e..13259f7 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -401,12 +401,13 @@ sub STORE {
     my $self = shift->_get_self;
     my ($key, $value, $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} ) {
-        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\}";
@@ -432,9 +433,10 @@ sub STORE {
                 $rhs = "bless $rhs, '$c'";
             }
 
-            flock( $afh, LOCK_EX );
-            print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
-            flock( $afh, LOCK_UN );
+            $self->_fileobj->audit( "$lhs = $rhs;" );
+#            flock( $afh, LOCK_EX );
+#            print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
+#            flock( $afh, LOCK_UN );
         }
     }
 
@@ -468,7 +470,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 +488,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 +503,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 +548,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 +564,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 +598,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} ) {
+        my $lhs = $self->_find_parent;
+
+        my $rhs = '()';
+        if ( $self->_type eq TYPE_HASH ) {
+            $lhs = '%{' . $lhs . '}';
+        }
+        else {
+            $lhs = '@{' . $lhs . '}';
+        }
+
+        flock( $afh, LOCK_EX );
+        print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
+        flock( $afh, LOCK_UN );
+    }
+
     ##
     # Request exclusive lock for writing
     ##