From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Thu, 27 Apr 2006 19:00:54 +0000 (+0000)
Subject: CLEAR now works ... all that's left before 0.99_01 is documentation
X-Git-Tag: 0-99_02~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f9a320bbfd5286e53755daee52535fdba66b2969;p=dbsrgits%2FDBM-Deep.git

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
--- 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
--- 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
--- 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" );
+