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;
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;
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 {
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 {
sub add_entry {
my $self = shift;
- my ($trans_id, $loc) = @_;
+ my ($trans_id, $loc, $idx) = @_;
+
+ return unless $trans_id;
$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;
}
}
$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;