Fixed why t/33 was failing (errors were skipping the unlock, thus blocking further...

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine.pm

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 2c369a9..85cdafe 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -491,23 +491,9 @@ sub rollback {
         DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
     }
 
-    # Each entry is the file location for a bucket that has a modification for
-    # this transaction. The entries need to be expunged.
-    foreach my $entry (@{ $self->get_entries } ) {
-        # Remove the entry here
-        my $read_loc = $entry
-          + $self->hash_size
-          + $self->byte_size
-          + $self->byte_size
-          + ($self->trans_id - 1) * ( $self->byte_size + $STALE_SIZE );
-
-        my $data_loc = $self->storage->read_at( $read_loc, $self->byte_size );
-        $data_loc = unpack( $StP{$self->byte_size}, $data_loc );
-        $self->storage->print_at( $read_loc, pack( $StP{$self->byte_size}, 0 ) );
-
-        if ( $data_loc > 1 ) {
-            $self->_load_sector( $data_loc )->free;
-        }
+    foreach my $entry ( @{ $self->get_entries } ) {
+        my ($sector, $idx) = split ':', $entry;
+        $self->_load_sector( $sector )->rollback( $idx );
     }
 
     $self->clear_entries;
@@ -529,29 +515,9 @@ sub commit {
         DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
     }
 
-    foreach my $entry (@{ $self->get_entries } ) {
-        # Overwrite the entry in head with the entry in trans_id
-        my $base = $entry
-          + $self->hash_size
-          + $self->byte_size;
-
-        my $head_loc = $self->storage->read_at( $base, $self->byte_size );
-        $head_loc = unpack( $StP{$self->byte_size}, $head_loc );
-
-        my $spot = $base + $self->byte_size + ($self->trans_id - 1) * ( $self->byte_size + $STALE_SIZE );
-        my $trans_loc = $self->storage->read_at(
-            $spot, $self->byte_size,
-        );
-
-        $self->storage->print_at( $base, $trans_loc );
-        $self->storage->print_at(
-            $spot,
-            pack( $StP{$self->byte_size} . ' ' . $StP{$STALE_SIZE}, (0) x 2 ),
-        );
-
-        if ( $head_loc > 1 ) {
-            $self->_load_sector( $head_loc )->free;
-        }
+    foreach my $entry ( @{ $self->get_entries } ) {
+        my ($sector, $idx) = split ':', $entry;
+        $self->_load_sector( $sector )->commit( $idx );
     }
 
     $self->clear_entries;
@@ -567,21 +533,12 @@ sub commit {
 
 sub read_txn_slots {
     my $self = shift;
-    my $bl = $self->txn_bitfield_len;
-    my $num_bits = $bl * 8;
-    return split '', unpack( 'b'.$num_bits,
-        $self->storage->read_at(
-            $self->trans_loc, $bl,
-        )
-    );
+    return $self->_load_header->read_txn_slots(@_);
 }
 
 sub write_txn_slots {
     my $self = shift;
-    my $num_bits = $self->txn_bitfield_len * 8;
-    $self->storage->print_at( $self->trans_loc,
-        pack( 'b'.$num_bits, join('', @_) ),
-    );
+    return $self->_load_header->write_txn_slots(@_);
 }
 
 sub get_running_txn_ids {
@@ -592,30 +549,12 @@ sub get_running_txn_ids {
 
 sub get_txn_staleness_counter {
     my $self = shift;
-    my ($trans_id) = @_;
-
-    # Hardcode staleness of 0 for the HEAD
-    return 0 unless $trans_id;
-
-    return unpack( $StP{$STALE_SIZE},
-        $self->storage->read_at(
-            $self->trans_loc + $self->txn_bitfield_len + $STALE_SIZE * ($trans_id - 1),
-            $STALE_SIZE,
-        )
-    );
+    return $self->_load_header->get_txn_staleness_counter(@_);
 }
 
 sub inc_txn_staleness_counter {
     my $self = shift;
-    my ($trans_id) = @_;
-
-    # Hardcode staleness of 0 for the HEAD
-    return 0 unless $trans_id;
-
-    $self->storage->print_at(
-        $self->trans_loc + $self->txn_bitfield_len + $STALE_SIZE * ($trans_id - 1),
-        pack( $StP{$STALE_SIZE}, $self->get_txn_staleness_counter( $trans_id ) + 1 ),
-    );
+    return $self->_load_header->inc_txn_staleness_counter(@_);
 }
 
 sub get_entries {
@@ -625,23 +564,23 @@ sub get_entries {
 
 sub add_entry {
     my $self = shift;
-    my ($trans_id, $loc) = @_;
+    my ($trans_id, $loc, $idx) = @_;
 
     $self->{entries}{$trans_id} ||= {};
-    $self->{entries}{$trans_id}{$loc} = undef;
+    $self->{entries}{$trans_id}{"$loc:$idx"} = undef;
 }
 
 # If the buckets are being relocated because of a reindexing, the entries
 # mechanism needs to be made aware of it.
 sub reindex_entry {
     my $self = shift;
-    my ($old_loc, $new_loc) = @_;
+    my ($old_loc, $old_idx, $new_loc, $new_idx) = @_;
 
     TRANS:
     while ( my ($trans_id, $locs) = each %{ $self->{entries} } ) {
-        if ( exists $locs->{$old_loc} ) {
-            delete $locs->{$old_loc};
-            $locs->{$new_loc} = undef;
+        if ( exists $locs->{"$old_loc:$old_idx"} ) {
+            delete $locs->{"$old_loc:$old_idx"};
+            $locs->{"$new_loc:$new_idx"} = undef;
             next TRANS;
         }
     }
@@ -781,6 +720,10 @@ sub flush {
         $self->storage->print_at( $offset, $self->sector_cache->{$offset} );
     }
 
+    # Why do we need to have the storage flush? Shouldn't autoflush take care of things?
+    # -RobK, 2008-06-26
+    $self->storage->flush;
+
     $self->clear_dirty_sectors;
 
     $self->clear_sector_cache;