die "Attempt to use a deleted value" if $_is_del;
die "Internal error!" if !$_val_offset;
- my ($key_offset) = $self->_find_key_offset({
+ my ($key_tag) = $self->_find_key_offset({
offset => $_val_offset,
key_md5 => $self->_apply_digest( $key ),
});
- return if !$key_offset;
+ return if !$key_tag;
my ($val_offset, $is_del) = $self->_find_value_offset({
- offset => $key_offset,
+ offset => $key_tag->{start},
trans_id => $trans_id,
allow_head => 1,
});
die "Internal error!" if !$val_offset;
return $self->_read_value({
+ keyloc => $key_tag->{start},
offset => $val_offset,
+ key => $key,
});
}
die "Attempt to use a deleted value" if $_is_del;
die "Internal error!" if !$_val_offset;
- my ($key_offset) = $self->_find_key_offset({
+ my ($key_tag) = $self->_find_key_offset({
offset => $_val_offset,
key_md5 => $self->_apply_digest( $key ),
});
- return if !$key_offset;
+ return '' if !$key_tag->{start};
my ($val_offset, $is_del) = $self->_find_value_offset({
- offset => $key_offset,
+ offset => $key_tag->{start},
trans_id => $trans_id,
allow_head => 1,
});
+ die "Internal error!" if !$_val_offset;
- return 1 if $is_del;
+ return '' if $is_del;
- die "Internal error!" if !$_val_offset;
- return '';
+ return 1;
}
sub get_next_key {
my $self = shift;
- my ($offset) = @_;
+ my ($trans_id, $base_offset) = @_;
+
+ my ($_val_offset, $_is_del) = $self->_find_value_offset({
+ offset => $base_offset,
+ trans_id => $trans_id,
+ allow_head => 1,
+ });
+ die "Attempt to use a deleted value" if $_is_del;
+ die "Internal error!" if !$_val_offset;
# If the previous key was not specifed, start at the top and
# return the first one found.
my $temp;
- if ( @_ > 1 ) {
+ if ( @_ > 2 ) {
$temp = {
- prev_md5 => $self->apply_digest($_[1]),
+ prev_md5 => $self->_apply_digest($_[2]),
return_next => 0,
};
}
};
}
- return $self->traverse_index( $temp, $offset, 0 );
+ local $::DEBUG = 1;
+ print "get_next_key: $_val_offset\n" if $::DEBUG;
+ return $self->traverse_index( $temp, $_val_offset, 0 );
}
sub delete_key {
die "Attempt to use a deleted value" if $_is_del;
die "Internal error!" if !$_val_offset;
- my ($key_offset, $bucket_tag) = $self->_find_key_offset({
+ my ($key_tag, $bucket_tag) = $self->_find_key_offset({
offset => $_val_offset,
key_md5 => $self->_apply_digest( $key ),
});
- return if !$key_offset;
-
- my $key_tag = $self->load_tag( $key_offset );
+ return if !$key_tag->{start};
+ my $value = $self->read_value( $trans_id, $base_offset, $key );
if ( $trans_id ) {
$self->_mark_as_deleted({
tag => $key_tag,
});
}
else {
- my $value = $self->read_value( $trans_id, $base_offset, $key );
if ( my @transactions = $self->_storage->current_transactions ) {
foreach my $other_trans_id ( @transactions ) {
next if $self->_has_keyloc_entry({
$self->write_value( $other_trans_id, $base_offset, $key, $value );
}
}
- else {
- $self->_remove_key_offset({
- offset => $_val_offset,
- key_md5 => $self->_apply_digest( $key ),
- });
- }
+
+ $self->_mark_as_deleted({
+ tag => $key_tag,
+ trans_id => $trans_id,
+ });
+# $self->_remove_key_offset({
+# offset => $_val_offset,
+# key_md5 => $self->_apply_digest( $key ),
+# });
}
- return 1;
+ return $value;
}
sub write_value {
die "Attempt to use a deleted value" if $_is_del;
die "Internal error!" if !$_val_offset;
- my ($key_offset, $bucket_tag) = $self->_find_key_offset({
+ my ($key_tag, $bucket_tag) = $self->_find_key_offset({
offset => $_val_offset,
key_md5 => $self->_apply_digest( $key ),
create => 1,
});
- die "Cannot find/create new key offset!" if !$key_offset;
-
- my $key_tag = $self->load_tag( $key_offset );
+ die "Cannot find/create new key offset!" if !$key_tag->{start};
if ( $trans_id ) {
- if ( $bucket_tag->{is_new} ) {
+ if ( $key_tag->{is_new} ) {
# Must mark the HEAD as deleted because it doesn't exist
$self->_mark_as_deleted({
tag => $key_tag,
else {
# If the HEAD isn't new, then we must take other transactions
# into account. If it is, then there can be no other transactions.
- if ( !$bucket_tag->{is_new} ) {
+ if ( !$key_tag->{is_new} ) {
my $old_value = $self->read_value( $trans_id, $base_offset, $key );
if ( my @transactions = $self->_storage->current_transactions ) {
foreach my $other_trans_id ( @transactions ) {
}
}
- #XXX Write this
- $self->_write_value({
- tag => $key_tag,
- value => $value,
+ my $value_loc = $self->_storage->request_space(
+ $self->_length_needed( $value, $key ),
+ );
+
+ $self->_add_key_offset({
+ tag => $key_tag,
+ trans_id => $trans_id,
+ loc => $value_loc,
});
+ $self->_write_value( $key_tag->{start}, $value_loc, $key, $value, $key );
+
return 1;
}
return;
}
-#XXX Need to keep track of $bucket_tag->(ref_loc} and $bucket_tag->{ch}
sub _find_key_offset {
my $self = shift;
my ($args) = @_;
my $bucket_tag = $self->load_tag( $args->{offset} )
or $self->_throw_error( "INTERNAL ERROR - Cannot find tag" );
- # $bucket_tag->{ref_loc} and $bucket_tag->{ch} are used in split_index()
-
#XXX What happens when $ch >= $self->{hash_size} ??
for (my $ch = 0; $bucket_tag->{signature} ne SIG_BLIST; $ch++) {
my $num = ord substr($args->{key_md5}, $ch, 1);
$self->_storage->print_at( $bucket_tag->{offset}, $bucket_tag->{content} );
- $self->write_tag(
+ my $key_tag = $self->write_tag(
$keytag_loc, SIG_KEYS,
chr(0)x$self->{keyloc_size},
);
- return( $keytag_loc, $bucket_tag );
+ return( $key_tag, $bucket_tag );
}
else {
+ my ($key, $subloc, $index);
BUCKET:
for ( my $i = 0; $i < $self->{max_buckets}; $i++ ) {
- my ($key, $subloc) = $self->_get_key_subloc(
+ ($key, $subloc) = $self->_get_key_subloc(
$bucket_tag->{content}, $i,
);
next BUCKET if $subloc && $key ne $args->{key_md5};
- #XXX Right here, I need to create a new value, if I can
- return( $subloc, $bucket_tag );
+
+ # Keep track of where we are, in case we need to create a new
+ # entry.
+ $index = $i;
+ last;
+ }
+
+ # If we have a subloc to return or we don't want to create a new
+ # entry, we need to return now.
+ $args->{create} ||= 0;
+ return ($self->load_tag( $subloc ), $bucket_tag) if $subloc || !$args->{create};
+
+ my $keytag_loc = $self->_storage->request_space(
+ $self->tag_size( $self->{keyloc_size} ),
+ );
+
+ # There's space left in this bucket
+ if ( defined $index ) {
+ substr( $bucket_tag->{content}, $index * $self->{key_size}, $self->{key_size} ) =
+ $args->{key_md5} . pack( "$self->{long_pack}", $keytag_loc );
+
+ $self->_storage->print_at( $bucket_tag->{offset}, $bucket_tag->{content} );
}
- # Right here, it looks like split_index needs to happen
- # What happens here?
+ # We need to split the index
+ else {
+ $self->split_index( $bucket_tag, $args->{key_md5}, $keytag_loc );
+ }
+
+ my $key_tag = $self->write_tag(
+ $keytag_loc, SIG_KEYS,
+ chr(0)x$self->{keyloc_size},
+ );
+
+ return( $key_tag, $bucket_tag );
}
return;
my $self = shift;
my ($args) = @_;
- return $self->read_from_loc( $args->{offset} );
+ return $self->read_from_loc( $args->{keyloc}, $args->{offset}, $args->{key} );
}
sub _mark_as_deleted {
substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ),
);
+ last unless $loc || $is_deleted;
if ( $trans_id == $args->{trans_id} ) {
substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ) = pack(
"$self->{long_pack} C C",
$loc, $trans_id, 1,
- )
+ );
+ $is_changed = 1;
+ last;
}
}
return 1;
}
-sub _write_value {
+sub _add_key_offset {
my $self = shift;
my ($args) = @_;
+ my $is_changed;
+ for ( my $i = 0; $i < $self->{max_buckets}; $i++ ) {
+ my ($loc, $trans_id, $is_deleted) = unpack(
+ "$self->{long_pack} C C",
+ substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ),
+ );
+ if ( $trans_id == $args->{trans_id} || (!$loc && !$is_deleted) ) {
+ substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ) = pack(
+ "$self->{long_pack} C C",
+ $args->{loc}, $args->{trans_id}, 0,
+ );
+ $is_changed = 1;
+ last;
+ }
+ }
+
+ if ( $is_changed ) {
+ $self->_storage->print_at(
+ $args->{tag}{offset}, $args->{tag}{content},
+ );
+ }
+ else {
+ die "Why didn't _add_key_offset() change something?!\n";
+ }
+
+ return 1;
}
sub setup_fh {
$self->write_tag(
$obj->{base_offset}, SIG_KEYS,
- pack( "$self->{long_pack} C C", $obj->{base_offset}, 0, 0 ),
- chr(0) x ($self->{index_size} - $self->{long_size} + 2),
+ pack( "$self->{long_pack} C C", $value_spot, HEAD, 0 ),
+ chr(0) x ($self->{index_size} - $self->{key_size}),
);
$self->write_tag(
else {
$obj->{base_offset} = $bytes_read;
+ my ($_val_offset, $_is_del) = $self->_find_value_offset({
+ offset => $obj->{base_offset},
+ trans_id => HEAD,
+ allow_head => 1,
+ });
+ die "Attempt to use a deleted value" if $_is_del;
+ die "Internal error!" if !$_val_offset;
+
##
# Get our type from master index header
##
- my $tag = $self->load_tag($obj->_base_offset);
+ my $tag = $self->load_tag($_val_offset);
unless ( $tag ) {
flock $fh, LOCK_UN;
$self->_throw_error("Corrupted file, no master index record");
projects / dbsrgits/DBM-Deep.git / blobdiff