$self->{digest} = \&Digest::MD5::md5;
}
+ #XXX HACK
+ $self->{chains_loc} = 15;
+
return $self;
}
my $self = shift;
my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
- my $header_var = 1 + 1;
+ my $header_var = 1 + 1 + 2 * $self->byte_size;
my $loc = $self->storage->request_space( $header_fixed + $header_var );
# --- Above is $header_fixed. Below is $header_var
pack('C', $self->byte_size),
pack('C', $self->max_buckets),
+ pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
+ pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
);
- $self->storage->set_transaction_offset( 13 );
+ $self->set_chains_loc( $header_fixed + 2 );
+
+# $self->storage->set_transaction_offset( $header_fixed );
return;
}
my $self = shift;
my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
- my $header_var = 1 + 1;
my $buffer = $self->storage->read_at( 0, $header_fixed );
return unless length($buffer);
DBM::Deep->_throw_error( "Old file version found." );
}
- unless ( $size eq $header_var ) {
- $self->storage->close;
- DBM::Deep->_throw_error( "Unexpected size found." );
- }
-
my $buffer2 = $self->storage->read_at( undef, $size );
my @values = unpack( 'C C', $buffer2 );
+ $self->set_chains_loc( $header_fixed + 2 );
+
# The transaction offset is the first thing after the fixed header section
- $self->storage->set_transaction_offset( $header_fixed );
+ #$self->storage->set_transaction_offset( $header_fixed );
if ( @values < 2 || grep { !defined } @values ) {
$self->storage->close;
#XXX Add warnings if values weren't set right
@{$self}{qw(byte_size max_buckets)} = @values;
+ my $header_var = 1 + 1 + 2 * $self->byte_size;
+ unless ( $size eq $header_var ) {
+ $self->storage->close;
+ DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
+ }
+
return length($buffer) + length($buffer2);
}
my ($offset) = @_;
my $type = $self->storage->read_at( $offset, 1 );
+ return if $type eq chr(0);
+
if ( $type eq $self->SIG_ARRAY || $type eq $self->SIG_HASH ) {
return DBM::Deep::Engine::Sector::Reference->new({
engine => $self,
offset => $offset,
});
}
+ # This was deleted from under us, so just return and let the caller figure it out.
+ elsif ( $type eq $self->SIG_FREE ) {
+ return;
+ }
die "'$offset': Don't know what to do with type '$type'\n";
}
sub _add_free_sector {
my $self = shift;
my ($offset, $size) = @_;
+
+ my $chains_offset;
+ # Data sector
+ if ( $size == 256 ) {
+ $chains_offset = $self->byte_size;
+ }
+ # Blist sector
+ else {
+ $chains_offset = 0;
+ }
+
+ my $old_head = $self->storage->read_at( $self->chains_loc + $chains_offset, $self->byte_size );
+
+ $self->storage->print_at( $self->chains_loc + $offset,
+ pack( $StP{$self->byte_size}, $offset ),
+ );
+
+ # Record the old head in the new sector after the signature
+ $self->storage->print_at( $offset + 1, $old_head );
+}
+
+sub _request_sector {
+ my $self = shift;
+ my ($size) = @_;
+
+ my $chains_offset;
+ # Data sector
+ if ( $size == 256 ) {
+ $chains_offset = $self->byte_size;
+ }
+ # Blist sector
+ else {
+ $chains_offset = 0;
+ }
+
+ my $old_head = $self->storage->read_at( $self->chains_loc + $chains_offset, $self->byte_size );
+ my $loc = unpack( $StP{$self->byte_size}, $old_head );
+
+ # We don't have any free sectors of the right size, so allocate a new one.
+ unless ( $loc ) {
+ return $self->storage->request_space( $size );
+ }
+
+ my $new_head = $self->storage->read_at( $loc + 1, $self->byte_size );
+ $self->storage->print_at( $self->chains_loc + $chains_offset, $new_head );
+
+ return $loc;
}
################################################################################
sub iterator { $_[0]{iterator} }
sub blank_md5 { chr(0) x $_[0]->hash_size }
+sub chains_loc { $_[0]{chains_loc} }
+sub set_chains_loc { $_[0]{chains_loc} = $_[1] }
+
################################################################################
package DBM::Deep::Engine::Iterator;
unless ( @$crumbs ) {
# This will be a Reference sector
my $sector = $self->{engine}->_load_sector( $self->{base_offset} )
- or die "Iterator: How did this fail (no sector for '$self->{base_offset}')?!\n";
+ # or die "Iterator: How did this fail (no ref sector for '$self->{base_offset}')?!\n";
+ # If no sector is found, thist must have been deleted from under us.
+ or return;
push @$crumbs, [ $sector->get_blist_loc, 0 ];
}
}
my $sector = $self->{engine}->_load_sector( $offset )
- or die "Iterator: How did this fail (no sector for '$offset')?!\n";
+ or die "Iterator: How did this fail (no blist sector for '$offset')?!\n";
my $key_sector = $sector->get_key_for( $idx );
unless ( $key_sector ) {
sub free {
my $self = shift;
- return;
+ $self->engine->storage->print_at( $self->offset,
+ $self->engine->SIG_FREE,
+ chr(0) x ($self->size - 1),
+ );
+
$self->engine->_add_free_sector(
$self->offset, $self->size,
);
- $self->engine->storage->print_at( $self->offset,
- chr(0) x $self->size,
- );
+ return;
}
package DBM::Deep::Engine::Sector::Data;
#XXX This assumes that length($data) > $leftover
$leftover -= length( $data );
- $self->{offset} = $engine->storage->request_space( $self->size );
+ $self->{offset} = $engine->_request_sector( $self->size );
$engine->storage->print_at( $self->offset,
$self->type, # Sector type
pack( $StP{1}, 0 ), # Recycled counter
unless ( $self->offset ) {
my $leftover = $self->size - 3 - 1 * $engine->byte_size;
- $self->{offset} = $engine->storage->request_space( $self->size );
+ $self->{offset} = $engine->_request_sector( $self->size );
$engine->storage->print_at( $self->offset,
$self->type, # Sector type
pack( $StP{1}, 0 ), # Recycled counter
unless ( $self->offset ) {
my $leftover = $self->size - 4 - 2 * $engine->byte_size;
- $self->{offset} = $engine->storage->request_space( $self->size );
+ $self->{offset} = $engine->_request_sector( $self->size );
$engine->storage->print_at( $self->offset,
$self->type, # Sector type
pack( $StP{1}, 0 ), # Recycled counter
unless ( $self->offset ) {
my $leftover = $self->size - $self->base_size;
- $self->{offset} = $engine->storage->request_space( $self->size );
+ $self->{offset} = $engine->_request_sector( $self->size );
$engine->storage->print_at( $self->offset,
$engine->SIG_BLIST, # Sector type
pack( $StP{1}, 0 ), # Recycled counter
+++ /dev/null
-package TestSimpleHash;
-
-use 5.6.0;
-
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-
-use base 'TestBase';
-
-sub A_assignment : Test( 23 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my @keys = keys %{$self->{data}};
-
- push @keys, $keys[0] while @keys < 3;
-
- cmp_ok( keys %$db, '==', 0 );
-
- foreach my $k ( @keys[0..2] ) {
- ok( !exists $db->{$k} );
- ok( !$db->exists( $k ) );
- }
-
- $db->{$keys[0]} = $self->{data}{$keys[0]};
- $db->put( $keys[1] => $self->{data}{$keys[1]} );
- $db->store( $keys[2] => $self->{data}{$keys[2]} );
-
- foreach my $k ( @keys[0..2] ) {
- ok( $db->exists( $k ) );
- ok( exists $db->{$k} );
-
- is( $db->{$k}, $self->{data}{$k} );
- is( $db->get($k), $self->{data}{$k} );
- is( $db->fetch($k), $self->{data}{$k} );
- }
-
- if ( @keys > 3 ) {
- $db->{$_} = $self->{data}{$_} for @keys[3..$#keys];
- }
-
- cmp_ok( keys %$db, '==', @keys );
-}
-
-sub B_check_keys : Test( 1 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my @control = sort keys %{$self->{data}};
- my @test1 = sort keys %$db;
- is_deeply( \@test1, \@control );
-}
-
-sub C_each : Test( 1 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my $temp = {};
- while ( my ($k,$v) = each %$db ) {
- $temp->{$k} = $v;
- }
-
- is_deeply( $temp, $self->{data} );
-}
-
-sub D_firstkey : Test( 1 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my $temp = {};
-
- my $key = $db->first_key;
- while ( $key ) {
- $temp->{$key} = $db->get( $key );
- $key = $db->next_key( $key );
- }
-
- is_deeply( $temp, $self->{data} );
-}
-
-sub E_delete : Test( 12 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my @keys = keys %{$self->{data}};
- cmp_ok( keys %$db, '==', @keys );
-
- my $key1 = $keys[0];
- ok( exists $db->{$key1} );
- is( $db->{$key1}, $self->{data}{$key1} );
- is( delete $db->{$key1}, $self->{data}{$key1} );
- ok( !exists $db->{$key1} );
- cmp_ok( keys %$db, '==', @keys - 1 );
-
- my $key2 = $keys[1];
- ok( exists $db->{$key2} );
- is( $db->{$key2}, $self->{data}{$key2} );
- is( $db->delete( $key2 ), $self->{data}{$key2} );
- ok( !exists $db->{$key2} );
- cmp_ok( keys %$db, '==', @keys - 2 );
-
- @{$db}{ @keys[0,1] } = @{$self->{data}}{@keys[0,1]};
-
- cmp_ok( keys %$db, '==', @keys );
-}
-
-sub F_clear : Test( 3 ) {
- my $self = shift;
- my $db = $self->{db};
-
- my @keys = keys %{$self->{data}};
- cmp_ok( keys %$db, '==', @keys );
-
- %$db = ();
-
- cmp_ok( keys %$db, '==', 0 );
-
- %$db = %{$self->{data}};
- cmp_ok( keys %$db, '==', @keys );
-}
-
-sub G_reassign_and_close : Test( 4 ) {
- my $self = shift;
-
- my @keys = keys %{$self->{data}};
-
- my $key1 = $keys[0];
-
- my $long_value = 'long value' x 100;
- $self->{db}{$key1} = $long_value;
- is( $self->{db}{$key1}, $long_value );
-
- my $filename = $self->{db}->_root->{file};
- undef $self->{db};
-
- $self->{db} = DBM::Deep->new( $filename );
-
- is( $self->{db}{$key1}, $long_value );
-
- $self->{db}{$key1} = $self->{data}{$key1};
- is( $self->{db}{$key1}, $self->{data}{$key1} );
-
- cmp_ok( keys %{$self->{db}}, '==', @keys );
-}
-
-1;
-__END__
projects / dbsrgits/DBM-Deep.git / commitdiff