CLEAR now works ... all that's left before 0.99_01 is documentation

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 90005ce..cfa458b 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -641,11 +641,30 @@ sub CLEAR {
     ##
     $self->lock( LOCK_EX );
 
+    if ( $self->_type eq TYPE_HASH ) {
+        my $key = $self->first_key;
+        while ( $key ) {
+            my $next_key = $self->next_key( $key );
+            my $md5 = $self->_engine->{digest}->($key);
+            my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
+            $self->_engine->delete_bucket( $tag, $md5, $key );
+            $key = $next_key;
+        }
+    }
+    else {
+        my $size = $self->FETCHSIZE;
+        for my $key ( map { pack ( $self->_engine->{long_pack}, $_ ) } 0 .. $size - 1 ) {
+            my $md5 = $self->_engine->{digest}->($key);
+            my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
+            $self->_engine->delete_bucket( $tag, $md5, $key );
+        }
+        $self->STORESIZE( 0 );
+    }
 #XXX This needs updating to use _release_space
-    $self->_engine->write_tag(
-        $self->_base_offset, $self->_type,
-        chr(0)x$self->_engine->{index_size},
-    );
+#    $self->_engine->write_tag(
+#        $self->_base_offset, $self->_type,
+#        chr(0)x$self->_engine->{index_size},
+#    );
 
     $self->unlock();
 

diff --git a/t/33_transactions.t b/t/33_transactions.t
index 3b72a36..2971a84 100644 (file)
--- a/t/33_transactions.t
+++ b/t/33_transactions.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 58;
+use Test::More tests => 62;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -116,9 +116,6 @@ is( $db2->{foo}, 'bar', "Set foo to bar in DB2" );
 cmp_bag( [ keys %$db1 ], [qw( foo )], "DB1 keys correct" );
 cmp_bag( [ keys %$db2 ], [qw( foo )], "DB2 keys correct" );
 
-TODO: {
-    todo_skip 'Still need to work on clear()', 4;
-
 $db1->begin_work;
 
     %$db1 = (); # clear()
@@ -136,9 +133,8 @@ is( $db2->{foo}, 'bar', "Rollback means 'foo' is still there" );
 cmp_bag( [ keys %$db1 ], [qw( foo )], "DB1 keys correct" );
 cmp_bag( [ keys %$db2 ], [qw( foo )], "DB2 keys correct" );
 
-}
-
 $db1->optimize;
+
 is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
 is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
 

diff --git a/t/34_transaction_arrays.t b/t/34_transaction_arrays.t
index 420bb2d..ea50810 100644 (file)
--- a/t/34_transaction_arrays.t
+++ b/t/34_transaction_arrays.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 43;
+use Test::More tests => 47;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -108,3 +108,16 @@ is( $db1->[-1], 'foo' );
 
 is( $db2->[0], 'bar' );
 is( $db2->[-1], 'foo' );
+
+$db1->begin_work;
+
+    @$db1 = (); # clear()
+
+    cmp_ok( scalar(@$db1), '==', 0, "DB1 now has 0 elements" );
+    cmp_ok( scalar(@$db2), '==', 5, "DB2 still has 5 elements" );
+
+$db1->rollback;
+
+cmp_ok( scalar(@$db1), '==', 5, "DB1 now has 5 elements" );
+cmp_ok( scalar(@$db2), '==', 5, "DB2 still has 5 elements" );
+