r11705@rob-kinyons-powerbook58: rob | 2006-05-01 13:19:45 -0400

 Fixed bugs with delete_bucket, add_bucket, and transactions that were exposed through Win32 testing done by Nigel Sandever (Thanks\!)

diff --git a/Build.PL b/Build.PL
index 61c368a..c73c3f1 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -29,4 +29,3 @@ my $build = Module::Build->new(
 );
 
 $build->create_build_script;
-

diff --git a/Changes b/Changes
index bca3e01..62a45d2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@ Revision history for DBM::Deep.
 
 0.99_03 ??? ?? ??:??:?? 2006 Pacific
     - Converted to use FileHandle::Fmode to handle filehandle status checks
+    - Fixed bug with deleting already-deleted items on Win32 (reported by Nigel Sandever)
 
 0.99_02 Apr 28 05:00:00 2006 Pacific
     - Added missing file to the MANIFEST

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 268c835..887481f 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -246,6 +246,8 @@ sub import {
     return 1;
 }
 
+#XXX Need to keep track of who has a fh to this file in order to
+#XXX close them all prior to optimize on Win32/cygwin
 sub optimize {
     ##
     # Rebuild entire database into new file, then move

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 4c7493b..94be351 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -354,7 +354,7 @@ sub add_bucket {
         my $keytag = $self->load_tag( $keyloc );
         my ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag );
 
-        if ( @transactions ) {
+        if ( $subloc && !$is_deleted && @transactions ) {
             my $old_value = $self->read_from_loc( $subloc, $orig_key );
             my $old_size = $self->_length_needed( $old_value, $plain_key );
 
@@ -406,7 +406,7 @@ sub add_bucket {
         my $offset = 1;
         for my $trans_id ( @transactions ) {
             $fileobj->print_at( $keytag->{offset} + $self->{key_size} * $offset++,
-                pack( $self->{long_pack}, -1 ),
+                pack( $self->{long_pack}, 0 ),
                 pack( 'C C', $trans_id, 1 ),
             );
         }
@@ -677,7 +677,7 @@ sub get_bucket_value {
     else {
         my $keytag = $self->load_tag( $keyloc );
         my ($subloc, $is_deleted) = $self->find_keyloc( $keytag );
-        if (!$subloc) {
+        if (!$subloc && !$is_deleted) {
             ($subloc, $is_deleted) = $self->find_keyloc( $keytag, 0 );
         }
         if ( $subloc && !$is_deleted ) {
@@ -743,7 +743,7 @@ sub delete_bucket {
         my ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag );
 
         $fileobj->print_at( $keytag->{offset} + $offset,
-            pack($self->{long_pack}, -1 ),
+            pack($self->{long_pack}, 0 ),
             pack( 'C C', $fileobj->transaction_id, 1 ),
         );
     }
@@ -762,7 +762,7 @@ sub bucket_exists {
     my ($keyloc) = $self->_find_in_buckets( $tag, $md5 );
     my $keytag = $self->load_tag( $keyloc );
     my ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag );
-    if ( !$subloc ) {
+    if ( !$subloc && !$is_deleted ) {
         ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag, 0 );
     }
     return ($subloc && !$is_deleted) && 1;
@@ -898,7 +898,7 @@ sub traverse_index {
 
                 my $keytag = $self->load_tag( $keyloc );
                 my ($subloc, $is_deleted) = $self->find_keyloc( $keytag );
-                if ( $subloc == 0 ) {
+                if ( $subloc == 0 && !$is_deleted ) {
                     ($subloc, $is_deleted) = $self->find_keyloc( $keytag, 0 );
                 }
                 next if $is_deleted;

diff --git a/t/08_deephash.t b/t/08_deephash.t
index 11b0877..ff7a9f3 100644 (file)
--- a/t/08_deephash.t
+++ b/t/08_deephash.t
@@ -5,6 +5,8 @@ use strict;
 use Test::More tests => 5;
 use t::common qw( new_fh );
 
+diag "This test can take up to a minute to run. Please be patient.";
+
 use_ok( 'DBM::Deep' );
 
 my ($fh, $filename) = new_fh();

diff --git a/t/09_deeparray.t b/t/09_deeparray.t
index 288492b..d47ecc8 100644 (file)
--- a/t/09_deeparray.t
+++ b/t/09_deeparray.t
@@ -5,6 +5,8 @@ use strict;
 use Test::More tests => 3;
 use t::common qw( new_fh );
 
+diag "This test can take up to a minute to run. Please be patient.";
+
 use_ok( 'DBM::Deep' );
 
 my ($fh, $filename) = new_fh();

diff --git a/t/11_optimize.t b/t/11_optimize.t
index 27d2058..9fef32b 100644 (file)
--- a/t/11_optimize.t
+++ b/t/11_optimize.t
@@ -63,7 +63,8 @@ is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
 ##
 
 SKIP: {
-    skip "Fork tests skipped on Win32", 4 if $^O eq 'MSWin32';
+    skip "Fork tests skipped on Win32", 4
+        if $^O eq 'MSWin32' || $^O eq 'cygwin';
 
     ##
     # first things first, get us about 1000 keys so the optimize() will take 

diff --git a/t/33_transactions.t b/t/33_transactions.t
index 2971a84..6f813b2 100644 (file)
--- a/t/33_transactions.t
+++ b/t/33_transactions.t
@@ -33,7 +33,7 @@ $db1->begin_work;
 
     $db2->{other_x} = 'foo';
     is( $db2->{other_x}, 'foo', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
-    is( $db1->{other_x}, undef, "Since other_x was added after the transaction began, DB1 doesn't see it." );
+    ok( !exists $db1->{other_x}, "Since other_x was added after the transaction began, DB1 doesn't see it." );
 
     cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
     cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
@@ -133,19 +133,24 @@ 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;
+SKIP: {
+    skip "Optimize tests skipped on Win32", 5
+        if $^O eq 'MSWin32' || $^O eq 'cygwin';
 
-is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
-is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
+    $db1->optimize;
 
-cmp_bag( [ keys %$db1 ], [qw( foo )], "DB1 keys correct" );
-cmp_bag( [ keys %$db2 ], [qw( foo )], "DB2 keys correct" );
+    is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
+    is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
 
-$db1->begin_work;
+    cmp_bag( [ keys %$db1 ], [qw( foo )], "DB1 keys correct" );
+    cmp_bag( [ keys %$db2 ], [qw( foo )], "DB2 keys correct" );
 
-    cmp_ok( $db1->_fileobj->transaction_id, '==', 1, "Transaction ID has been reset after optimize" );
+    $db1->begin_work;
 
-$db1->rollback;
+        cmp_ok( $db1->_fileobj->transaction_id, '==', 1, "Transaction ID has been reset after optimize" );
+
+    $db1->rollback;
+}
 
 __END__