Fixed a bug in autovivification regarding how locking is handled.

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 1a841f8..fd6b9b7 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -134,6 +134,11 @@ sub read_value {
     });
 
     unless ( $value_sector ) {
+        # On Win32, we have to release the shared lock and acquire
+        # an exclusive lock in order to do any writing. We cannot
+        # just upgrade the shared lock to an exclusive lock because
+        # ::File::lock() doesn't let us (yet). -RobK, 2007-11-15
+        $self->storage->unlock; $self->storage->lock;
         $value_sector = DBM::Deep::Engine::Sector::Null->new({
             engine => $self,
             data   => undef,
@@ -924,6 +929,7 @@ sub _dump_file {
         $return .= $/;
     }
 
+eval{
     SECTOR:
     while ( $spot < $self->storage->{end} ) {
         # Read each sector in order.
@@ -978,6 +984,9 @@ sub _dump_file {
             $spot += $sector->size;
         }
     }
+}; if ( $@ ) {
+    return $return, $@;
+}
 
     return $return;
 }
@@ -2085,6 +2094,8 @@ sub get_data_location_for {
     );
     my ($loc, $staleness) = unpack( $StP{$e->byte_size} . ' ' . $StP{$STALE_SIZE}, $buffer );
 
+    # XXX Merge the two if-clauses below
+
     if ( $args->{trans_id} ) {
         # We have found an entry that is old, so get rid of it
         if ( $staleness != (my $s = $e->get_txn_staleness_counter( $args->{trans_id} ) ) ) {
@@ -2105,6 +2116,7 @@ sub get_data_location_for {
             idx        => $args->{idx},
         });
     }
+
     return $loc <= 1 ? 0 : $loc;
 }
 

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 83835d9..6f8e060 100644 (file)
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -110,7 +110,7 @@ sub print_at {
         seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
     }
 
-    print( $fh @_ );
+    print( $fh @_ ) or die "Internal Error (print_at): $!\n";
 
     return 1;
 }
@@ -165,6 +165,9 @@ sub lock {
 
     if (!defined($self->{fh})) { return; }
 
+    #XXX This needs to allow for upgrading a shared lock to an
+    # exclusive lock. q.v. the comment in read_value when
+    # autovivifying. -RobK, 2007-11-15
     if ($self->{locking}) {
         if (!$self->{locked}) {
             flock($self->{fh}, $type);

diff --git a/t/02_hash.t b/t/02_hash.t
index 59495ff..189b45d 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -9,7 +9,10 @@ use t::common qw( new_fh );
 use_ok( 'DBM::Deep' );
 
 my ($fh, $filename) = new_fh();
-my $db = DBM::Deep->new( $filename );
+my $db = DBM::Deep->new(
+    file => $filename,
+    fh => $fh,
+);
 
 ##
 # put/get key