Convert ::Reference to use a string in creation. This sparks an interesting debate...
rkinyon@cpan.org [Mon, 16 Jun 2008 01:14:06 +0000 (01:14 +0000)]
git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@3576 88f4d9cd-8a04-0410-9d60-8f63309c3137

14 files changed:
lib/DBM/Deep.pm
lib/DBM/Deep/Engine/Sector.pm
lib/DBM/Deep/Engine/Sector/BucketList.pm
lib/DBM/Deep/Engine/Sector/Data.pm
lib/DBM/Deep/Engine/Sector/Index.pm
lib/DBM/Deep/Engine/Sector/Null.pm
lib/DBM/Deep/Engine/Sector/Reference.pm
lib/DBM/Deep/Engine/Sector/Scalar.pm
lib/DBM/Deep/Iterator.pm
lib/DBM/Deep/Iterator/BucketList.pm
lib/DBM/Deep/Iterator/Index.pm
lib/DBM/Deep/Null.pm
t/44_upgrade_db.t
utils/upgrade_db.pl

index ace79c5..6a02caa 100644 (file)
@@ -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 );
index be079d0..5c9f3bc 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Engine::Sector;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index a083172..b76b2dd 100644 (file)
@@ -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';
index d39fac6..6448367 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Engine::Sector::Data;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index 8278f9a..149f271 100644 (file)
@@ -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';
index c97f0f5..c9570f5 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Engine::Sector::Null;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index b0b749d..0fd782a 100644 (file)
@@ -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;
 }
index 8984b94..d47d9f0 100644 (file)
@@ -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 );
 
index 1c9bd5f..6de0e05 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Iterator;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index 3f57868..9fa1cac 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Iterator::BucketList;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index 2052fa5..04df6d4 100644 (file)
@@ -1,6 +1,6 @@
 package DBM::Deep::Iterator::Index;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
index 35f1c83..6c63e4f 100644 (file)
@@ -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';
index 245f473..b42ca9e 100644 (file)
@@ -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 );
index 91003c3..b1162cc 100755 (executable)
@@ -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]?/) {