From: rkinyon Date: Tue, 21 Feb 2006 18:51:40 +0000 (+0000) Subject: Fixed the fact that delete should return the value deleted X-Git-Tag: 0-97~32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81d3d316f7cd26323e0650dfd42620670687e2ae;p=dbsrgits%2FDBM-Deep.git 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 --- 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 --- 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 --- 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 --- 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" ); }