Fixed the fact that delete should return the value deleted

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index d241003..349633d 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -87,20 +87,22 @@ set_digest();
 ##
 # Setup file and tag signatures.  These should never change.
 ##
-sub SIG_FILE  () { 'DPDB' }
-sub SIG_HASH  () { 'H' }
-sub SIG_ARRAY () { 'A' }
-sub SIG_NULL  () { 'N' }
-sub SIG_DATA  () { 'D' }
-sub SIG_INDEX () { 'I' }
-sub SIG_BLIST () { 'B' }
-sub SIG_SIZE  () {  1  }
+sub SIG_FILE   () { 'DPDB' }
+sub SIG_HASH   () { 'H' }
+sub SIG_ARRAY  () { 'A' }
+sub SIG_SCALAR () { 'S' }
+sub SIG_NULL   () { 'N' }
+sub SIG_DATA   () { 'D' }
+sub SIG_INDEX  () { 'I' }
+sub SIG_BLIST  () { 'B' }
+sub SIG_SIZE   () {  1  }
 
 ##
 # Setup constants for users to pass to new()
 ##
-sub TYPE_HASH  () { return SIG_HASH; }
-sub TYPE_ARRAY () { return SIG_ARRAY; }
+sub TYPE_HASH   () { return SIG_HASH; }
+sub TYPE_ARRAY  () { return SIG_ARRAY; }
+sub TYPE_SCALAR () { return SIG_SCALAR; }
 
 sub new {
        ##
@@ -1234,14 +1236,18 @@ sub STORE {
        # Store single hash key/value or array element in database.
        ##
     my $self = $_[0]->_get_self;
-       my $key = ($self->root->{filter_store_key} && $self->type eq TYPE_HASH) ? $self->root->{filter_store_key}->($_[1]) : $_[1];
+       my $key = $_[1];
+
     #XXX What is ref() checking here?
     #YYY User may be storing a hash, in which case we do not want it run 
     #YYY through the filtering system
-       my $value = ($self->root->{filter_store_value} && !ref($_[2])) ? $self->root->{filter_store_value}->($_[2]) : $_[2];
+       my $value = ($self->root->{filter_store_value} && !ref($_[2]))
+        ? $self->root->{filter_store_value}->($_[2])
+        : $_[2];
        
        my $unpacked_key = $key;
        if (($self->type eq TYPE_ARRAY) && ($key =~ /^\d+$/)) { $key = pack($LONG_PACK, $key); }
+
        my $md5 = $DIGEST_FUNC->($key);
        
        ##
@@ -1393,6 +1399,7 @@ sub DELETE {
        ##
        # Delete bucket
        ##
+    my $value = $self->FETCH( $unpacked_key );
        my $result = $self->_delete_bucket( $tag, $md5 );
        
        ##
@@ -1405,7 +1412,7 @@ sub DELETE {
        
        $self->unlock();
        
-       return $result;
+       return $value;
 }
 
 sub EXISTS {

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 30f4e90..1850388 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -24,6 +24,16 @@ sub TIEHASH {
     return $class->_init($args);
 }
 
+sub STORE {
+    my $self = shift->_get_self;
+       my $key = ($self->root->{filter_store_key})
+        ? $self->root->{filter_store_key}->($_[0])
+        : $_[0];
+    my $value = $_[1];
+
+    return $self->SUPER::STORE( $key, $value );
+}
+
 sub FIRSTKEY {
        ##
        # Locate and return first key (in no particular order)

diff --git a/t/02_hash.t b/t/02_hash.t
index 041e255..67c7c95 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -65,11 +65,8 @@ is( $temphash->{key3}, 'value3', "Third key copied successfully" );
 ##
 # delete keys
 ##
-TODO: {
-    local $TODO = "Delete should return the deleted value";
-    is( delete $db->{key1}, 'value1', "delete through tied inteface works" );
-    is( $db->delete("key2"), undef, "delete through OO inteface works" );
-}
+is( delete $db->{key1}, 'value1', "delete through tied inteface works" );
+is( $db->delete("key2"), undef, "delete through OO inteface works" );
 
 is( scalar keys %$db, 1, "After deleting two keys, 1 remains" );
 

diff --git a/t/04_array.t b/t/04_array.t
index 9b52e40..d5385a1 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -87,10 +87,7 @@ is( $db->length, 3, "... and we still have three after deleting" );
 is( $db->[0], undef, "0th element now undef" );
 is( $db->[1], 'elem2', "1st element still there after deleting" );
 is( $db->[2], 'elem3', "2nd element still there after deleting" );
-TODO: {
-    local $TODO = "delete on an array element should return the deleted value";
-    is( $deleted, 'elem1', "Deleted value is correct" );
-}
+is( $deleted, 'elem1', "Deleted value is correct" );
 
 is( $db->delete(99), undef, 'delete on an element not in the array returns undef' );
 is( $db->length, 3, "... and we still have three after a delete on an out-of-range index" );
@@ -113,7 +110,7 @@ TODO: {
 }
 is( $db->[2], 'elem3', "2nd element still there after deleting" );
 TODO: {
-    local $TODO = "delete on an array element should return the deleted value";
+    local $TODO = "delete on a negative array element should return the deleted value";
     is( $deleted, 'elem2', "Deleted value is correct" );
 }