r11693@rob-kinyons-powerbook58: rob | 2006-04-30 22:15:38 -0400

 Fixed Win32 bug reported by BrowserUk

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index af0478a..268c835 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -233,7 +233,17 @@ sub import {
         $struct = $self->_repr( @_ );
     }
 
-    return $self->_import( $struct );
+#XXX These are correct, but impossible until the other bug is fixed
+    eval {
+#        $self->begin_work;
+        $self->_import( $struct );
+#        $self->commit;
+    }; if ( $@ ) {
+        $self->rollback;
+        die $@;
+    }
+
+    return 1;
 }
 
 sub optimize {
@@ -248,6 +258,8 @@ sub optimize {
 #        $self->_throw_error("Cannot optimize: reference count is greater than 1");
 #    }
 
+    #XXX Do we have to lock the tempfile?
+
     my $db_temp = DBM::Deep->new(
         file => $self->_fileobj->{file} . '.tmp',
         type => $self->_type

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index be720be..4c7493b 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -710,7 +710,10 @@ sub delete_bucket {
 
     if ( $fileobj->transaction_id == 0 ) {
         my $keytag = $self->load_tag( $keyloc );
+
         my ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag );
+        return if !$subloc || $is_deleted;
+
         my $value = $self->read_from_loc( $subloc, $orig_key );
 
         my $size = $self->_length_needed( $value, $orig_key );
@@ -736,7 +739,9 @@ sub delete_bucket {
     }
     else {
         my $keytag = $self->load_tag( $keyloc );
+
         my ($subloc, $is_deleted, $offset) = $self->find_keyloc( $keytag );
+
         $fileobj->print_at( $keytag->{offset} + $offset,
             pack($self->{long_pack}, -1 ),
             pack( 'C C', $fileobj->transaction_id, 1 ),

diff --git a/t/36_transaction_deep.t b/t/36_transaction_deep.t
index eadc6d3..d0a3619 100644 (file)
--- a/t/36_transaction_deep.t
+++ b/t/36_transaction_deep.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 3;
+use Test::More tests => 7;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -12,12 +12,20 @@ my $db1 = DBM::Deep->new(
     autoflush => 1,
 );
 
+my $x_outer = { a => 'b' };
+my $x_inner = { a => 'c' };;
+
+$db1->{x} = $x_outer;
+is( $db1->{x}{a}, 'b', "We're looking at the right value from outer" );
+
 $db1->begin_work;
 
-    my $x = { a => 'b' };;
-    $db1->{x} = $x;
+    $db1->{x} = $x_inner;
+    is( $db1->{x}{a}, 'c', "We're looking at the right value from inner" );
+    is( $x_outer->{a}, 'c', "We're looking at the right value from outer" );
 
 $db1->commit;
 
-is( $db1->{x}{a}, 'b', "DB1 X-A is good" );
-is( $x->{a}, 'b', "X's A is good" );
+is( $db1->{x}{a}, 'c', "Commit means x_inner is still correct" );
+is( $x_outer->{a}, 'c', "outer made the move" );
+is( $x_inner->{a}, 'c', "inner is still good" );