From: rkinyon@cpan.org Date: Mon, 16 Jun 2008 01:14:06 +0000 (+0000) Subject: Convert ::Reference to use a string in creation. This sparks an interesting debate... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c7d9738477ef6616ce0560d095aa68097c3ed55;p=dbsrgits%2FDBM-Deep.git Convert ::Reference to use a string in creation. This sparks an interesting debate about the staleness counter. There doesn't seem to be a test for it. That needs to be remedied. git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@3576 88f4d9cd-8a04-0410-9d60-8f63309c3137 --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index ace79c5..6a02caa 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings FATAL => 'all'; -our $VERSION = q(1.0013); +our $VERSION = q(1.0014); use Data::Dumper (); use Fcntl qw( :flock ); diff --git a/lib/DBM/Deep/Engine/Sector.pm b/lib/DBM/Deep/Engine/Sector.pm index be079d0..5c9f3bc 100644 --- a/lib/DBM/Deep/Engine/Sector.pm +++ b/lib/DBM/Deep/Engine/Sector.pm @@ -1,6 +1,6 @@ package DBM::Deep::Engine::Sector; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Engine/Sector/BucketList.pm b/lib/DBM/Deep/Engine/Sector/BucketList.pm index a083172..b76b2dd 100644 --- a/lib/DBM/Deep/Engine/Sector/BucketList.pm +++ b/lib/DBM/Deep/Engine/Sector/BucketList.pm @@ -1,7 +1,7 @@ #TODO: Convert this to a string package DBM::Deep::Engine::Sector::BucketList; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Engine/Sector/Data.pm b/lib/DBM/Deep/Engine/Sector/Data.pm index d39fac6..6448367 100644 --- a/lib/DBM/Deep/Engine/Sector/Data.pm +++ b/lib/DBM/Deep/Engine/Sector/Data.pm @@ -1,6 +1,6 @@ package DBM::Deep::Engine::Sector::Data; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Engine/Sector/Index.pm b/lib/DBM/Deep/Engine/Sector/Index.pm index 8278f9a..149f271 100644 --- a/lib/DBM/Deep/Engine/Sector/Index.pm +++ b/lib/DBM/Deep/Engine/Sector/Index.pm @@ -1,7 +1,7 @@ #TODO: Convert this to a string package DBM::Deep::Engine::Sector::Index; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Engine/Sector/Null.pm b/lib/DBM/Deep/Engine/Sector/Null.pm index c97f0f5..c9570f5 100644 --- a/lib/DBM/Deep/Engine/Sector/Null.pm +++ b/lib/DBM/Deep/Engine/Sector/Null.pm @@ -1,6 +1,6 @@ package DBM::Deep::Engine::Sector::Null; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Engine/Sector/Reference.pm b/lib/DBM/Deep/Engine/Sector/Reference.pm index b0b749d..0fd782a 100644 --- a/lib/DBM/Deep/Engine/Sector/Reference.pm +++ b/lib/DBM/Deep/Engine/Sector/Reference.pm @@ -1,7 +1,7 @@ #TODO: Convert this to a string package DBM::Deep::Engine::Sector::Reference; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; @@ -19,10 +19,11 @@ sub _init { my $e = $self->engine; unless ( $self->offset ) { - my $classname = Scalar::Util::blessed( delete $self->{data} ); - my $leftover = $self->size - $self->base_size - 3 * $e->byte_size; + $self->{staleness} = 0; + $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, @@ -31,24 +32,23 @@ sub _init { $class_offset = $class_sector->offset; } - $self->{offset} = $e->_request_data_sector( $self->size ); - $e->storage->print_at( $self->offset, $self->type ); # Sector type - # Skip staleness counter - $e->storage->print_at( $self->offset + $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 - chr(0) x $leftover, # Zero-fill the rest + my $string = chr(0) x $self->size; + substr( $string, 0, 1, $self->type ); + substr( $string, $self->base_size, 3 * $e->byte_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 ); + $e->storage->print_at( $self->offset, $string ); } else { $self->{type} = $e->storage->read_at( $self->offset, 1 ); - } - $self->{staleness} = unpack( - $e->StP($DBM::Deep::Engine::STALE_SIZE), - $e->storage->read_at( $self->offset + $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ), - ); + $self->{staleness} = unpack( + $e->StP($DBM::Deep::Engine::STALE_SIZE), + $e->storage->read_at( $self->offset + $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ), + ); + } return; } diff --git a/lib/DBM/Deep/Engine/Sector/Scalar.pm b/lib/DBM/Deep/Engine/Sector/Scalar.pm index 8984b94..d47d9f0 100644 --- a/lib/DBM/Deep/Engine/Sector/Scalar.pm +++ b/lib/DBM/Deep/Engine/Sector/Scalar.pm @@ -1,13 +1,11 @@ #TODO: Convert this to a string package DBM::Deep::Engine::Sector::Scalar; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; -our $VERSION = '0.01'; - use DBM::Deep::Engine::Sector::Data; our @ISA = qw( DBM::Deep::Engine::Sector::Data ); diff --git a/lib/DBM/Deep/Iterator.pm b/lib/DBM/Deep/Iterator.pm index 1c9bd5f..6de0e05 100644 --- a/lib/DBM/Deep/Iterator.pm +++ b/lib/DBM/Deep/Iterator.pm @@ -1,6 +1,6 @@ package DBM::Deep::Iterator; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Iterator/BucketList.pm b/lib/DBM/Deep/Iterator/BucketList.pm index 3f57868..9fa1cac 100644 --- a/lib/DBM/Deep/Iterator/BucketList.pm +++ b/lib/DBM/Deep/Iterator/BucketList.pm @@ -1,6 +1,6 @@ package DBM::Deep::Iterator::BucketList; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Iterator/Index.pm b/lib/DBM/Deep/Iterator/Index.pm index 2052fa5..04df6d4 100644 --- a/lib/DBM/Deep/Iterator/Index.pm +++ b/lib/DBM/Deep/Iterator/Index.pm @@ -1,6 +1,6 @@ package DBM::Deep::Iterator::Index; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/lib/DBM/Deep/Null.pm b/lib/DBM/Deep/Null.pm index 35f1c83..6c63e4f 100644 --- a/lib/DBM/Deep/Null.pm +++ b/lib/DBM/Deep/Null.pm @@ -2,7 +2,7 @@ # I need an undef value, not an implementation of the Null Class pattern. package DBM::Deep::Null; -use 5.006; +use 5.006_000; use strict; use warnings FATAL => 'all'; diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t index 245f473..b42ca9e 100644 --- a/t/44_upgrade_db.t +++ b/t/44_upgrade_db.t @@ -20,7 +20,7 @@ BEGIN { } } -plan tests => 292; +plan tests => 302; use t::common qw( new_fh ); use File::Spec; @@ -72,7 +72,8 @@ my @output_versions = ( '0.981', '0.982', '0.983', '0.99_01', '0.99_02', '0.99_03', '0.99_04', '1.00', '1.000', '1.0000', '1.0001', '1.0002', - '1.0003', '1.0004', '1.0005', '1.0006', '1.0007', '1.0008', '1.0009', '1.0010', '1.0011', '1.0012', '1.0013', + '1.0003', '1.0004', '1.0005', '1.0006', '1.0007', '1.0008', '1.0009', '1.0010', + '1.0011', '1.0012', '1.0013', '1.0014', ); foreach my $input_filename ( @@ -93,6 +94,8 @@ foreach my $input_filename ( "-version $v", ); + #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/ ) { ok( 1 ); @@ -125,7 +128,7 @@ foreach my $input_filename ( die "$output\n" if $output; my $db; - if ( $v =~ /^1\.001[0-3]/ || $v =~ /^1\.000[3-9]/ ) { + if ( $v =~ /^1\.001[0-4]/ || $v =~ /^1\.000[3-9]/ ) { push @INC, 'lib'; eval "use DBM::Deep"; $db = DBM::Deep->new( $output_filename ); diff --git a/utils/upgrade_db.pl b/utils/upgrade_db.pl index 91003c3..b1162cc 100755 --- a/utils/upgrade_db.pl +++ b/utils/upgrade_db.pl @@ -28,7 +28,7 @@ my %is_dev = ( my %opts = ( man => 0, help => 0, - version => '1.0013', + version => '1.0014', autobless => 1, ); GetOptions( \%opts, @@ -71,10 +71,7 @@ my %db; { my $ver = $opts{version}; - if ( $ver =~ /^1\.001[0-3]/) { - $ver = 3; - } - elsif ( $ver =~ /^1\.000[3-9]/) { + if ( $ver =~ /^1\.001[0-4]/ || $ver =~ /^1\.000[3-9]/) { $ver = 3; } elsif ( $ver =~ /^1\.000?[0-2]?/) {