From: rkinyon@cpan.org Date: Tue, 21 Oct 2008 02:31:16 +0000 (+0000) Subject: Most tests now pass properly X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a5bdb1ac0c138a18058575acfc46023f3dc0fcf4;p=dbsrgits%2FDBM-Deep.git Most tests now pass properly git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@4462 88f4d9cd-8a04-0410-9d60-8f63309c3137 --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 4d6a980..f712c0d 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -76,17 +76,6 @@ sub new { return bless $self, $class; } -sub DESTROY { - my $self = shift; - - # If we have an error, don't flush - we might be flushing bad stuff. -RobK, 2008-06-26 - die $@ if $@; - - #XXX For some reason, this causes an allocation error in the final scope close - # of t/08_deephash.t. -RobK, 2008-06-28 - $self->_get_self->_engine->flush; -} - # This initializer is called from the various TIE* methods. new() calls tie(), # which allows for a single point of entry. sub _init { diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 6fb2039..1df77fd 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -440,6 +440,8 @@ sub setup_fh { } } + $self->storage->set_inode; + return 1; } diff --git a/lib/DBM/Deep/Engine/Sector.pm b/lib/DBM/Deep/Engine/Sector.pm deleted file mode 100644 index d86c7a5..0000000 --- a/lib/DBM/Deep/Engine/Sector.pm +++ /dev/null @@ -1,87 +0,0 @@ -package DBM::Deep::Engine::Sector; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use Scalar::Util (); - -sub new { - my $self = bless $_[1], $_[0]; - Scalar::Util::weaken( $self->{engine} ); - - $self->_init; - - return $self; -} - -#sub _init {} -#sub clone { DBM::Deep->_throw_error( "Must be implemented in the child class" ); } - -sub engine { $_[0]{engine} } -sub offset { $_[0]{offset} } -sub type { $_[0]{type} } - -sub base_size { - my $self = shift; - if ( ref($self) ) { - return $self->engine->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE; - } - else { - return $_[0]->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE; - } -} - -sub free { - my $self = shift; - - my $e = $self->engine; - - $self->write( 0, $e->SIG_FREE ); - $self->write( $self->base_size, chr(0) x ($self->size - $self->base_size) ); - - my $free_meth = $self->free_meth; - $e->$free_meth( $self ); - - return; -} - -sub read { - my $self = shift; - - if ( @_ == 1 ) { - die "read(): Start ($_[0]) is too large" if $_[0] > $self->size; - return substr( ${$self->engine->get_data( $self->offset, $self->size )}, $_[0] ); - } - elsif ( @_ == 2 ) { - die "read(): Start ($_[0]) is too large" if $_[0] > $self->size; - die "read(): Length ($_[1]) is too large" if $_[1] > $self->size; - return substr( ${$self->engine->get_data( $self->offset, $self->size )}, $_[0], $_[1] ); - } - elsif ( @_ < 1 ) { - die "read( start [, length ]): No parameters found."; - } - else { - die "read( start [, length ]): Too many parameters found (@_)."; - } -} - -sub write { - my $self = shift; - my ($start, $text) = @_; - - die "write(): Start ($start) is too large" if $start > $self->size; - die "write(): length(\$text) (@{[length($text)]}) is too large" if length($text) > $self->size; - substr( ${$self->engine->get_data( $self->offset, $self->size )}, $start, length($text) ) = $text; - - $self->mark_dirty; -} - -sub mark_dirty { - my $self = shift; - $self->engine->add_dirty_sector( $self->offset ); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/BucketList.pm b/lib/DBM/Deep/Engine/Sector/BucketList.pm deleted file mode 100644 index 73d1e0b..0000000 --- a/lib/DBM/Deep/Engine/Sector/BucketList.pm +++ /dev/null @@ -1,417 +0,0 @@ -package DBM::Deep::Engine::Sector::BucketList; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use DBM::Deep::Engine::Sector; -our @ISA = qw( DBM::Deep::Engine::Sector ); - -sub _init { - my $self = shift; - - my $engine = $self->engine; - - unless ( $self->offset ) { - $self->{offset} = $engine->_request_blist_sector( $self->size ); - - $self->write( 0, $engine->SIG_BLIST ); - } - - if ( $self->{key_md5} ) { - $self->find_md5; - } - - return $self; -} - -sub clear { - my $self = shift; - - # Zero-fill the data - $self->write( $self->base_size, chr(0) x ($self->size - $self->base_size) ); -} - -sub size { - my $self = shift; - if ( ref($self) ) { - unless ( $self->{size} ) { - # Base + numbuckets * bucketsize - $self->{size} = $self->base_size + $self->engine->max_buckets * $self->bucket_size; - } - return $self->{size}; - } - else { - my $e = shift; - return $self->base_size($e) + $e->max_buckets * $self->bucket_size($e); - } -} - -sub free_meth { return '_add_free_blist_sector' } - -sub free { - my $self = shift; - - my $e = $self->engine; - foreach my $bucket ( $self->chopped_up ) { - my $rest = $bucket->[-1]; - - # Delete the keysector - my $l = unpack( $e->StP($e->byte_size), substr( $rest, $e->hash_size, $e->byte_size ) ); - my $s = $e->_load_sector( $l ); $s->free if $s; - - # Delete the HEAD sector - $l = unpack( $e->StP($e->byte_size), - substr( $rest, - $e->hash_size + $e->byte_size, - $e->byte_size, - ), - ); - $s = $e->_load_sector( $l ); $s->free if $s; - - foreach my $txn ( 0 .. $e->num_txns - 2 ) { - my $l = unpack( $e->StP($e->byte_size), - substr( $rest, - $e->hash_size + 2 * $e->byte_size + $txn * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE), - $e->byte_size, - ), - ); - my $s = $e->_load_sector( $l ); $s->free if $s; - } - } - - $self->SUPER::free(); -} - -sub bucket_size { - my $self = shift; - if ( ref($self) ) { - unless ( $self->{bucket_size} ) { - my $e = $self->engine; - # Key + head (location) + transactions (location + staleness-counter) - my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE); - $self->{bucket_size} = $e->hash_size + $location_size; - } - return $self->{bucket_size}; - } - else { - my $e = shift; - my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE); - return $e->hash_size + $location_size; - } -} - -# XXX This is such a poor hack. I need to rethink this code. -sub chopped_up { - my $self = shift; - - my $e = $self->engine; - - my @buckets; - foreach my $idx ( 0 .. $e->max_buckets - 1 ) { - my $spot = $self->base_size + $idx * $self->bucket_size; - my $data = $self->read( $spot, $self->bucket_size ); - - # _dump_file() will run into the blank_md5. Otherwise, we should never run into it. - # -RobK, 2008-06-18 - last if substr( $data, 0, $e->hash_size ) eq $e->blank_md5; - - push @buckets, [ $spot, $data ]; - } - - return @buckets; -} - -#XXX Call this append() instead? -RobK, 2008-06-30 -sub write_at_next_open { - my $self = shift; - my ($entry) = @_; - - #XXX This is such a hack! - $self->{_next_open} = 0 unless exists $self->{_next_open}; - - my $spot = $self->base_size + $self->{_next_open}++ * $self->bucket_size; - $self->write( $spot, $entry ); - - return ($self->{_next_open} - 1); -} - -sub has_md5 { - my $self = shift; - unless ( exists $self->{found} ) { - $self->find_md5; - } - return $self->{found}; -} - -sub find_md5 { - my $self = shift; - - $self->{found} = undef; - $self->{idx} = -1; - - if ( @_ ) { - $self->{key_md5} = shift; - } - - # If we don't have an MD5, then what are we supposed to do? - unless ( exists $self->{key_md5} ) { - DBM::Deep->_throw_error( "Cannot find_md5 without a key_md5 set" ); - } - - my $e = $self->engine; - foreach my $idx ( 0 .. $e->max_buckets - 1 ) { - my $potential = $self->read( - $self->base_size + $idx * $self->bucket_size, $e->hash_size, - ); - - if ( $potential eq $e->blank_md5 ) { - $self->{idx} = $idx; - return; - } - - if ( $potential eq $self->{key_md5} ) { - $self->{found} = 1; - $self->{idx} = $idx; - return; - } - } - - return; -} - -sub write_md5 { - my $self = shift; - my ($args) = @_; - - DBM::Deep->_throw_error( "write_md5: no key" ) unless exists $args->{key}; - DBM::Deep->_throw_error( "write_md5: no key_md5" ) unless exists $args->{key_md5}; - DBM::Deep->_throw_error( "write_md5: no value" ) unless exists $args->{value}; - - my $e = $self->engine; - - $args->{trans_id} = $e->trans_id unless exists $args->{trans_id}; - - my $spot = $self->base_size + $self->{idx} * $self->bucket_size; - $e->add_entry( $args->{trans_id}, $self->offset, $self->{idx} ); - - unless ($self->{found}) { - my $key_sector = DBM::Deep::Engine::Sector::Scalar->new({ - engine => $e, - data => $args->{key}, - }); - - $self->write( $spot, $args->{key_md5} . pack( $e->StP($e->byte_size), $key_sector->offset ) ); - } - - my $loc = $spot + $e->hash_size + $e->byte_size; - - if ( $args->{trans_id} ) { - $loc += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - - $self->write( $loc, - pack( $e->StP($e->byte_size), $args->{value}->offset ) - . pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $e->get_txn_staleness_counter( $args->{trans_id} ) ), - ); - } - else { - $self->write( $loc, pack( $e->StP($e->byte_size), $args->{value}->offset ) ); - } -} - -sub mark_deleted { - my $self = shift; - my ($args) = @_; - $args ||= {}; - - my $e = $self->engine; - - $args->{trans_id} = $e->trans_id unless exists $args->{trans_id}; - - my $spot = $self->base_size + $self->{idx} * $self->bucket_size; - $e->add_entry( $args->{trans_id}, $self->offset, $self->{idx} ); - - my $loc = $spot - + $e->hash_size - + $e->byte_size; - - if ( $args->{trans_id} ) { - $loc += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - - $self->write( $loc, - pack( $e->StP($e->byte_size), 1 ) # 1 is the marker for deleted - . pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $e->get_txn_staleness_counter( $args->{trans_id} ) ), - ); - } - else { - # 1 is the marker for deleted - $self->write( $loc, pack( $e->StP($e->byte_size), 1 ) ); - } -} - -sub delete_md5 { - my $self = shift; - my ($args) = @_; - - my $engine = $self->engine; - return undef unless $self->{found}; - - # Save the location so that we can free the data - my $location = $self->get_data_location_for({ - allow_head => 0, - }); - my $key_sector = $self->get_key_for; - - my $spot = $self->base_size + $self->{idx} * $self->bucket_size; - - # Shuffle everything down to cover the deleted bucket's spot. - $self->write( $spot, - $self->read( - $spot + $self->bucket_size, - $self->bucket_size * ( $engine->max_buckets - $self->{idx} - 1 ), - ) - . chr(0) x $self->bucket_size, - ); - - $key_sector->free; - - my $data_sector = $self->engine->_load_sector( $location ); - my $data = $data_sector->data({ export => 1 }); - $data_sector->free; - - return $data; -} - -sub get_data_location_for { - my $self = shift; - 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 $e = $self->engine; - - my $spot = $self->base_size - + $args->{idx} * $self->bucket_size - + $e->hash_size - + $e->byte_size; - - if ( $args->{trans_id} ) { - $spot += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - } - - my $buffer = $self->read( $spot, $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - my ($loc, $staleness) = unpack( - $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE), - $buffer, - ); - - # XXX Merge the two if-clauses below - if ( $args->{trans_id} ) { - # We have found an entry that is old, so get rid of it - if ( $staleness != (my $s = $e->get_txn_staleness_counter( $args->{trans_id} ) ) ) { - $e->storage->print_at( - $spot, - pack( $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE), (0) x 2 ), - ); - $loc = 0; - } - } - - # If we're in a transaction and we never wrote to this location, try the - # HEAD instead. - if ( $args->{trans_id} && !$loc && $args->{allow_head} ) { - return $self->get_data_location_for({ - trans_id => 0, - allow_head => 1, - idx => $args->{idx}, - }); - } - - return $loc <= 1 ? 0 : $loc; -} - -sub get_data_for { - my $self = shift; - my ($args) = @_; - $args ||= {}; - - 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; - - if ( $idx >= $self->engine->max_buckets ) { - DBM::Deep->_throw_error( "get_key_for(): Attempting to retrieve $idx beyond max_buckets" ); - } - - my $location = $self->read( - $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size, - $self->engine->byte_size, - ); - $location = unpack( $self->engine->StP($self->engine->byte_size), $location ); - DBM::Deep->_throw_error( "get_key_for: No location?" ) unless $location; - - return $self->engine->_load_sector( $location ); -} - -sub rollback { - my $self = shift; - my ($idx) = @_; - my $e = $self->engine; - my $trans_id = $e->trans_id; - -# warn "Rolling back $idx ($trans_id)\n"; - - my $base = $self->base_size + ($idx * $self->bucket_size) + $e->hash_size + $e->byte_size; - my $spot = $base + $e->byte_size + ($trans_id - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - - my $trans_loc = $self->read( $spot, $e->byte_size ); - $trans_loc = unpack( $e->StP($e->byte_size), $trans_loc ); -# warn "$trans_loc\n"; - - $self->write( $spot, pack( $e->StP($e->byte_size), 0 ) ); - - if ( $trans_loc > 1 ) { - $e->_load_sector( $trans_loc )->free; - } - - return; -} - -sub commit { - my $self = shift; - my ($idx) = @_; - my $e = $self->engine; - my $trans_id = $e->trans_id; - - my $base = $self->base_size + ($idx * $self->bucket_size) + $e->hash_size + $e->byte_size; - - my $head_loc = $self->read( $base, $e->byte_size ); - $head_loc = unpack( $e->StP($e->byte_size), $head_loc ); - - my $spot = $base + $e->byte_size + ($trans_id - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE ); - my $trans_loc = $self->read( $spot, $e->byte_size ); - - $self->write( $base, $trans_loc ); - $self->write( $spot, pack( $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE), (0) x 2 ) ); - - if ( $head_loc > 1 ) { - $e->_load_sector( $head_loc )->free; - } - - return; -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/Data.pm b/lib/DBM/Deep/Engine/Sector/Data.pm deleted file mode 100644 index e12e942..0000000 --- a/lib/DBM/Deep/Engine/Sector/Data.pm +++ /dev/null @@ -1,28 +0,0 @@ -package DBM::Deep::Engine::Sector::Data; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use DBM::Deep::Engine::Sector; -our @ISA = qw( DBM::Deep::Engine::Sector ); - -# This is in bytes -sub size { - my $e = ref($_[0]) ? $_[0]{engine} : $_[1]; - return $e->data_sector_size; -} -sub free_meth { return '_add_free_data_sector' } - -sub clone { - my $self = shift; - return ref($self)->new({ - engine => $self->engine, - type => $self->type, - data => $self->data, - }); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/FileHeader.pm b/lib/DBM/Deep/Engine/Sector/FileHeader.pm deleted file mode 100644 index fe70e6a..0000000 --- a/lib/DBM/Deep/Engine/Sector/FileHeader.pm +++ /dev/null @@ -1,245 +0,0 @@ -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. - unless ( exists $self->engine->sector_cache->{0} || $self->engine->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; - - # Make sure we set up sector caching so that get_data() works. -RobK, 2008-06-24 - $self->engine->sector_cache->{$self->offset} = chr(0) x ($header_fixed + $header_var); - - $self->write( 0, - $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; - $self->{is_new} = 0; - - return if exists $self->engine->sector_cache->{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) ); - - # Make sure we set up sector caching so that get_data() works. -RobK, 2008-06-24 - $self->engine->sector_cache->{$self->offset} = $buffer . $buffer2; - } -} - -sub header_var_size { - my $self = shift; - my $e = shift || $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; - if ( ref($self) ) { - $self->{size} ||= $header_fixed + $self->header_var_size; - } - else { - return $header_fixed + $self->header_var_size( @_ ); - } -} - -sub is_new { $_[0]{is_new} } - -sub add_free_sector { - my $self = shift; - my ($multiple, $sector) = @_; - - my $e = $self->engine; - - my $chains_offset = $multiple * $e->byte_size; - - # Increment staleness. - # XXX Can this increment+modulo be done by "&= 0x1" ? - my $staleness = unpack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $sector->read( $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ) ); - $staleness = ($staleness + 1 ) % ( 2 ** ( 8 * $DBM::Deep::Engine::STALE_SIZE ) ); - $sector->write( $e->SIG_SIZE, pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $staleness ) ); - - my $old_head = $self->read( $e->chains_loc + $chains_offset, $e->byte_size ); - - $self->write( $e->chains_loc + $chains_offset, - pack( $e->StP($e->byte_size), $sector->offset ), - ); - - # Record the old head in the new sector after the signature and staleness counter - $sector->write( $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $old_head ); -} - -sub request_sector { - my $self = shift; - my ($multiple, $size) = @_; - - my $e = $self->engine; - - my $chains_offset = $multiple * $e->byte_size; - - my $old_head = $self->read( $e->chains_loc + $chains_offset, $e->byte_size ); - my $loc = unpack( $e->StP($e->byte_size), $old_head ); - - # We don't have any free sectors of the right size, so allocate a new one. - unless ( $loc ) { - my $offset = $e->storage->request_space( $size ); - - # Zero out the new sector. This also guarantees correct increases - # in the filesize. - $self->engine->sector_cache->{$offset} = chr(0) x $size; - - return $offset; - } - - # Need to load the new sector so we can read from it. - my $new_sector = $self->engine->get_data( $loc, $size ); - - # Read the new head after the signature and the staleness counter - my $new_head = substr( $$new_sector, $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $e->byte_size ); - - $self->write( $e->chains_loc + $chains_offset, $new_head ); - - return $loc; -} - -sub read_txn_slots { - my $self = shift; - my $e = $self->engine; - my $bl = $e->txn_bitfield_len; - my $num_bits = $bl * 8; - my @x = split '', unpack( 'b'.$num_bits, $self->read( $e->trans_loc, $bl ) ); - return @x; -} - -sub write_txn_slots { - my $self = shift; - my $e = $self->engine; - my $num_bits = $e->txn_bitfield_len * 8; - $self->write( $e->trans_loc, - pack( 'b'.$num_bits, join('', @_) ), - ); -} - -sub get_txn_staleness_counter { - my $self = shift; - my ($trans_id) = @_; - - # Hardcode staleness of 0 for the HEAD - return 0 unless $trans_id; - - my $e = $self->engine; - return unpack( $e->StP($DBM::Deep::Engine::STALE_SIZE), - $self->read( - $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1), - $DBM::Deep::Engine::STALE_SIZE, - ) - ); -} - -sub inc_txn_staleness_counter { - my $self = shift; - my ($trans_id) = @_; - - # Hardcode staleness of 0 for the HEAD - return 0 unless $trans_id; - - my $e = $self->engine; - $self->write( - $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1), - pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $self->get_txn_staleness_counter( $trans_id ) + 1 ), - ); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/Index.pm b/lib/DBM/Deep/Engine/Sector/Index.pm deleted file mode 100644 index a7c9334..0000000 --- a/lib/DBM/Deep/Engine/Sector/Index.pm +++ /dev/null @@ -1,90 +0,0 @@ -package DBM::Deep::Engine::Sector::Index; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use DBM::Deep::Engine::Sector; -our @ISA = qw( DBM::Deep::Engine::Sector ); - -sub _init { - my $self = shift; - - my $engine = $self->engine; - - unless ( $self->offset ) { - $self->{offset} = $engine->_request_index_sector( $self->size ); - - $self->write( 0, $engine->SIG_INDEX ); - } - - return $self; -} - -#XXX Change here -#XXX Why? -RobK, 2008-06-18 -sub size { - my $self = shift; - if ( ref($self) ) { - unless ( $self->{size} ) { - my $e = $self->engine; - $self->{size} = $self->base_size + $e->byte_size * $e->hash_chars; - } - return $self->{size}; - } - else { - my $e = shift; - return $self->base_size($e) + $e->byte_size * $e->hash_chars; - } -} - -sub free_meth { return '_add_free_index_sector' } - -sub free { - my $self = shift; - my $e = $self->engine; - - for my $i ( 0 .. $e->hash_chars - 1 ) { - my $l = $self->get_entry( $i ) or next; - $e->_load_sector( $l )->free; - } - - $self->SUPER::free(); -} - -sub _loc_for { - my $self = shift; - my ($idx) = @_; - return $self->base_size + $idx * $self->engine->byte_size; -} - -sub get_entry { - my $self = shift; - my ($idx) = @_; - - my $e = $self->engine; - - DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" ) - if $idx < 0 || $idx >= $e->hash_chars; - - return unpack( - $e->StP($e->byte_size), - $self->read( $self->_loc_for( $idx ), $e->byte_size ), - ); -} - -sub set_entry { - my $self = shift; - my ($idx, $loc) = @_; - - my $e = $self->engine; - - DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" ) - if $idx < 0 || $idx >= $e->hash_chars; - - $self->write( $self->_loc_for( $idx ), pack( $e->StP($e->byte_size), $loc ) ); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/Null.pm b/lib/DBM/Deep/Engine/Sector/Null.pm deleted file mode 100644 index 18af99a..0000000 --- a/lib/DBM/Deep/Engine/Sector/Null.pm +++ /dev/null @@ -1,34 +0,0 @@ -package DBM::Deep::Engine::Sector::Null; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use DBM::Deep::Engine::Sector::Data; -our @ISA = qw( DBM::Deep::Engine::Sector::Data ); - -sub type { $_[0]{engine}->SIG_NULL } -sub data_length { 0 } -sub data { return } - -sub _init { - my $self = shift; - - my $engine = $self->engine; - - unless ( $self->offset ) { - $self->{offset} = $engine->_request_data_sector( $self->size ); - - $self->write( 0, $self->type ); - $self->write( $self->base_size, - pack( $engine->StP($engine->byte_size), 0 ) # Chain loc - . pack( $engine->StP(1), $self->data_length ), # Data length - ); - - return; - } -} - -1; -__END__ diff --git a/lib/DBM/Deep/Engine/Sector/Reference.pm b/lib/DBM/Deep/Engine/Sector/Reference.pm deleted file mode 100644 index de102c5..0000000 --- a/lib/DBM/Deep/Engine/Sector/Reference.pm +++ /dev/null @@ -1,517 +0,0 @@ -package DBM::Deep::Engine::Sector::Reference; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use Scalar::Util (); - -use DBM::Deep::Null; - -use DBM::Deep::Engine::Sector::Data; -our @ISA = qw( DBM::Deep::Engine::Sector::Data ); - -sub _init { - my $self = shift; - - my $e = $self->engine; - - unless ( $self->offset ) { - $self->{offset} = $e->_request_data_sector( $self->size ); - - my $class_offset = 0; - my $classname = Scalar::Util::blessed( delete $self->{data} ); - if ( defined $classname ) { - my $class_sector = DBM::Deep::Engine::Sector::Scalar->new({ - engine => $e, - data => $classname, - }); - $class_offset = $class_sector->offset; - } - - $self->write( 0, $self->type ); - $self->write( $self->base_size, - pack( $e->StP($e->byte_size), 0 ) # Index/BList loc - . pack( $e->StP($e->byte_size), $class_offset ) # Classname loc - . pack( $e->StP($e->byte_size), 1 ) # Initial refcount - ); - } - else { - $self->{type} = $self->read( 0, $e->SIG_SIZE ); - } - - $self->{staleness} = unpack( - $e->StP($DBM::Deep::Engine::STALE_SIZE), - $self->read( $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ), - ); - - return; -} - -sub staleness { $_[0]{staleness} } - -sub get_data_location_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}, - key => $args->{key}, - 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 $location; -} - -sub get_data_for { - my $self = shift; - my ($args) = @_; - - my $location = $self->get_data_location_for( $args ) - 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}, - key => $args->{key}, - create => 1, - }) or DBM::Deep->_throw_error( "How did write_data fail (no blist)?!" ); - - # Handle any transactional bookkeeping. - if ( $self->engine->trans_id ) { - if ( ! $blist->has_md5 ) { - $blist->mark_deleted({ - trans_id => 0, - }); - } - } - else { - my @trans_ids = $self->engine->get_running_txn_ids; - if ( $blist->has_md5 ) { - 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 ) { - #XXX This doesn't seem to possible to ever happen . . . - next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 }); - $blist->mark_deleted({ - trans_id => $other_trans_id, - }); - } - } - } - } - - #XXX Is this safe to do transactionally? - # 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 DBM::Deep->_throw_error( "How did delete_key fail (no blist)?!" ); - - # Save the location so that we can free the data - my $location = $blist->get_data_location_for({ - allow_head => 0, - }); - my $old_value = $location && $self->engine->_load_sector( $location ); - - my @trans_ids = $self->engine->get_running_txn_ids; - - # If we're the HEAD and there are running txns, then we need to clone this value to the other - # transactions to preserve Isolation. - if ( $self->engine->trans_id == 0 ) { - 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->write_md5({ - trans_id => $other_trans_id, - key => $args->{key}, - key_md5 => $args->{key_md5}, - value => $old_value->clone, - }); - } - } - } - - my $data; - if ( @trans_ids ) { - $blist->mark_deleted( $args ); - - if ( $old_value ) { - $data = $old_value->data({ export => 1 }); - $old_value->free; - } - } - else { - $data = $blist->delete_md5( $args ); - } - - return $data; -} - -sub get_blist_loc { - my $self = shift; - - my $e = $self->engine; - return unpack( - $e->StP($e->byte_size), - $self->read( $self->base_size, $e->byte_size ), - ); -} - -sub get_bucket_list { - my $self = shift; - my ($args) = @_; - $args ||= {}; - - # XXX Add in check here for recycling? - - my $engine = $self->engine; - - my $blist_loc = $self->get_blist_loc; - - # There's no index or blist yet - unless ( $blist_loc ) { - return unless $args->{create}; - - my $blist = DBM::Deep::Engine::Sector::BucketList->new({ - engine => $engine, - key_md5 => $args->{key_md5}, - }); - - $self->write( $self->base_size, pack( $engine->StP($engine->byte_size), $blist->offset ) ); - - return $blist; - } - - my $sector = $engine->_load_sector( $blist_loc ) - 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' ) ) { - $blist_loc = $sector->get_entry( ord( substr( $args->{key_md5}, $i++, 1 ) ) ); - $last_sector = $sector; - if ( $blist_loc ) { - $sector = $engine->_load_sector( $blist_loc ) - or DBM::Deep->_throw_error( "2: Cannot read sector at $blist_loc in get_bucket_list()" ); - } - else { - $sector = undef; - last; - } - } - - # This means we went through the Index sector(s) and found an empty slot - unless ( $sector ) { - return unless $args->{create}; - - DBM::Deep->_throw_error( "No last_sector when attempting to build a new entry" ) - unless $last_sector; - - my $blist = DBM::Deep::Engine::Sector::BucketList->new({ - engine => $engine, - key_md5 => $args->{key_md5}, - }); - - $last_sector->set_entry( ord( substr( $args->{key_md5}, $i - 1, 1 ) ) => $blist->offset ); - - return $blist; - } - - $sector->find_md5( $args->{key_md5} ); - - # See whether or not we need to reindex the bucketlist - # Yes, the double-braces are there for a reason. if() doesn't create a redo-able block, - # so we have to create a bare block within the if() for redo-purposes. Patch and idea - # submitted by sprout@cpan.org. -RobK, 2008-01-09 - if ( !$sector->has_md5 && $args->{create} && $sector->{idx} == -1 ) {{ - my $redo; - - my $new_index = DBM::Deep::Engine::Sector::Index->new({ - engine => $engine, - }); - - my %blist_cache; - #XXX q.v. the comments for this function. - my $old_idx = 0; - foreach my $entry ( $sector->chopped_up ) { - my ($spot, $md5) = @{$entry}; - my $idx = ord( substr( $md5, $i, 1 ) ); - - # XXX This is inefficient - my $blist = $blist_cache{$idx} - ||= DBM::Deep::Engine::Sector::BucketList->new({ - engine => $engine, - }); - - $new_index->set_entry( $idx => $blist->offset ); - - #XXX q.v. the comments for this function. - my $new_idx = $blist->write_at_next_open( $md5 ); - - $engine->reindex_entry( ( $sector->offset, $old_idx ) => ( $blist->offset, $new_idx ) ); - - $old_idx++; - } - - # Handle the new item separately. - { - my $idx = ord( substr( $args->{key_md5}, $i, 1 ) ); - - # If all the previous blist's items have been thrown into one - # blist and the new item belongs in there too, we need - # another index. - if ( keys %blist_cache == 1 and each %blist_cache == $idx ) { - ++$i, ++$redo; - } else { - my $blist = $blist_cache{$idx} - ||= DBM::Deep::Engine::Sector::BucketList->new({ - engine => $engine, - }); - - $new_index->set_entry( $idx => $blist->offset ); - - #XXX THIS IS HACKY! - $blist->find_md5( $args->{key_md5} ); - $blist->write_md5({ - key => $args->{key}, - key_md5 => $args->{key_md5}, - value => DBM::Deep::Engine::Sector::Null->new({ - engine => $engine, - data => undef, - }), - }); - } - -#XXX Why is this code here? -RobK, 2008-06-15 -# my $blist = $blist_cache{$idx} -# ||= DBM::Deep::Engine::Sector::BucketList->new({ -# engine => $engine, -# }); -# -# $new_index->set_entry( $idx => $blist->offset ); -# -# #XXX THIS IS HACKY! -# $blist->find_md5( $args->{key_md5} ); -# $blist->write_md5({ -# key => $args->{key}, -# key_md5 => $args->{key_md5}, -# value => DBM::Deep::Engine::Sector::Null->new({ -# engine => $engine, -# data => undef, -# }), -# }); - } - - if ( $last_sector ) { - $last_sector->set_entry( - ord( substr( $args->{key_md5}, $i - 1, 1 ) ), - $new_index->offset, - ); - } else { - $self->write( $self->base_size, pack( $engine->StP($engine->byte_size), $new_index->offset ) ); - } - - $sector->clear; - $sector->free; - - if ( $redo ) { - (undef, $sector) = %blist_cache; - $last_sector = $new_index; - redo; - } - - $sector = $blist_cache{ ord( substr( $args->{key_md5}, $i, 1 ) ) }; - $sector->find_md5( $args->{key_md5} ); - }} - - return $sector; -} - -sub get_class_offset { - my $self = shift; - - my $e = $self->engine; - return unpack( - $e->StP($e->byte_size), - $self->read( - $self->base_size + 1 * $e->byte_size, - $e->byte_size, - ), - ); -} - -sub get_classname { - my $self = shift; - - my $class_offset = $self->get_class_offset; - - return unless $class_offset; - - return $self->engine->_load_sector( $class_offset )->data; -} - -sub data { - my $self = shift; - my ($args) = @_; - $args ||= {}; - - my $obj; - unless ( $obj = $self->engine->cache->{ $self->offset } ) { - $obj = DBM::Deep->new({ - type => $self->type, - base_offset => $self->offset, - staleness => $self->staleness, - storage => $self->engine->storage, - engine => $self->engine, - }); - - if ( $self->engine->storage->{autobless} ) { - my $classname = $self->get_classname; - if ( defined $classname ) { - bless $obj, $classname; - } - } - - $self->engine->cache->{$self->offset} = $obj; - } - - # We're not exporting, so just return. - unless ( $args->{export} ) { - return $obj; - } - - # We shouldn't export if this is still referred to. - if ( $self->get_refcount > 1 ) { - return $obj; - } - - return $obj->export; -} - -sub free { - my $self = shift; - - # We're not ready to be removed yet. - if ( $self->decrement_refcount > 0 ) { - return; - } - - # Rebless the object into DBM::Deep::Null. - eval { %{ $self->engine->cache->{ $self->offset } } = (); }; - eval { @{ $self->engine->cache->{ $self->offset } } = (); }; - bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null'; - delete $self->engine->cache->{ $self->offset }; - - foreach my $meth ( qw( get_blist_loc get_class_offset ) ) { - my $l = $self->$meth; - my $s = $self->engine->_load_sector( $l ); - $s->free if $s; - } - - $self->SUPER::free(); -} - -sub increment_refcount { - my $self = shift; - - my $refcount = $self->get_refcount; - - $refcount++; - - $self->write_refcount( $refcount ); - - return $refcount; -} - -sub decrement_refcount { - my $self = shift; - - my $refcount = $self->get_refcount; - - $refcount--; - - $self->write_refcount( $refcount ); - - return $refcount; -} - -sub get_refcount { - my $self = shift; - - my $e = $self->engine; - return unpack( - $e->StP($e->byte_size), - $self->read( - $self->base_size + 2 * $e->byte_size, - $e->byte_size, - ), - ); -} - -sub write_refcount { - my $self = shift; - my ($num) = @_; - - my $e = $self->engine; - $self->write( - $self->base_size + 2 * $e->byte_size, - pack( $e->StP($e->byte_size), $num ), - ); -} - - -1; -__END__ - diff --git a/lib/DBM/Deep/Engine/Sector/Scalar.pm b/lib/DBM/Deep/Engine/Sector/Scalar.pm deleted file mode 100644 index 332e849..0000000 --- a/lib/DBM/Deep/Engine/Sector/Scalar.pm +++ /dev/null @@ -1,93 +0,0 @@ -#TODO: Add chaining back in. -package DBM::Deep::Engine::Sector::Scalar; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use DBM::Deep::Engine::Sector::Data; -our @ISA = qw( DBM::Deep::Engine::Sector::Data ); - -sub free { - my $self = shift; - - my $chain_loc = $self->chain_loc; - - $self->SUPER::free(); - - if ( $chain_loc ) { - $self->engine->_load_sector( $chain_loc )->free; - } - - return; -} - -sub type { $_[0]{engine}->SIG_DATA } -sub _init { - my $self = shift; - - my $engine = $self->engine; - - unless ( $self->offset ) { - $self->{offset} = $engine->_request_data_sector( $self->size ); - my $data = delete $self->{data}; - my $dlen = length $data; - - my $data_section = $self->size - $self->base_size - $engine->byte_size - 1; - my $next_offset = 0; - - 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; - - return unpack( - $self->engine->StP(1), - $self->read( $self->base_size + $self->engine->byte_size, 1 ), - ); -} - -sub chain_loc { - my $self = shift; - return unpack( - $self->engine->StP($self->engine->byte_size), - $self->read( - $self->base_size, - $self->engine->byte_size, - ), - ); -} - -sub data { - my $self = shift; - - my $data; - while ( 1 ) { - my $chain_loc = $self->chain_loc; - - $data .= $self->read( $self->base_size + $self->engine->byte_size + 1, $self->data_length ); - - last unless $chain_loc; - - $self = $self->engine->_load_sector( $chain_loc ); - } - - return $data; -} - -1; -__END__ diff --git a/lib/DBM/Deep/Iterator.pm b/lib/DBM/Deep/Iterator.pm deleted file mode 100644 index bd5905f..0000000 --- a/lib/DBM/Deep/Iterator.pm +++ /dev/null @@ -1,123 +0,0 @@ -package DBM::Deep::Iterator; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use Scalar::Util (); - -use DBM::Deep::Iterator::Index; -use DBM::Deep::Iterator::BucketList; - -sub new { - my $class = shift; - my ($args) = @_; - - my $self = bless { - breadcrumbs => [], - engine => $args->{engine}, - base_offset => $args->{base_offset}, - }, $class; - - Scalar::Util::weaken( $self->{engine} ); - - return $self; -} - -sub reset { $_[0]{breadcrumbs} = [] } - -sub get_sector_iterator { - my $self = shift; - my ($loc) = @_; - - my $sector = $self->{engine}->_load_sector( $loc ) - or return; - - if ( $sector->isa( 'DBM::Deep::Engine::Sector::Index' ) ) { - return DBM::Deep::Iterator::Index->new({ - iterator => $self, - sector => $sector, - }); - } - elsif ( $sector->isa( 'DBM::Deep::Engine::Sector::BucketList' ) ) { - return DBM::Deep::Iterator::BucketList->new({ - iterator => $self, - sector => $sector, - }); - } - - DBM::Deep->_throw_error( "get_sector_iterator(): Why did $loc make a $sector?" ); -} - -sub get_next_key { - my $self = shift; - my ($obj) = @_; - - my $crumbs = $self->{breadcrumbs}; - my $e = $self->{engine}; - - warn "1\n"; - unless ( @$crumbs ) { - # This will be a Reference sector - my $sector = $e->_load_sector( $self->{base_offset} ) - # If no sector is found, thist must have been deleted from under us. - or return; - - if ( $sector->staleness != $obj->_staleness ) { - return; - } - - my $loc = $sector->get_blist_loc - or return; - - push @$crumbs, $self->get_sector_iterator( $loc ); - } - - warn "2: " . $obj->_dump_file; - FIND_NEXT_KEY: { - # We're at the end. - unless ( @$crumbs ) { - $self->reset; - return; - } - - my $iterator = $crumbs->[-1]; - - # This level is done. - if ( $iterator->at_end ) { - pop @$crumbs; - redo FIND_NEXT_KEY; - } - - if ( $iterator->isa( 'DBM::Deep::Iterator::Index' ) ) { - # If we don't have any more, it will be caught at the - # prior check. - if ( my $next = $iterator->get_next_iterator ) { - push @$crumbs, $next; - } - redo FIND_NEXT_KEY; - } - - unless ( $iterator->isa( 'DBM::Deep::Iterator::BucketList' ) ) { - DBM::Deep->_throw_error( - "Should have a bucketlist iterator here - instead have $iterator" - ); - } - - # At this point, we have a BucketList iterator - my $key = $iterator->get_next_key; - if ( defined $key ) { - return $key; - } - #XXX else { $iterator->set_to_end() } ? - - # We hit the end of the bucketlist iterator, so redo - redo FIND_NEXT_KEY; - } - - DBM::Deep->_throw_error( "get_next_key(): How did we get here?" ); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Iterator/BucketList.pm b/lib/DBM/Deep/Iterator/BucketList.pm deleted file mode 100644 index 9fa1cac..0000000 --- a/lib/DBM/Deep/Iterator/BucketList.pm +++ /dev/null @@ -1,36 +0,0 @@ -package DBM::Deep::Iterator::BucketList; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -sub new { - my $self = bless $_[1] => $_[0]; - $self->{curr_index} = 0; - return $self; -} - -sub at_end { - my $self = shift; - return $self->{curr_index} >= $self->{iterator}{engine}->max_buckets; -} - -sub get_next_key { - my $self = shift; - - return if $self->at_end; - - my $idx = $self->{curr_index}++; - - my $data_loc = $self->{sector}->get_data_location_for({ - allow_head => 1, - idx => $idx, - }) or return; - - #XXX Do we want to add corruption checks here? - return $self->{sector}->get_key_for( $idx )->data; -} - -1; -__END__ diff --git a/lib/DBM/Deep/Iterator/Index.pm b/lib/DBM/Deep/Iterator/Index.pm deleted file mode 100644 index 04df6d4..0000000 --- a/lib/DBM/Deep/Iterator/Index.pm +++ /dev/null @@ -1,32 +0,0 @@ -package DBM::Deep::Iterator::Index; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -sub new { - my $self = bless $_[1] => $_[0]; - $self->{curr_index} = 0; - return $self; -} - -sub at_end { - my $self = shift; - return $self->{curr_index} >= $self->{iterator}{engine}->hash_chars; -} - -sub get_next_iterator { - my $self = shift; - - my $loc; - while ( !$loc ) { - return if $self->at_end; - $loc = $self->{sector}->get_entry( $self->{curr_index}++ ); - } - - return $self->{iterator}->get_sector_iterator( $loc ); -} - -1; -__END__ diff --git a/lib/DBM/Deep/Null.pm b/lib/DBM/Deep/Null.pm deleted file mode 100644 index 6c63e4f..0000000 --- a/lib/DBM/Deep/Null.pm +++ /dev/null @@ -1,20 +0,0 @@ -# This was copied from MARCEL's Class::Null. However, I couldn't use it because -# I need an undef value, not an implementation of the Null Class pattern. -package DBM::Deep::Null; - -use 5.006_000; - -use strict; -use warnings FATAL => 'all'; - -use overload - 'bool' => sub { undef }, - '""' => sub { undef }, - '0+' => sub { undef }, - fallback => 1, - nomethod => 'AUTOLOAD'; - -sub AUTOLOAD { return; } - -1; -__END__ diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t index b7a3c61..96a3fd0 100644 --- a/t/44_upgrade_db.t +++ b/t/44_upgrade_db.t @@ -95,7 +95,7 @@ foreach my $input_filename ( "-version $v", ); - warn "Testing $input_filename against $v\n"; + #warn "Testing $input_filename against $v\n"; # Clone was removed as a requirement in 1.0006 if ( $output =~ /Can\'t locate Clone\.pm in \@INC/ ) {