$args->{type} = $class->TYPE_ARRAY;
- return $class->_init($args);
+ my $self = $class->_init($args);
+
+# $self->STORESIZE;
+
+ return $self;
}
sub FETCH {
my $self = shift->_get_self;
my ($key) = @_;
+ warn "ARRAY:FETCH( $key )\n" if DBM::Deep::DEBUG;
$self->lock_shared;
sub STORE {
my $self = shift->_get_self;
my ($key, $value) = @_;
+ warn "ARRAY::STORE($self, $key)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
sub EXISTS {
my $self = shift->_get_self;
my ($key) = @_;
+ warn "ARRAY::EXISTS($self, $key)\n" if DBM::Deep::DEBUG;
$self->lock_shared;
# going to work.
sub FETCHSIZE {
my $self = shift->_get_self;
+ warn "ARRAY::FETCHSIZE($self)\n" if DBM::Deep::DEBUG;
$self->lock_shared;
my $SAVE_FILTER = $self->_engine->storage->{filter_fetch_value};
$self->_engine->storage->{filter_fetch_value} = undef;
+ # If there is no flushing, then things get out of sync.
+# warn "FETCHSIZE BEG: " . $self->_engine->_dump_file;
my $size = $self->FETCH('length') || 0;
+# warn "FETCHSIZE AFT: " . $self->_engine->_dump_file;
$self->_engine->storage->{filter_fetch_value} = $SAVE_FILTER;
$self->unlock;
+# warn "FETCHSIZE END: " . $self->_engine->_dump_file;
+
return $size;
}
sub STORESIZE {
my $self = shift->_get_self;
my ($new_length) = @_;
+ warn "ARRAY::STORESIZE($self, $new_length)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
sub POP {
my $self = shift->_get_self;
+ warn "ARRAY::POP($self)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
sub PUSH {
my $self = shift->_get_self;
+ warn "ARRAY::PUSH($self)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
sub SHIFT {
my $self = shift->_get_self;
- warn "SHIFT($self)\n" if DBM::Deep::DEBUG;
+ warn "ARRAY::SHIFT($self)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
sub UNSHIFT {
my $self = shift->_get_self;
+ warn "ARRAY::UNSHIFT($self)\n" if DBM::Deep::DEBUG;
my @new_elements = @_;
$self->lock_exclusive;
$self->_move_value( $i, $i+$new_size );
}
+# warn "BEFORE: " . $self->_dump_file;
$self->STORESIZE( $length + $new_size );
}
+# $self->_engine->flush;
for (my $i = 0; $i < $new_size; $i++) {
$self->STORE( $i, $new_elements[$i] );
}
+ warn "AFTER : " . $self->_dump_file;
$self->unlock;
sub SPLICE {
my $self = shift->_get_self;
+ warn "ARRAY::SPLICE($self)\n" if DBM::Deep::DEBUG;
$self->lock_exclusive;
# We don't need to populate it, yet.
# It will be useful, though, when we split out HASH and ARRAY
sub EXTEND {
+ warn "ARRAY::EXTEND()\n" if DBM::Deep::DEBUG;
##
# Perl will call EXTEND() when the array is likely to grow.
# We don't care, but include it because it gets called at times.
use strict;
use warnings FATAL => 'all';
-use DBM::Deep::Engine::Sector::BucketList;
-use DBM::Deep::Engine::Sector::Index;
-use DBM::Deep::Engine::Sector::Null;
-use DBM::Deep::Engine::Sector::Reference;
-use DBM::Deep::Engine::Sector::Scalar;
-use DBM::Deep::Iterator;
-
# Never import symbols into our namespace. We are a class, not a library.
# -RobK, 2008-05-27
use Scalar::Util ();
);
sub StP { $StP{$_[1]} }
+# Import these after the SIG_* definitions because those definitions are used
+# in the headers of these classes. -RobK, 2008-06-20
+use DBM::Deep::Engine::Sector::BucketList;
+use DBM::Deep::Engine::Sector::FileHeader;
+use DBM::Deep::Engine::Sector::Index;
+use DBM::Deep::Engine::Sector::Null;
+use DBM::Deep::Engine::Sector::Reference;
+use DBM::Deep::Engine::Sector::Scalar;
+use DBM::Deep::Iterator;
+
################################################################################
sub new {
# This will be a Reference sector
my $sector = $self->_load_sector( $obj->_base_offset )
- or DBM::Deep->_throw_error( "How did get_classname fail (no sector for '$obj')?!" );
+ or DBM::Deep->_throw_error( "How did make_reference fail (no sector for '$obj')?!" );
if ( $sector->staleness != $obj->_staleness ) {
return;
# This will be a Reference sector
my $sector = $self->_load_sector( $obj->_base_offset )
- or DBM::Deep->_throw_error( "Cannot write to a deleted spot in DBM::Deep." );
+ or DBM::Deep->_throw_error( "1: Cannot write to a deleted spot in DBM::Deep." );
if ( $sector->staleness != $obj->_staleness ) {
- DBM::Deep->_throw_error( "Cannot write to a deleted spot in DBM::Deep." );
+ DBM::Deep->_throw_error( "2: Cannot write to a deleted spot in DBM::Deep." );
}
my ($class, $type);
my $self = shift;
my ($obj) = @_;
- # We're opening the file.
- unless ( $obj->_base_offset ) {
- my $bytes_read = $self->_read_file_header;
+ return 1 if $obj->_base_offset;
- # Creating a new file
- unless ( $bytes_read ) {
- $self->_write_file_header;
+ my $header = DBM::Deep::Engine::Sector::FileHeader->new({
+ engine => $self,
+ });
- # 1) Create Array/Hash entry
- my $initial_reference = DBM::Deep::Engine::Sector::Reference->new({
- engine => $self,
- type => $obj->_type,
- });
- $obj->{base_offset} = $initial_reference->offset;
- $obj->{staleness} = $initial_reference->staleness;
+ # Creating a new file
+ if ( $header->is_new ) {
+ # 1) Create Array/Hash entry
+ my $sector = DBM::Deep::Engine::Sector::Reference->new({
+ engine => $self,
+ type => $obj->_type,
+ });
+ $obj->{base_offset} = $sector->offset;
+ $obj->{staleness} = $sector->staleness;
- $self->storage->flush;
+ $self->flush;
+ }
+ # Reading from an existing file
+ else {
+ $obj->{base_offset} = $header->size;
+ my $sector = DBM::Deep::Engine::Sector::Reference->new({
+ engine => $self,
+ offset => $obj->_base_offset,
+ });
+ unless ( $sector ) {
+ DBM::Deep->_throw_error("Corrupted file, no master index record");
}
- # Reading from an existing file
- else {
- $obj->{base_offset} = $bytes_read;
- my $initial_reference = DBM::Deep::Engine::Sector::Reference->new({
- engine => $self,
- offset => $obj->_base_offset,
- });
- unless ( $initial_reference ) {
- DBM::Deep->_throw_error("Corrupted file, no master index record");
- }
-
- unless ($obj->_type eq $initial_reference->type) {
- DBM::Deep->_throw_error("File type mismatch");
- }
- $obj->{staleness} = $initial_reference->staleness;
+ unless ($obj->_type eq $sector->type) {
+ DBM::Deep->_throw_error("File type mismatch");
}
- $self->storage->set_inode;
+ $obj->{staleness} = $sector->staleness;
}
+ $self->storage->set_inode;
+
return 1;
}
################################################################################
-{
- my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
- my $this_file_version = 3;
-
- sub _write_file_header {
- my $self = shift;
-
- my $nt = $self->num_txns;
- my $bl = $self->txn_bitfield_len;
-
- my $header_var = 1 + 1 + 1 + 1 + $bl + $STALE_SIZE * ($nt - 1) + 3 * $self->byte_size;
-
- my $loc = $self->storage->request_space( $header_fixed + $header_var );
-
- $self->storage->print_at( $loc,
- SIG_FILE,
- SIG_HEADER,
- pack('N', $this_file_version), # At this point, we're at 9 bytes
- pack('N', $header_var), # header size
- # --- Above is $header_fixed. Below is $header_var
- pack('C', $self->byte_size),
-
- # These shenanigans are to allow a 256 within a C
- pack('C', $self->max_buckets - 1),
- pack('C', $self->data_sector_size - 1),
-
- pack('C', $nt),
- pack('C' . $bl, 0 ), # Transaction activeness bitfield
- pack($StP{$STALE_SIZE}.($nt-1), 0 x ($nt-1) ), # Transaction staleness counters
- pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
- pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
- pack($StP{$self->byte_size}, 0), # Start of free chain (index size)
- );
-
- #XXX Set these less fragilely
- $self->set_trans_loc( $header_fixed + 4 );
- $self->set_chains_loc( $header_fixed + 4 + $bl + $STALE_SIZE * ($nt-1) );
-
- return;
- }
+sub _load_sector {
+ my $self = shift;
+ my ($offset) = @_;
- sub _read_file_header {
- my $self = shift;
+ # Add a catch for offset of 0 or 1
+ return if !$offset || $offset <= 1;
- my $buffer = $self->storage->read_at( 0, $header_fixed );
- return unless length($buffer);
+ unless ( exists $self->sector_cache->{ $offset } ) {
+ my $type = $self->storage->read_at( $offset, $self->SIG_SIZE );
- my ($file_signature, $sig_header, $file_version, $size) = unpack(
- 'A4 A N N', $buffer
- );
+ # XXX Don't we want to do something more proactive here? -RobK, 2008-06-19
+ return if $type eq chr(0);
- unless ( $file_signature eq SIG_FILE ) {
- $self->storage->close;
- DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
+ if ( $type eq $self->SIG_ARRAY || $type eq $self->SIG_HASH ) {
+ $self->sector_cache->{$offset} = DBM::Deep::Engine::Sector::Reference->new({
+ engine => $self,
+ type => $type,
+ offset => $offset,
+ });
}
-
- unless ( $sig_header eq SIG_HEADER ) {
- $self->storage->close;
- DBM::Deep->_throw_error( "Pre-1.00 file version found" );
+ # XXX Don't we need key_md5 here?
+ elsif ( $type eq $self->SIG_BLIST ) {
+ $self->sector_cache->{$offset} = DBM::Deep::Engine::Sector::BucketList->new({
+ engine => $self,
+ type => $type,
+ offset => $offset,
+ });
}
-
- unless ( $file_version == $this_file_version ) {
- $self->storage->close;
- DBM::Deep->_throw_error(
- "Wrong file version found - " . $file_version .
- " - expected " . $this_file_version
- );
+ elsif ( $type eq $self->SIG_INDEX ) {
+ $self->sector_cache->{$offset} = DBM::Deep::Engine::Sector::Index->new({
+ engine => $self,
+ type => $type,
+ offset => $offset,
+ });
}
-
- my $buffer2 = $self->storage->read_at( undef, $size );
- my @values = unpack( 'C C C C', $buffer2 );
-
- if ( @values != 4 || grep { !defined } @values ) {
- $self->storage->close;
- DBM::Deep->_throw_error("Corrupted file - bad header");
+ elsif ( $type eq $self->SIG_NULL ) {
+ $self->sector_cache->{$offset} = DBM::Deep::Engine::Sector::Null->new({
+ engine => $self,
+ type => $type,
+ offset => $offset,
+ });
}
-
- #XXX Add warnings if values weren't set right
- @{$self}{qw(byte_size max_buckets data_sector_size num_txns)} = @values;
-
- # These shenangians are to allow a 256 within a C
- $self->{max_buckets} += 1;
- $self->{data_sector_size} += 1;
-
- my $bl = $self->txn_bitfield_len;
-
- my $header_var = scalar(@values) + $bl + $STALE_SIZE * ($self->num_txns - 1) + 3 * $self->byte_size;
- unless ( $size == $header_var ) {
- $self->storage->close;
- DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
+ elsif ( $type eq $self->SIG_DATA ) {
+ $self->sector_cache->{$offset} = DBM::Deep::Engine::Sector::Scalar->new({
+ engine => $self,
+ type => $type,
+ 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;
+ }
+ else {
+ DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" );
}
-
- $self->set_trans_loc( $header_fixed + scalar(@values) );
- $self->set_chains_loc( $header_fixed + scalar(@values) + $bl + $STALE_SIZE * ($self->num_txns - 1) );
-
- return length($buffer) + length($buffer2);
- }
-}
-
-sub _load_sector {
- my $self = shift;
- my ($offset) = @_;
-
- # Add a catch for offset of 0 or 1
- return if !$offset || $offset <= 1;
-
- 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,
- type => $type,
- 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,
- type => $type,
- offset => $offset,
- });
- }
- elsif ( $type eq $self->SIG_INDEX ) {
- return DBM::Deep::Engine::Sector::Index->new({
- engine => $self,
- type => $type,
- offset => $offset,
- });
- }
- elsif ( $type eq $self->SIG_NULL ) {
- return DBM::Deep::Engine::Sector::Null->new({
- engine => $self,
- type => $type,
- offset => $offset,
- });
- }
- elsif ( $type eq $self->SIG_DATA ) {
- return DBM::Deep::Engine::Sector::Scalar->new({
- engine => $self,
- type => $type,
- 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;
}
- DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" );
+ return $self->sector_cache->{$offset};
}
sub _apply_digest {
################################################################################
+sub sector_cache {
+ my $self = shift;
+ return $self->{sector_cache} ||= {};
+}
+
+sub clear_sector_cache {
+ my $self = shift;
+ $self->{sector_cache} = {};
+}
+
sub dirty_sectors {
my $self = shift;
return $self->{dirty_sectors} ||= {};
}
+sub clear_dirty_sectors {
+ my $self = shift;
+ $self->{dirty_sectors} = {};
+}
+
sub add_dirty_sector {
my $self = shift;
my ($sector) = @_;
$self->dirty_sectors->{ $sector->offset } = $sector;
}
-sub clear_dirty_sectors {
- my $self = shift;
- $self->{dirty_sectors} = {};
-}
-
sub flush {
my $self = shift;
- for (values %{ $self->dirty_sectors }) {
- $_->flush;
+ my $sectors = $self->dirty_sectors;
+ for my $offset (sort { $a <=> $b } keys %{ $sectors }) {
+ $sectors->{$offset}->flush;
}
$self->clear_dirty_sectors;
+
+ $self->clear_sector_cache;
}
################################################################################
sub _dump_file {
my $self = shift;
+ $self->flush;
# Read the header
- my $spot = $self->_read_file_header();
+ my $header_sector = DBM::Deep::Engine::Sector::FileHeader->new({
+ engine => $self,
+ });
my %types = (
0 => 'B',
$return .= $/;
}
+ my $spot = $header_sector->size;
SECTOR:
while ( $spot < $self->storage->{end} ) {
# Read each sector in order.
$self->_init;
+ # Add new sectors to the sector cache.
+ $self->engine->sector_cache->{$self->offset} = $self;
+
return $self;
}
--- /dev/null
+package DBM::Deep::Engine::Sector::FileHeader;
+
+use 5.006;
+
+use strict;
+use warnings FATAL => 'all';
+
+use DBM::Deep::Engine::Sector;
+our @ISA = qw( DBM::Deep::Engine::Sector );
+
+my $header_fixed = length( &DBM::Deep::Engine::SIG_FILE ) + 1 + 4 + 4;
+my $this_file_version = 3;
+
+sub _init {
+ my $self = shift;
+
+ my $e = $self->engine;
+
+ # This means the file is being created.
+ # Use defined() here because the offset should always be 0. -RobK. 2008-06-20
+ unless ( $e->storage->size ) {
+ my $nt = $e->num_txns;
+ my $bl = $e->txn_bitfield_len;
+
+ my $header_var = $self->header_var_size;
+
+ $self->{offset} = $e->storage->request_space( $header_fixed + $header_var );
+ DBM::Deep::_throw_error( "Offset wasn't 0, it's '$self->{offset}'" ) unless $self->offset == 0;
+
+ $self->write( $self->offset,
+ $e->SIG_FILE
+ . $e->SIG_HEADER
+ . pack('N', $this_file_version) # At this point, we're at 9 bytes
+ . pack('N', $header_var) # header size
+ # --- Above is $header_fixed. Below is $header_var
+ . pack('C', $e->byte_size)
+
+ # These shenanigans are to allow a 256 within a C
+ . pack('C', $e->max_buckets - 1)
+ . pack('C', $e->data_sector_size - 1)
+
+ . pack('C', $nt)
+ . pack('C' . $bl, 0 ) # Transaction activeness bitfield
+ . pack($e->StP($DBM::Deep::Engine::STALE_SIZE).($nt-1), 0 x ($nt-1) ) # Transaction staleness counters
+ . pack($e->StP($e->byte_size), 0) # Start of free chain (blist size)
+ . pack($e->StP($e->byte_size), 0) # Start of free chain (data size)
+ . pack($e->StP($e->byte_size), 0) # Start of free chain (index size)
+ );
+
+ $e->set_trans_loc( $header_fixed + 4 );
+ $e->set_chains_loc( $header_fixed + 4 + $bl + $DBM::Deep::Engine::STALE_SIZE * ($nt-1) );
+
+ $self->{is_new} = 1;
+ }
+ else {
+ $self->{offset} = 0;
+
+ my $s = $e->storage;
+
+ my $buffer = $s->read_at( $self->offset, $header_fixed );
+ return unless length($buffer);
+
+ my ($file_signature, $sig_header, $file_version, $size) = unpack(
+ 'A4 A N N', $buffer
+ );
+
+ unless ( $file_signature eq $e->SIG_FILE ) {
+ $s->close;
+ DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
+ }
+
+ unless ( $sig_header eq $e->SIG_HEADER ) {
+ $s->close;
+ DBM::Deep->_throw_error( "Pre-1.00 file version found" );
+ }
+
+ unless ( $file_version == $this_file_version ) {
+ $s->close;
+ DBM::Deep->_throw_error(
+ "Wrong file version found - " . $file_version .
+ " - expected " . $this_file_version
+ );
+ }
+
+ my $buffer2 = $s->read_at( undef, $size );
+ my @values = unpack( 'C C C C', $buffer2 );
+
+ if ( @values != 4 || grep { !defined } @values ) {
+ $s->close;
+ DBM::Deep->_throw_error("Corrupted file - bad header");
+ }
+
+ #XXX Add warnings if values weren't set right
+ @{$e}{qw(byte_size max_buckets data_sector_size num_txns)} = @values;
+
+ # These shenangians are to allow a 256 within a C
+ $e->{max_buckets} += 1;
+ $e->{data_sector_size} += 1;
+
+ my $header_var = $self->header_var_size;
+ unless ( $size == $header_var ) {
+ $s->close;
+ DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
+ }
+
+ $e->set_trans_loc( $header_fixed + scalar(@values) );
+
+ my $bl = $e->txn_bitfield_len;
+ $e->set_chains_loc( $header_fixed + scalar(@values) + $bl + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) );
+
+ $self->{is_new} = 1;
+ }
+}
+
+sub header_var_size {
+ my $self = shift;
+ my $e = $self->engine;
+ return 1 + 1 + 1 + 1 + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) + 3 * $e->byte_size;
+}
+
+sub size {
+ my $self = shift;
+ $self->{size} ||= $header_fixed + $self->header_var_size;
+}
+sub is_new { $_[0]{is_new} }
+
+1;
+__END__
}
my $sector = $engine->_load_sector( $blist_loc )
- or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" );
+ or DBM::Deep->_throw_error( "1: Cannot read sector at $blist_loc in get_bucket_list()" );
my $i = 0;
my $last_sector = undef;
while ( $sector->isa( 'DBM::Deep::Engine::Sector::Index' ) ) {
$last_sector = $sector;
if ( $blist_loc ) {
$sector = $engine->_load_sector( $blist_loc )
- or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" );
+ or DBM::Deep->_throw_error( "2: Cannot read sector at $blist_loc in get_bucket_list()" );
}
else {
$sector = undef;
-#TODO: Convert this to a string
+#TODO: Add chaining back in.
package DBM::Deep::Engine::Sector::Scalar;
use 5.006_000;
my $dlen = length $data;
my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
+ my $next_offset = 0;
- my $curr_offset = $self->offset;
- my $continue = 1;
- while ( $continue ) {
- my $next_offset = 0;
-
- my ($leftover, $this_len, $chunk);
- if ( $dlen > $data_section ) {
- $leftover = 0;
- $this_len = $data_section;
- $chunk = substr( $data, 0, $this_len );
-
- $dlen -= $data_section;
- $next_offset = $engine->_request_data_sector( $self->size );
- $data = substr( $data, $this_len );
- }
- else {
- $leftover = $data_section - $dlen;
- $this_len = $dlen;
- $chunk = $data;
-
- $continue = 0;
- }
-
- my $string = chr(0) x $self->size;
- substr( $string, 0, $engine->SIG_SIZE, $self->type );
- substr( $string, $self->base_size, $engine->byte_size + 1,
- pack( $engine->StP($engine->byte_size), $next_offset ) # Chain loc
- . pack( $engine->StP(1), $this_len ), # Data length
- );
- substr( $string, $self->base_size + $engine->byte_size + 1, $this_len,
- $chunk,
- );
-
- $engine->storage->print_at( $curr_offset, $string );
-
- $curr_offset = $next_offset;
+ if ( $dlen > $data_section ) {
+ DBM::Deep->_throw_error( "Storage of values longer than $data_section not supported." );
}
+ $self->write( 0, $self->type );
+ $self->write( $self->base_size,
+ pack( $engine->StP($engine->byte_size), $next_offset ) # Chain loc
+ . pack( $engine->StP(1), $dlen ) # Data length
+ . $data
+ );
+
return;
}
}
sub data_length {
my $self = shift;
- my $buffer = $self->engine->storage->read_at(
- $self->offset + $self->base_size + $self->engine->byte_size, 1
+ return unpack(
+ $self->engine->StP(1),
+ $self->read( $self->base_size + $self->engine->byte_size, 1 ),
);
-
- return unpack( $self->engine->StP(1), $buffer );
}
sub chain_loc {
my $self = shift;
return unpack(
$self->engine->StP($self->engine->byte_size),
- $self->engine->storage->read_at(
- $self->offset + $self->base_size,
+ $self->read(
+ $self->base_size,
$self->engine->byte_size,
),
);
sub data {
my $self = shift;
-# my ($args) = @_;
-# $args ||= {};
my $data;
while ( 1 ) {
my $chain_loc = $self->chain_loc;
- $data .= $self->engine->storage->read_at(
- $self->offset + $self->base_size + $self->engine->byte_size + 1, $self->data_length,
- );
+ $data .= $self->read( $self->base_size + $self->engine->byte_size + 1, $self->data_length );
last unless $chain_loc;
return 1;
}
+sub size {
+ my $self = shift;
+
+ return 0 unless $self->{fh};
+ return -s $self->{fh};
+}
+
sub set_inode {
my $self = shift;
##
my $max_keys = 4000;
+warn localtime(time) . ": before put\n";
for ( 0 .. $max_keys ) {
$foo->put( "hello $_" => "there " . $_ * 2 );
}
+warn localtime(time) . ": after put\n";
my $count = -1;
for ( 0 .. $max_keys ) {
};
}
is( $count, $max_keys, "We read $count keys" );
+warn localtime(time) . ": after read\n";
my @keys = sort keys %$foo;
+warn localtime(time) . ": after keys\n";
cmp_ok( scalar(@keys), '==', $max_keys + 1, "Number of keys is correct" );
my @control = sort map { "hello $_" } 0 .. $max_keys;
cmp_deeply( \@keys, \@control, "Correct keys are there" );
ok( exists $foo->{does_not_exist}, "EXISTS works on large hashes for newly-existent keys" );
cmp_ok( scalar(keys %$foo), '==', $max_keys + 2, "Number of keys after autovivify is correct" );
+warn localtime(time) . ": before clear\n";
$db->clear;
+warn localtime(time) . ": after clear\n";
cmp_ok( scalar(keys %$db), '==', 0, "Number of keys after clear() is correct" );
# basic put/get/push
##
$db->[0] = "elem1";
-$db->push( "elem2" );
-$db->put(2, "elem3");
-$db->store(3, "elem4");
+#$db->push( "elem2" );
+#$db->put(2, "elem3");
+#$db->store(3, "elem4");
+warn $db->_engine->_dump_file;
$db->unshift("elem0");
+warn $db->_engine->_dump_file;
+__END__
is( $db->[0], 'elem0', "Array get for shift works" );
is( $db->[1], 'elem1', "Array get for array set works" );
} qr/Storage of references of type 'GLOB' is not supported/,
'Storage of glob refs not supported';
+ warn "\n1: " . $db->_engine->_dump_file;
$db->{scalar} = $x;
+ warn "\n2: " . $db->_engine->_dump_file;
TODO: {
todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2;
lives_ok {
is( ${$db->{selfref}}, $x, "A ref to a DBM::Deep object is ok" );
}
+
+ warn $db->_engine->_dump_file;
}
{
projects / dbsrgits/DBM-Deep.git / commitdiff