my $key_md5 = $self->_apply_digest( $key );
- # XXX What should happen if this fails?
- my $blist = $sector->get_bucket_list({
- key_md5 => $key_md5,
- create => 1,
- }) or die "How did read_value fail (no blist)?!\n";
+ my $value_sector = $sector->get_data_for({
+ key_md5 => $key_md5,
+ allow_head => 1,
+ });
- my $value_sector = $blist->get_data_for( $key_md5, { allow_head => 1 } );
- if ( !$value_sector ) {
- # Autovivification
+ unless ( $value_sector ) {
$value_sector = DBM::Deep::Engine::Sector::Null->new({
engine => $self,
data => undef,
});
- $blist->write_md5( $key_md5, $key, $value_sector->offset );
+ $sector->write_data({
+ key_md5 => $key_md5,
+ key => $key,
+ value => $value_sector,
+ });
}
return $value_sector->data;
my $sector = $self->_load_sector( $obj->_base_offset )
or die "How did key_exists fail (no sector for '$obj')?!\n";
- my $key_md5 = $self->_apply_digest( $key );
-
- # XXX What should happen if this fails?
- my $blist = $sector->get_bucket_list({
- key_md5 => $key_md5,
- }) or die "How did key_exists fail (no blist)?!\n";
+ my $data = $sector->get_data_for({
+ key_md5 => $self->_apply_digest( $key ),
+ allow_head => 1,
+ });
# exists() returns 1 or '' for true/false.
- return $blist->has_md5( $key_md5, { allow_head => 1 } ) ? 1 : '';
+ return $data ? 1 : '';
}
sub delete_key {
my $sector = $self->_load_sector( $obj->_base_offset )
or die "How did delete_key fail (no sector for '$obj')?!\n";
+ return $sector->delete_key({
+ key_md5 => $self->_apply_digest( $key ),
+ allow_head => 0,
+ });
+
my $key_md5 = $self->_apply_digest( $key );
# XXX What should happen if this fails?
my $self = shift;
my ($obj, $key, $value) = @_;
- # This will be a Reference sector
- my $sector = $self->_load_sector( $obj->_base_offset )
- or die "How did write_value fail (no sector for '$obj')?!\n";
-
- my $key_md5 = $self->_apply_digest( $key );
-
- # XXX What should happen if this fails?
- my $blist = $sector->get_bucket_list({
- key_md5 => $key_md5,
- create => 1,
- }) or die "How did write_value fail (no blist)?!\n";
-
my $r = Scalar::Util::reftype( $value ) || '';
{
last if $r eq '';
$class = 'DBM::Deep::Engine::Sector::Scalar';
}
- if ( $blist->has_md5( $key_md5 ) ) {
- $blist->get_data_for( $key_md5, { allow_head => 0 } )->free;
- }
+ # This will be a Reference sector
+ my $sector = $self->_load_sector( $obj->_base_offset )
+ or die "How did write_value fail (no sector for '$obj')?!\n";
+ # Create this after loading the reference sector in case something bad happens.
+ # This way, we won't allocate value sector(s) needlessly.
my $value_sector = $class->new({
engine => $self,
data => $value,
type => $type,
});
- $blist->write_md5( $key_md5, $key, $value_sector->offset );
+ $sector->write_data({
+ key => $key,
+ key_md5 => $self->_apply_digest( $key ),
+ value => $value_sector,
+ });
# This code is to make sure we write all the values in the $value to the disk
# and to make sure all changes to $value after the assignment are reflected
offset => $offset,
});
}
+ # XXX Don't we need key_md5 here?
elsif ( $type eq $self->SIG_BLIST ) {
return DBM::Deep::Engine::Sector::BucketList->new({
engine => $self,
breadcrumbs => [],
engine => $args->{engine},
base_offset => $args->{base_offset},
- trans_id => $args->{trans_id},
}, $class;
Scalar::Util::weaken( $self->{engine} );
last;
}
+ if ( $idx >= $self->{engine}->max_buckets ) {
+ $self->reset;
+ last;
+ }
+
my $sector = $self->{engine}->_load_sector( $offset )
or die "Iterator: How did this fail (no blist sector for '$offset')?!\n";
+ #XXX Think this through!
+ my $loc = $sector->get_data_location_for({
+ idx => $idx,
+ });
+ unless ( $loc ) {
+ $crumbs->[-1][1]++;
+ next;
+ }
+
my $key_sector = $sector->get_key_for( $idx );
unless ( $key_sector ) {
$self->reset;
return $self;
}
sub _init {}
+sub clone { die "Must be implemented in the child class" }
sub engine { $_[0]{engine} }
sub offset { $_[0]{offset} }
# This is in bytes
sub size { return 256 }
+sub clone {
+ my $self = shift;
+ return ref($self)->new({
+ engine => $self->engine,
+ data => $self->data,
+ type => $self->type,
+ });
+}
+
package DBM::Deep::Engine::Sector::Scalar;
our @ISA = qw( DBM::Deep::Engine::Sector::Data );
unless ( $self->offset ) {
my $data_section = $self->size - 3 - 1 * $engine->byte_size;
- my $data = delete $self->{data};
-
$self->{offset} = $engine->_request_sector( $self->size );
+ my $data = delete $self->{data};
my $dlen = length $data;
my $continue = 1;
my $curr_offset = $self->offset;
return;
}
+sub get_data_for {
+ my $self = shift;
+ my ($args) = @_;
+
+ # Assume that the head is not allowed unless otherwise specified.
+ $args->{allow_head} = 0 unless exists $args->{allow_head};
+
+ # Assume we don't create a new blist location unless otherwise specified.
+ $args->{create} = 0 unless exists $args->{create};
+
+ my $blist = $self->get_bucket_list({
+ key_md5 => $args->{key_md5},
+ create => $args->{create},
+ });
+ return unless $blist && $blist->{found};
+
+ # At this point, $blist knows where the md5 is. What it -doesn't- know yet
+ # is whether or not this transaction has this key. That's part of the next
+ # function call.
+ my $location = $blist->get_data_location_for({
+ allow_head => $args->{allow_head},
+ }) or return;
+
+ return $self->engine->_load_sector( $location );
+}
+
+sub write_data {
+ my $self = shift;
+ my ($args) = @_;
+
+ my $blist = $self->get_bucket_list({
+ key_md5 => $args->{key_md5},
+ create => 1,
+ }) or die "How did write_value fail (no blist)?!\n";
+
+ # Handle any transactional bookkeeping.
+ if ( $self->engine->trans_id ) {
+ if ( ! $blist->{found} ) {
+ $blist->mark_deleted({
+ trans_id => 0,
+ });
+ }
+ }
+ else {
+ my @transactions = $self->engine->read_transaction_slots;
+ my @trans_ids = grep { $transactions[$_] } 0 .. $#transactions;
+ if ( $blist->{found} ) {
+ if ( @trans_ids ) {
+ my $old_value = $blist->get_data_for;
+ foreach my $other_trans_id ( @trans_ids ) {
+ next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 });
+ $blist->write_md5({
+ trans_id => $other_trans_id,
+ key => $args->{key},
+ key_md5 => $args->{key_md5},
+ value => $old_value->clone,
+ });
+ }
+ }
+ }
+ else {
+ if ( @trans_ids ) {
+ foreach my $other_trans_id ( @trans_ids ) {
+ next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 });
+ $blist->mark_deleted({
+ trans_id => $other_trans_id,
+ });
+ }
+ }
+ }
+ }
+
+ # Free the place we're about to write to.
+ if ( $blist->get_data_location_for({ allow_head => 0 }) ) {
+ $blist->get_data_for({ allow_head => 0 })->free;
+ }
+
+ $blist->write_md5({
+ key => $args->{key},
+ key_md5 => $args->{key_md5},
+ value => $args->{value},
+ });
+}
+
+sub delete_key {
+ my $self = shift;
+ my ($args) = @_;
+
+ # XXX What should happen if this fails?
+ my $blist = $self->get_bucket_list({
+ key_md5 => $args->{key_md5},
+ }) or die "How did delete_key fail (no blist)?!\n";
+
+ return $blist->delete_md5( $args );
+}
+
sub get_blist_loc {
my $self = shift;
- my $engine = $self->engine;
- my $blist_loc = $engine->storage->read_at( $self->offset + 2, $engine->byte_size );
- return unpack( $StP{$engine->byte_size}, $blist_loc );
+ my $e = $self->engine;
+ my $blist_loc = $e->storage->read_at( $self->offset + 2, $e->byte_size );
+ return unpack( $StP{$e->byte_size}, $blist_loc );
}
sub get_bucket_list {
return unless $args->{create};
my $blist = DBM::Deep::Engine::Sector::BucketList->new({
- engine => $engine,
+ engine => $engine,
+ key_md5 => $args->{key_md5},
});
+
$engine->storage->print_at( $self->offset + 2,
pack( $StP{$engine->byte_size}, $blist->offset ),
);
+
return $blist;
}
return DBM::Deep::Engine::Sector::BucketList->new({
- engine => $engine,
- offset => $blist_loc,
+ engine => $engine,
+ offset => $blist_loc,
+ key_md5 => $args->{key_md5},
});
}
);
}
+ if ( $self->{key_md5} ) {
+ $self->find_md5;
+ }
+
return $self;
}
sub size {
my $self = shift;
- my $e = $self->engine;
- return $self->base_size + $e->max_buckets * $self->bucket_size; # Base + numbuckets * bucketsize
+ unless ( $self->{size} ) {
+ my $e = $self->engine;
+ $self->{size} = $self->base_size + $e->max_buckets * $self->bucket_size; # Base + numbuckets * bucketsize
+ }
+ return $self->{size};
}
sub bucket_size {
my $self = shift;
- my $e = $self->engine;
- # Key + transactions
- my $locs_size = (1 + $e->num_txns ) * $e->byte_size;
- return $e->hash_size + $locs_size;
+ unless ( $self->{bucket_size} ) {
+ my $e = $self->engine;
+ # Key + transactions
+ my $locs_size = (1 + $e->num_txns ) * $e->byte_size;
+ $self->{bucket_size} = $e->hash_size + $locs_size;
+ }
+ return $self->{bucket_size};
}
sub has_md5 {
my $self = shift;
- my ($found, $idx) = $self->find_md5( @_ );
- return $found;
+ unless ( exists $self->{found} ) {
+ $self->find_md5;
+ }
+ return $self->{found};
}
sub find_md5 {
my $self = shift;
- my ($md5, $opts) = @_;
- $opts ||= {};
- foreach my $idx ( 0 .. $self->engine->max_buckets - 1 ) {
- my $potential = $self->engine->storage->read_at(
- $self->offset + $self->base_size + $idx * $self->bucket_size, $self->engine->hash_size,
- );
+ $self->{found} = undef;
+ $self->{idx} = -1;
- return (undef, $idx) if $potential eq $self->engine->blank_md5;
- if ( $md5 eq $potential ) {
- my $location = $self->get_data_location_for(
- $self->engine->trans_id, $idx, $opts,
- );
+ # If we don't have an MD5, then what are we supposed to do?
+ unless ( exists $self->{key_md5} ) {
+ DBM::Deep->throw( "Cannot find_md5 without a key_md5 set" );
+ }
- if ( $location > 1 ) {
- return (1, $idx);
- }
+ my $e = $self->engine;
+ foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
+ my $potential = $e->storage->read_at(
+ $self->offset + $self->base_size + $idx * $self->bucket_size, $e->hash_size,
+ );
+
+ if ( $potential eq $e->blank_md5 ) {
+ $self->{idx} = $idx;
+ return;
+ }
- return (undef, $idx);
+ if ( $potential eq $self->{key_md5} ) {
+ $self->{found} = 1;
+ $self->{idx} = $idx;
+ return;
}
}
sub write_md5 {
my $self = shift;
- my ($md5, $key, $value_loc) = @_;
+ my ($args) = @_;
+ $args ||= {};
+
+ $args->{trans_id} = $self->engine->trans_id unless exists $args->{trans_id};
my $engine = $self->engine;
- my ($found, $idx) = $self->find_md5( $md5, { allow_head => 0 } );
- my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
+ my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
- unless ($found) {
+ unless ($self->{found}) {
my $key_sector = DBM::Deep::Engine::Sector::Scalar->new({
engine => $self->engine,
- data => $key,
+ data => $args->{key},
});
$engine->storage->print_at( $spot,
- $md5,
+ $args->{key_md5},
pack( $StP{$self->engine->byte_size}, $key_sector->offset ),
);
}
$engine->storage->print_at(
$spot
+ + $engine->hash_size
+ + $engine->byte_size
+ + $args->{trans_id} * $engine->byte_size,
+ pack( $StP{$engine->byte_size}, $args->{value}->offset ),
+ );
+}
+
+sub mark_deleted {
+ my $self = shift;
+ my ($args) = @_;
+
+ my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
+ $self->engine->storage->print_at(
+ $spot
+ $self->engine->hash_size
+ $self->engine->byte_size
- + $self->engine->trans_id * $self->engine->byte_size,
- pack( $StP{$engine->byte_size}, $value_loc ), # The pointer to the data in the HEAD
+ + $args->{trans_id} * $self->engine->byte_size,
+ pack( $StP{$self->engine->byte_size}, 1 ), # 1 is the marker for deleted
);
}
sub delete_md5 {
my $self = shift;
- my ($md5) = @_;
+ my ($args) = @_;
my $engine = $self->engine;
- my ($found, $idx) = $self->find_md5( $md5, { allow_head => 0 } );
- return undef unless $found;
+ return undef unless $self->{found};
# Save the location so that we can free the data
- my $location = $self->get_data_location_for( $self->engine->trans_id, $idx, { allow_head => 0 } );
- my $key_sector = $self->get_key_for( $idx );
+ my $location = $self->get_data_location_for({
+ allow_head => 0,
+ });
+ my $key_sector = $self->get_key_for;
- my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
+ my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
$engine->storage->print_at( $spot,
$engine->storage->read_at(
$spot + $self->bucket_size,
- $self->bucket_size * ( $engine->num_txns - $idx - 1 ),
+ $self->bucket_size * ( $engine->num_txns - $self->{idx} - 1 ),
),
chr(0) x $self->bucket_size,
);
sub get_data_location_for {
my $self = shift;
- my ($trans_id, $idx, $opts) = @_;
- $opts ||= {};
+ my ($args) = @_;
+ $args ||= {};
+
+ $args->{allow_head} = 0 unless exists $args->{allow_head};
+ $args->{trans_id} = $self->engine->trans_id unless exists $args->{trans_id};
+ $args->{idx} = $self->{idx} unless exists $args->{idx};
my $location = $self->engine->storage->read_at(
$self->offset + $self->base_size
- + $idx * $self->bucket_size
+ + $args->{idx} * $self->bucket_size
+ $self->engine->hash_size
+ $self->engine->byte_size
- + $trans_id * $self->engine->byte_size,
+ + $args->{trans_id} * $self->engine->byte_size,
$self->engine->byte_size,
);
my $loc = unpack( $StP{$self->engine->byte_size}, $location );
# If we're in a transaction and we never wrote to this location, try the
# HEAD instead.
- if ( $trans_id && !$loc && $opts->{allow_head} ) {
- return $self->get_data_location_for( 0, $idx );
+ if ( $args->{trans_id} && !$loc && $args->{allow_head} ) {
+ return $self->get_data_location_for({
+ trans_id => 0,
+ allow_head => 1,
+ });
}
- return $loc;
+ return $loc <= 1 ? 0 : $loc;
}
sub get_data_for {
my $self = shift;
- my ($md5, $opts) = @_;
- $opts ||= {};
+ my ($args) = @_;
+ $args ||= {};
- my ($found, $idx) = $self->find_md5( $md5, $opts );
- return unless $found;
- my $location = $self->get_data_location_for( $self->engine->trans_id, $idx, $opts );
+ return unless $self->{found};
+ my $location = $self->get_data_location_for({
+ allow_head => $args->{allow_head},
+ });
return $self->engine->_load_sector( $location );
}
sub get_key_for {
my $self = shift;
my ($idx) = @_;
+ $idx = $self->{idx} unless defined $idx;
my $location = $self->engine->storage->read_at(
$self->offset + $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size,
projects / dbsrgits/DBM-Deep.git / commitdiff