From: rkinyon Date: Tue, 30 Jan 2007 03:16:24 +0000 (+0000) Subject: Change some defaults and the tests to match X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=811224a0a98aa8fd507d9fae68ca68300c531a36;p=dbsrgits%2FDBM-Deep.git Change some defaults and the tests to match --- diff --git a/Build.PL b/Build.PL index d636a23..55071fe 100644 --- 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 --- 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. diff --git a/MANIFEST b/MANIFEST index 0422ec9..bbc9e25 100644 --- 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 diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index db76940..7a6bbcd 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -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; } diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod index 3bd15d3..701c70b 100644 --- a/lib/DBM/Deep.pod +++ b/lib/DBM/Deep.pod @@ -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 below. @@ -212,7 +212,7 @@ See L 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 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.) This is @@ -614,12 +614,6 @@ B 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 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 from within a transaction. -This restriction will be lifted when subtransactions are added in a future -release. - =head2 Exporting Calling the C method on an existing DBM::Deep object will return @@ -1169,11 +1163,11 @@ B 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 diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 1eead43..65aa508 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -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; diff --git a/lib/DBM/Deep/Internals.pod b/lib/DBM/Deep/Internals.pod index 71a1b7e..02664b3 100644 --- a/lib/DBM/Deep/Internals.pod +++ b/lib/DBM/Deep/Internals.pod @@ -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 diff --git a/t/06_error.t b/t/06_error.t index d343d23..f60e4a5 100644 --- a/t/06_error.t +++ b/t/06_error.t @@ -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"; diff --git a/t/13_setpack.t b/t/13_setpack.t index fe8be0f..9b468b4 100644 --- a/t/13_setpack.t +++ b/t/13_setpack.t @@ -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(); { diff --git a/t/17_import.t b/t/17_import.t index 204be66..7792b6d 100644 --- a/t/17_import.t +++ b/t/17_import.t @@ -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 index 0000000..8414066 --- /dev/null +++ b/t/38_data_sector_size.t @@ -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 index 4306e1b..0000000 --- a/t/38_transaction_add_item.todo +++ /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} ); -}