sub SIG_DATA () { 'D' }
sub SIG_INDEX () { 'I' }
sub SIG_BLIST () { 'B' }
+sub SIG_FREE () { 'F' }
sub SIG_SIZE () { 1 }
sub precalc_sizes {
my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
+# $self->_release_space( $obj, $size, $subloc );
# Updating a known md5
+#XXX This needs updating to use _release_space
if ( $subloc ) {
$result = 1;
print( $fh pack($self->{long_pack}, $actual_length ) );
}
# If bucket didn't fit into list, split into a new index level
+ # split_index() will do the _request_space() call
else {
-#XXX This is going to be a problem.
- $self->split_index( $obj, $md5, $tag );
-
- $location = $self->_request_space( $obj, $actual_length );
+ $location = $self->split_index( $obj, $md5, $tag );
}
$self->write_value( $obj, $location, $plain_key, $value );
$value->isa( 'DBM::Deep' );
};
- my $internal_ref = $is_dbm_deep && ($value->_root eq $root);
+ my $is_internal_ref = $is_dbm_deep && ($value->_root eq $root);
seek($fh, $location + $root->{file_offset}, SEEK_SET);
# actual value.
##
my $r = Scalar::Util::reftype($value) || '';
- if ( $internal_ref ) {
+ if ( $is_internal_ref ) {
$self->write_tag( $obj, undef, SIG_INTERNAL,pack($self->{long_pack}, $value->_base_offset) );
}
elsif ($r eq 'HASH') {
print( $fh pack($self->{data_pack}, length($key)) . $key );
# Internal references don't care about autobless
- return 1 if $internal_ref;
+ return 1 if $is_internal_ref;
##
# If value is blessed, preserve class name
# If content is a hash or array, create new child DBM::Deep object and
# pass each key or element to it.
##
- if ( !$internal_ref ) {
+ if ( !$is_internal_ref ) {
if ($r eq 'HASH') {
my $branch = DBM::Deep->new(
type => DBM::Deep->TYPE_HASH,
my $fh = $obj->_fh;
my $root = $obj->_root;
- my $keys = $tag->{content};
-
- seek($fh, $tag->{ref_loc} + $root->{file_offset}, SEEK_SET);
my $loc = $self->_request_space(
$obj, $self->tag_size( $self->{index_size} ),
);
+ seek($fh, $tag->{ref_loc} + $root->{file_offset}, SEEK_SET);
print( $fh pack($self->{long_pack}, $loc) );
my $index_tag = $self->write_tag(
chr(0)x$self->{index_size},
);
- my @offsets = ();
+ my $newtag_loc = $self->_request_space(
+ $obj, $self->tag_size( $self->{bucket_list_size} ),
+ );
- $keys .= $md5 . (pack($self->{long_pack}, 0) x 2);
+ my $keys = $tag->{content}
+ . $md5 . pack($self->{long_pack}, $newtag_loc)
+ . pack($self->{long_pack}, 0);
+ my @newloc = ();
BUCKET:
for (my $i = 0; $i <= $self->{max_buckets}; $i++) {
my ($key, $old_subloc, $size) = $self->_get_key_subloc( $keys, $i );
- next BUCKET unless $key;
+ die "[INTERNAL ERROR]: No key in split_index()\n" unless $key;
+ die "[INTERNAL ERROR]: No subloc in split_index()\n" unless $old_subloc;
my $num = ord(substr($key, $tag->{ch} + 1, 1));
- if ($offsets[$num]) {
- my $offset = $offsets[$num] + SIG_SIZE + $self->{data_size};
- seek($fh, $offset + $root->{file_offset}, SEEK_SET);
+ if ($newloc[$num]) {
+ seek($fh, $newloc[$num] + $root->{file_offset}, SEEK_SET);
my $subkeys;
read( $fh, $subkeys, $self->{bucket_list_size});
- for (my $k=0; $k<$self->{max_buckets}; $k++) {
- my ($temp, $subloc) = $self->_get_key_subloc( $subkeys, $k );
+ # This is looking for the first empty spot
+ my ($subloc, $offset, $size) = $self->_find_in_buckets(
+ { content => $subkeys }, '',
+ );
+
+ seek($fh, $newloc[$num] + $offset + $root->{file_offset}, SEEK_SET);
+ print( $fh $key . pack($self->{long_pack}, $old_subloc) );
- if (!$subloc) {
- seek($fh, $offset + ($k * $self->{bucket_size}) + $root->{file_offset}, SEEK_SET);
- print( $fh $key . pack($self->{long_pack}, $old_subloc || $root->{end}) );
- last;
- }
- } # k loop
+ next;
}
- else {
- $offsets[$num] = $root->{end};
- seek($fh, $index_tag->{offset} + ($num * $self->{long_size}) + $root->{file_offset}, SEEK_SET);
- my $loc = $self->_request_space(
- $obj, $self->tag_size( $self->{bucket_list_size} ),
- );
+ seek($fh, $index_tag->{offset} + ($num * $self->{long_size}) + $root->{file_offset}, SEEK_SET);
- print( $fh pack($self->{long_pack}, $loc) );
+ my $loc = $self->_request_space(
+ $obj, $self->tag_size( $self->{bucket_list_size} ),
+ );
- my $blist_tag = $self->write_tag(
- $obj, $loc, SIG_BLIST,
- chr(0)x$self->{bucket_list_size},
- );
+ print( $fh pack($self->{long_pack}, $loc) );
- seek($fh, $blist_tag->{offset} + $root->{file_offset}, SEEK_SET);
- print( $fh $key . pack($self->{long_pack}, $old_subloc || $root->{end}) );
- }
- } # i loop
+ my $blist_tag = $self->write_tag(
+ $obj, $loc, SIG_BLIST,
+ chr(0)x$self->{bucket_list_size},
+ );
- return;
+ seek($fh, $blist_tag->{offset} + $root->{file_offset}, SEEK_SET);
+ print( $fh $key . pack($self->{long_pack}, $old_subloc) );
+
+ $newloc[$num] = $blist_tag->{offset};
+ }
+
+ $self->_release_space(
+ $obj, $self->tag_size( $self->{bucket_list_size} ),
+ $tag->{offset} - SIG_SIZE - $self->{data_size},
+ );
+
+ return $newtag_loc;
}
sub read_from_loc {
my ($obj, $tag, $md5) = @_;
my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
+#XXX This needs _release_space()
if ( $subloc ) {
my $fh = $obj->_fh;
seek($fh, $tag->{offset} + $offset + $obj->_root->{file_offset}, SEEK_SET);
if (!$tag) {
return if !$args->{create};
- my $fh = $obj->_fh;
- seek($fh, $ref_loc + $obj->_root->{file_offset}, SEEK_SET);
-
my $loc = $self->_request_space(
$obj, $self->tag_size( $self->{bucket_list_size} ),
);
+ my $fh = $obj->_fh;
+ seek($fh, $ref_loc + $obj->_root->{file_offset}, SEEK_SET);
print( $fh pack($self->{long_pack}, $loc) );
$tag = $self->write_tag(
return;
}
+#sub _print_at {
+# my $self = shift;
+# my ($obj, $spot, $data) = @_;
+#
+# my $fh = $obj->_fh;
+# seek( $fh, $spot, SEEK_SET );
+# print( $fh $data );
+#
+# return;
+#}
+
sub _request_space {
my $self = shift;
my ($obj, $size) = @_;
my $self = shift;
my ($obj, $size, $loc) = @_;
+ my $next_loc = 0;
+
+ my $fh = $obj->_fh;
+ seek( $fh, $loc + $obj->_root->{file_offset}, SEEK_SET );
+ print( $fh SIG_FREE
+ . pack($self->{long_pack}, $size )
+ . pack($self->{long_pack}, $next_loc )
+ );
+
return;
}