'File::Path' => '0.01',
'File::Temp' => '0.01',
'Test::Deep' => '0.095',
+ 'Test::Warn' => '0.08',
'Test::More' => '0.47',
'Test::Exception' => '0.21',
},
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.
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
#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;
}
=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.
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
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
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
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
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
|| $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";
|| $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} ) {
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
#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;
=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
##
$|++;
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' );
}
{
+ 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";
SKIP: {
skip "Largefile support is not compiled into $^X", 3
- if 1; #unless $Config{ uselargefile };
+ unless $Config{ use64bitall };
my ($fh, $filename) = new_fh();
{
};
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__
--- /dev/null
+##
+# 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" );
+}
+++ /dev/null
-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} );
-}