Change some defaults and the tests to match
rkinyon [Tue, 30 Jan 2007 03:16:24 +0000 (03:16 +0000)]
12 files changed:
Build.PL
Changes
MANIFEST
lib/DBM/Deep.pm
lib/DBM/Deep.pod
lib/DBM/Deep/Engine.pm
lib/DBM/Deep/Internals.pod
t/06_error.t
t/13_setpack.t
t/17_import.t
t/38_data_sector_size.t [new file with mode: 0644]
t/38_transaction_add_item.todo [deleted file]

index d636a23..55071fe 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -19,6 +19,7 @@ my $build = Module::Build->new(
         'File::Path'      => '0.01',
         'File::Temp'      => '0.01',
         'Test::Deep'      => '0.095',
+        'Test::Warn'      => '0.08',
         'Test::More'      => '0.47',
         'Test::Exception' => '0.21',
     },
diff --git a/Changes b/Changes
index 6b840a5..fbf5f95 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,11 +1,20 @@
 Revision history for DBM::Deep.
 
+1.0000 Jan ?? 22:30:00 2007 EDT
+    - THIS VERSION IS INCOMPATIBLE WITH FILES FROM ALL OTHER PRIOR VERSIONS.
+      - To aid in this form of upgrades, DBM::Deep now checks the file format
+        version to make sure that it knows how to read it.
+      - dpdb_upgrade_db.pl was added to scripts/.
+    - importing no longer takes place within a transaction
+    - The following parameters were added:
+      - data_sector_size - this determines the default size of a data sector.
+
 0.99_04 Jan 24 22:30:00 2007 EDT
     - Added the missing lib/DBM/Deep.pod file to the MANIFEST
     - Fixed a poorly-designed test that was failing depending on what Clone::Any
-    - was using.
+      was using.
     - All "use 5.6.0;" lines are now "use 5.006_000;" to avoid warnings about
-      unsupported vstrings in bleadperl.
+      unsupported vstrings in 5.9.x
 
 0.99_03 Jan 23 22:30:00 2007 EDT
     - THIS VERSION IS INCOMPATIBLE WITH FILES FROM ALL OTHER PRIOR VERSIONS.
index 0422ec9..bbc9e25 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -49,6 +49,7 @@ t/34_transaction_arrays.t
 t/35_transaction_multiple.t
 t/36_verybighash.t
 t/37_delete_edge_cases.t
+t/38_data_sector_size.t
 t/39_singletons.t
 t/40_freespace.t
 t/41_transaction_multilevel.t
index db76940..7a6bbcd 100644 (file)
@@ -216,11 +216,8 @@ sub import {
     #XXX but that's a lot more thinking than I want to do right now.
     eval {
         local $SIG{'__DIE__'};
-        $self->begin_work;
         $self->_import( Clone::clone( $struct ) );
-        $self->commit;
     }; if ( my $e = $@ ) {
-        $self->rollback;
         die $e;
     }
 
index 3bd15d3..701c70b 100644 (file)
@@ -202,9 +202,9 @@ from the values stored in the datafile's header.
 
 =item * num_txns
 
-This is the maximum number of transactions that can be running at one time. The
-default is two - the HEAD and one for imports. The minimum is two and the
-maximum is 255. The more transactions, the larger and quicker the datafile grows.
+This is the number of transactions that can be running at one time. The
+default is one - the HEAD. The minimum is one and the maximum is 255. The more
+transactions, the larger and quicker the datafile grows.
 
 See L</TRANSACTIONS> below.
 
@@ -212,7 +212,7 @@ See L</TRANSACTIONS> below.
 
 This is the number of entries that can be added before a reindexing. The larger
 this number is made, the larger a file gets, but the better performance you will
-have. The default and minimum number this can be is 16. The maximum is 255, but
+have. The default and minimum number this can be is 16. The maximum is 256, but
 more than 64 isn't recommended.
 
 =item * data_sector_size
@@ -225,7 +225,7 @@ have a lot of chaining. If it is too large, your file will have a lot of dead
 space in it.
 
 The default for this is 64 bytes. The minimum value is 32 and the maximum is
-255 bytes.
+256 bytes.
 
 B<Note:> There are between 5 and 9 bytes taken up in each data sector for
 bookkeeping. (It's 3 + the number of bytes in your L</pack_size>.) This is
@@ -614,12 +614,6 @@ B<Note:> Make sure your existing structure has no circular references in it.
 These will cause an infinite loop when importing. There are plans to fix this
 in a later release.
 
-B<Note:> With the addition of transactions, importing is performed within a
-transaction, then immediately committed upon success (and rolled back upon
-failre). As a result, you cannot call C<import()> from within a transaction.
-This restriction will be lifted when subtransactions are added in a future
-release.
-
 =head2 Exporting
 
 Calling the C<export()> method on an existing DBM::Deep object will return
@@ -1169,11 +1163,11 @@ B<Devel::Cover> report on this distribution's test suite.
   File                           stmt   bran   cond    sub    pod   time  total
   ---------------------------- ------ ------ ------ ------ ------ ------ ------
   blib/lib/DBM/Deep.pm           96.8   87.9   90.5  100.0   89.5    4.5   95.2
-  blib/lib/DBM/Deep/Array.pm    100.0   94.3  100.0  100.0  100.0    4.9   98.7
-  blib/lib/DBM/Deep/Engine.pm    96.9   85.2   79.7  100.0    0.0   58.2   90.3
-  blib/lib/DBM/Deep/File.pm      99.0   88.9   77.8  100.0    0.0   30.0   90.3
-  blib/lib/DBM/Deep/Hash.pm     100.0  100.0  100.0  100.0  100.0    2.4  100.0
-  Total                          97.6   87.9   84.0  100.0   32.1  100.0   92.8
+  blib/lib/DBM/Deep/Array.pm    100.0   94.3  100.0  100.0  100.0    4.8   98.7
+  blib/lib/DBM/Deep/Engine.pm    97.2   86.4   86.0  100.0    0.0   56.8   91.0
+  blib/lib/DBM/Deep/File.pm      98.1   83.3   66.7  100.0    0.0   31.4   88.0
+  blib/lib/DBM/Deep/Hash.pm     100.0  100.0  100.0  100.0  100.0    2.5  100.0
+  Total                          97.7   88.1   86.6  100.0   31.6  100.0   93.0
   ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 MORE INFORMATION
index 1eead43..65aa508 100644 (file)
@@ -49,7 +49,7 @@ sub new {
         hash_size   => 16,  # In bytes
         hash_chars  => 256, # Number of chars the algorithm uses per byte
         max_buckets => 16,
-        num_txns    => 2,   # HEAD plus 1 additional transaction for importing
+        num_txns    => 1,   # The HEAD
         trans_id    => 0,   # Default to the HEAD
 
         data_sector_size => 64, # Size in bytes of each data sector
@@ -92,21 +92,23 @@ sub new {
         || $self->{max_buckets} =~ /\D/
         || $self->{max_buckets} < 16
     ) {
+        $self->{max_buckets} = '(undef)' if !defined $self->{max_buckets};
         warn "Floor of max_buckets is 16. Setting it to 16 from '$self->{max_buckets}'\n";
         $self->{max_buckets} = 16;
     }
-    elsif ( $self->{max_buckets} > 255 ) {
-        warn "Ceiling of max_buckets is 255. Setting it to 255 from '$self->{max_buckets}'\n";
-        $self->{max_buckets} = 255;
+    elsif ( $self->{max_buckets} > 256 ) {
+        warn "Ceiling of max_buckets is 256. Setting it to 256 from '$self->{max_buckets}'\n";
+        $self->{max_buckets} = 256;
     }
 
     if (   !defined $self->{num_txns}
         || !length $self->{num_txns}
         || $self->{num_txns} =~ /\D/
-        || $self->{num_txns} < 2
+        || $self->{num_txns} < 1
     ) {
-        warn "Floor of num_txns is 2. Setting it to 2 from '$self->{num_txns}'\n";
-        $self->{num_txns} = 2;
+        $self->{num_txns} = '(undef)' if !defined $self->{num_txns};
+        warn "Floor of num_txns is 1. Setting it to 1 from '$self->{num_txns}'\n";
+        $self->{num_txns} = 1;
     }
     elsif ( $self->{num_txns} > 255 ) {
         warn "Ceiling of num_txns is 255. Setting it to 255 from '$self->{num_txns}'\n";
@@ -118,12 +120,13 @@ sub new {
         || $self->{data_sector_size} =~ /\D/
         || $self->{data_sector_size} < 32
     ) {
+        $self->{data_sector_size} = '(undef)' if !defined $self->{data_sector_size};
         warn "Floor of data_sector_size is 32. Setting it to 32 from '$self->{data_sector_size}'\n";
         $self->{data_sector_size} = 32;
     }
-    elsif ( $self->{data_sector_size} > 255 ) {
-        warn "Ceiling of data_sector_size is 255. Setting it to 255 from '$self->{data_sector_size}'\n";
-        $self->{data_sector_size} = 255;
+    elsif ( $self->{data_sector_size} > 256 ) {
+        warn "Ceiling of data_sector_size is 256. Setting it to 256 from '$self->{data_sector_size}'\n";
+        $self->{data_sector_size} = 256;
     }
 
     if ( !$self->{digest} ) {
@@ -585,8 +588,11 @@ sub clear_entries {
             pack('N', $header_var),        # header size
             # --- Above is $header_fixed. Below is $header_var
             pack('C', $self->byte_size),
-            pack('C', $self->max_buckets),
-            pack('C', $self->data_sector_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('N', 0 ),                   # Transaction activeness bitfield
             pack('N' . $nt, 0 x $nt ),       # Transaction staleness counters
@@ -644,6 +650,10 @@ sub clear_entries {
         #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 $header_var = scalar(@values) + 4 + 4 * $self->num_txns + 3 * $self->byte_size;
         unless ( $size == $header_var ) {
             $self->storage->close;
index 71a1b7e..02664b3 100644 (file)
@@ -57,17 +57,22 @@ This is the tagging of the file header. The file used by versions prior to
 
 =item * Version
 
-This is four bytes containing the header version. This lets the header change over time.
+This is four bytes containing the file version. This lets the file format change over time.
+
+=item * Constants
+
+These are the file-wide constants that determine how the file is laid out.
+They can only be set upon file creation.
 
 =item * Transaction information
 
 The current running transactions are stored here, as is the next transaction
 ID.
 
-=item * Constants
+=item * Freespace information
 
-These are the file-wide constants that determine how the file is laid out.
-They can only be set upon file creation.
+Pointers into the next free sectors of the various sector sizes (Index,
+Bucketlist, and Data) are stored here.
 
 =back
 
index d343d23..f60e4a5 100644 (file)
@@ -3,8 +3,9 @@
 ##
 $|++;
 use strict;
-use Test::More tests => 8;
+use Test::More tests => 23;
 use Test::Exception;
+use Test::Warn;
 use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
@@ -57,6 +58,75 @@ use_ok( 'DBM::Deep' );
 }
 
 {
+    my %floors = (
+        max_buckets => 16,
+        num_txns => 1,
+        data_sector_size => 32,
+    );
+
+    while ( my ($attr, $floor) = each %floors ) {
+        {
+            my ($fh, $filename) = new_fh();
+            warning_like {
+                my $db = DBM::Deep->new(
+                    file => $filename,
+                    $attr => undef,
+                );
+            } qr{Floor of $attr is $floor\. Setting it to $floor from '\Q(undef)\E'},
+             "Warning for $attr => undef is correct";
+        }
+        {
+            my ($fh, $filename) = new_fh();
+            warning_like {
+                my $db = DBM::Deep->new(
+                    file => $filename,
+                    $attr => '',
+                );
+            } qr{Floor of $attr is $floor\. Setting it to $floor from ''},
+             "Warning for $attr => '' is correct";
+        }
+        {
+            my ($fh, $filename) = new_fh();
+            warning_like {
+                my $db = DBM::Deep->new(
+                    file => $filename,
+                    $attr => 'abcd',
+                );
+            } qr{Floor of $attr is $floor\. Setting it to $floor from 'abcd'},
+             "Warning for $attr => 'abcd' is correct";
+        }
+        {
+            my ($fh, $filename) = new_fh();
+            my $val = $floor - 1;
+            warning_like {
+                my $db = DBM::Deep->new(
+                    file => $filename,
+                    $attr => $val,
+                );
+            } qr{Floor of $attr is $floor\. Setting it to $floor from '$val'},
+             "Warning for $attr => $val is correct";
+        }
+    }
+
+    my %ceilings = (
+        max_buckets => 256,
+        num_txns => 255,
+        data_sector_size => 256,
+    );
+
+    while ( my ($attr, $ceiling) = each %ceilings ) {
+        my ($fh, $filename) = new_fh();
+        warning_like {
+            my $db = DBM::Deep->new(
+                file => $filename,
+                $attr => 1000,
+            );
+        } qr{Ceiling of $attr is $ceiling\. Setting it to $ceiling from '1000'},
+          "Warning for $attr => 1000 is correct";
+    }
+}
+
+{
     throws_ok {
         DBM::Deep->new( 't/old_versions/db.0.983' );
     } qr/DBM::Deep: Pre-1.00 file version found/, "Fail if opening a pre-1.00 file";
index fe8be0f..9b468b4 100644 (file)
@@ -77,7 +77,7 @@ my ($default, $small, $medium, $large);
 
 SKIP: {
     skip "Largefile support is not compiled into $^X", 3
-        if 1; #unless $Config{ uselargefile };
+        unless $Config{ use64bitall };
 
     my ($fh, $filename) = new_fh();
     {
index 204be66..7792b6d 100644 (file)
@@ -109,13 +109,16 @@ use_ok( 'DBM::Deep' );
     };
     like( $@, qr/Storage of references of type 'SCALAR' is not supported/, 'Error message correct' );
 
-    cmp_deeply(
-        $db,
-        noclass({
-            foo => 'bar',
-        }),
-        "Everything matches",
-    );
+    TODO: {
+        local $TODO = "Importing cannot occur within a transaction yet.";
+        cmp_deeply(
+            $db,
+            noclass({
+                foo => 'bar',
+            }),
+            "Everything matches",
+        );
+    }
 }
 
 __END__
diff --git a/t/38_data_sector_size.t b/t/38_data_sector_size.t
new file mode 100644 (file)
index 0000000..8414066
--- /dev/null
@@ -0,0 +1,103 @@
+##
+# DBM::Deep Test
+##
+use strict;
+use Test::More tests => 8;
+
+use t::common qw( new_fh );
+
+use_ok( 'DBM::Deep' );
+
+my %sizes;
+
+{
+    my ($fh, $filename) = new_fh();
+    {
+        my $db = DBM::Deep->new(
+            file => $filename,
+            data_sector_size => 32,
+        );
+
+        do_stuff( $db );
+    }
+
+    $sizes{32} = -s $filename;
+
+    {
+        my $db = DBM::Deep->new( $filename );
+        verify( $db );
+    }
+}
+
+{
+    my ($fh, $filename) = new_fh();
+    {
+        my $db = DBM::Deep->new(
+            file => $filename,
+            data_sector_size => 64,
+        );
+
+        do_stuff( $db );
+    }
+
+    $sizes{64} = -s $filename;
+
+    {
+        my $db = DBM::Deep->new( $filename );
+        verify( $db );
+    }
+}
+
+{
+    my ($fh, $filename) = new_fh();
+    {
+        my $db = DBM::Deep->new(
+            file => $filename,
+            data_sector_size => 128,
+        );
+
+        do_stuff( $db );
+    }
+
+    $sizes{128} = -s $filename;
+
+    {
+        my $db = DBM::Deep->new( $filename );
+        verify( $db );
+    }
+}
+
+{
+    my ($fh, $filename) = new_fh();
+    {
+        my $db = DBM::Deep->new(
+            file => $filename,
+            data_sector_size => 256,
+        );
+
+        do_stuff( $db );
+    }
+
+    $sizes{256} = -s $filename;
+
+    {
+        my $db = DBM::Deep->new( $filename );
+        verify( $db );
+    }
+}
+
+cmp_ok( $sizes{256}, '>', $sizes{128}, "Filesize for 256 > filesize for 128" );
+cmp_ok( $sizes{128}, '>', $sizes{64}, "Filesize for 128 > filesize for 64" );
+cmp_ok( $sizes{64}, '>', $sizes{32}, "Filesize for 64 > filesize for 32" );
+
+sub do_stuff {
+    my ($db) = @_;
+
+    $db->{foo}{bar} = [ 1 .. 3 ];
+}
+
+sub verify {
+    my ($db) = @_;
+
+    cmp_ok( $db->{foo}{bar}[2], '==', 3, "Correct value found" );
+}
diff --git a/t/38_transaction_add_item.todo b/t/38_transaction_add_item.todo
deleted file mode 100644 (file)
index 4306e1b..0000000
+++ /dev/null
@@ -1,69 +0,0 @@
-use strict;
-use Test::More tests => 9;
-use Test::Deep;
-use t::common qw( new_fh );
-
-use_ok( 'DBM::Deep' );
-
-my ($fh, $filename) = new_fh();
-my $db = DBM::Deep->new(
-    file => $filename,
-    locking => 1,
-    autoflush => 1,
-    num_txns  => 16,
-);
-
-{
-    my $obj = bless {
-        foo => 5,
-    }, 'Foo';
-
-    cmp_ok( $obj->{foo}, '==', 5, "FOO is 5 in the object" );
-    ok( !exists $obj->{bar}, "BAR doesn't exist in the object" );
-
-    $db->begin_work;
-
-        $db->{foo} = $obj;
-        $db->{foo}{bar} = 1;
-
-        cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" );
-        cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" );
-
-    $db->rollback;
-
-TODO: {
-    local $TODO = "Adding items in transactions will be fixed soon";
-    local $^W;
-    cmp_ok( $obj->{foo}, '==', 5 );
-}
-    ok( !exists $obj->{bar}, "bar doesn't exist" );
-TODO: {
-    local $TODO = "Adding items in transactions will be fixed soon";
-    ok( !tied(%$obj), "And it's not tied" );
-}
-
-    ok( !exists $db->{foo}, "The transaction inside the DB works" );
-}
-
-__END__
-{
-    my $obj = bless {
-        foo => 5,
-    }, 'Foo';
-
-    cmp_ok( $obj->{foo}, '==', 5 );
-    ok( !exists $obj->{bar} );
-
-    $db->begin_work;
-
-        $db->{foo} = $obj;
-        $db->{foo}{bar} = 1;
-
-        cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" );
-        cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" );
-
-    $db->commit;
-
-    cmp_ok( $obj->{foo}, '==', 5 );
-    ok( !exists $obj->{bar} );
-}