package DBM::Deep;
-##
-# DBM::Deep
-#
-# Description:
-# Multi-level database module for storing hash trees, arrays and simple
-# key/value pairs into FTP-able, cross-platform binary database files.
-#
-# Type `perldoc DBM::Deep` for complete documentation.
-#
-# Usage Examples:
-# my %db;
-# tie %db, 'DBM::Deep', 'my_database.db'; # standard tie() method
-#
-# my $db = new DBM::Deep( 'my_database.db' ); # preferred OO method
-#
-# $db->{my_scalar} = 'hello world';
-# $db->{my_hash} = { larry => 'genius', hashes => 'fast' };
-# $db->{my_array} = [ 1, 2, 3, time() ];
-# $db->{my_complex} = [ 'hello', { perl => 'rules' }, 42, 99 ];
-# push @{$db->{my_array}}, 'another value';
-# my @key_list = keys %{$db->{my_hash}};
-# print "This module " . $db->{my_complex}->[1]->{perl} . "!\n";
-#
-# Copyright:
-# (c) 2002-2006 Joseph Huckaby. All Rights Reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-##
-
use 5.006_000;
use strict;
use warnings;
-our $VERSION = q(0.99_04);
+our $VERSION = q(1.0000);
use Fcntl qw( :flock );
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. There is no maximum, but
-more than 32 isn't recommended.
+have. The default and minimum number this can be is 16. The maximum is 255, but
+more than 64 isn't recommended.
=item * pack_size
=item * small
-This uses 2-byte offsets, allowing for a maximum file size of 65K
+This uses 2-byte offsets, allowing for a maximum file size of 65 KB.
=item * medium (default)
-This uses 4-byte offsets, allowing for a maximum file size of 2G.
+This uses 4-byte offsets, allowing for a maximum file size of 4 GB.
=item * large
-This uses 8-byte offsets, allowing for a maximum file size of 16XB (exabytes).
+This uses 8-byte offsets, allowing for a maximum file size of 16 XB
+(exabytes). This can only be enabled if your Perl is compiled for 64-bit.
=back
=head1 LARGEFILE SUPPORT
If you have a 64-bit system, and your Perl is compiled with both LARGEFILE
-and 64-bit support, you I<may> be able to create databases larger than 2 GB.
+and 64-bit support, you I<may> be able to create databases larger than 4 GB.
DBM::Deep by default uses 32-bit file offset tags, but these can be changed
by specifying the 'pack_size' parameter when constructing the file.
parameters are per-file, meaning you can access 32-bit and 64-bit files, as
you choose.
-B<Note:> We have not personally tested files larger than 2 GB -- all my
+B<Note:> We have not personally tested files larger than 4 GB -- all my
systems have only a 32-bit Perl. However, I have received user reports that
-this does indeed work!
+this does indeed work.
=head1 LOW-LEVEL ACCESS
use 5.006_000;
use strict;
+use warnings;
-our $VERSION = q(0.99_04);
+our $VERSION = q(1.0000);
use Scalar::Util ();
# Setup file and tag signatures. These should never change.
sub SIG_FILE () { 'DPDB' }
sub SIG_HEADER () { 'h' }
-sub SIG_INTERNAL () { 'i' }
sub SIG_HASH () { 'H' }
sub SIG_ARRAY () { 'A' }
sub SIG_NULL () { 'N' }
sub SIG_INDEX () { 'I' }
sub SIG_BLIST () { 'B' }
sub SIG_FREE () { 'F' }
-sub SIG_KEYS () { 'K' }
sub SIG_SIZE () { 1 }
sub STALE_SIZE () { 1 }
# Please refer to the pack() documentation for further information
my %StP = (
- 1 => 'C', # Unsigned char value (no order specified, presumably ASCII)
+ 1 => 'C', # Unsigned char value (no order needed as it's just one byte)
2 => 'n', # Unsigned short in "network" (big-endian) order
4 => 'N', # Unsigned long in "network" (big-endian) order
8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
storage => undef,
}, $class;
+ # Never allow byte_size to be set directly.
+ delete $args->{byte_size};
if ( defined $args->{pack_size} ) {
if ( lc $args->{pack_size} eq 'small' ) {
$args->{byte_size} = 2;
# files. DO NOT decrease this value below 16, due to risk of recursive
# reindex overrun.
##
- if ( $self->{max_buckets} < 16 ) {
+ if ( !defined $self->{max_buckets}
+ || !length $self->{max_buckets}
+ || $self->{max_buckets} =~ /\D/
+ || $self->{max_buckets} < 16
+ ) {
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 to to 255 from '$self->{max_buckets}'\n";
+ $self->{max_buckets} = 255;
+ }
+
+ if ( !defined $self->{num_txns}
+ || !length $self->{num_txns}
+ || $self->{num_txns} =~ /\D/
+ || $self->{num_txns} < 2
+ ) {
+ warn "Floor of num_txns is 2. Setting to to 2 from '$self->{num_txns}'\n";
+ $self->{num_txns} = 2;
+ }
+ elsif ( $self->{num_txns} > 255 ) {
+ warn "Ceiling of num_txns is 255. Setting to to 255 from '$self->{num_txns}'\n";
+ $self->{num_txns} = 255;
+ }
if ( !$self->{digest} ) {
require Digest::MD5;
{
my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
+ my $this_header_version = 2;
sub _write_file_header {
my $self = shift;
- my $header_var = 1 + 1 + 1 + 4 + 4 * $self->num_txns + 3 * $self->byte_size;
+ my $nt = $self->num_txns;
+
+ my $header_var = 1 + 1 + 1 + 4 + 4 * $nt + 3 * $self->byte_size;
my $loc = $self->storage->request_space( $header_fixed + $header_var );
$self->storage->print_at( $loc,
SIG_FILE,
SIG_HEADER,
- pack('N', 1), # header version - at this point, we're at 9 bytes
- pack('N', $header_var), # header size
+ pack('N', $this_header_version), # At this point, we're at 9 bytes
+ 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->num_txns),
+ pack('C', $nt),
pack('N', 0 ), # Transaction activeness bitfield
- pack('N' . $self->num_txns, 0 x $self->num_txns ), # Transaction staleness counters
+ pack('N' . $nt, 0 x $nt ), # Transaction staleness counters
pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
pack($StP{$self->byte_size}, 0), # Start of free chain (index size)
);
+ #XXX Set these less fragilely
$self->set_trans_loc( $header_fixed + 3 );
- $self->set_chains_loc( $header_fixed + 3 + 4 + 4 * $self->num_txns );
+ $self->set_chains_loc( $header_fixed + 3 + 4 + 4 * $nt );
return;
}
unless ( $sig_header eq SIG_HEADER ) {
$self->storage->close;
- DBM::Deep->_throw_error( "Old file version found." );
+ DBM::Deep->_throw_error( "Pre-1.00 file version found" );
+ }
+
+ unless ( $header_version == $this_header_version ) {
+ $self->storage->close;
+ DBM::Deep->_throw_error(
+ "Wrong file version found - " . $header_version .
+ " - expected " . $this_header_version
+ );
}
my $buffer2 = $self->storage->read_at( undef, $size );
--- /dev/null
+# This test was contributed by Fedor Soreks, Jan 2007.
+
+use strict;
+use Test::More;
+
+plan skip_all => "You must set \$ENV{LONG_TESTS} >= 2 to run the superlong tests"
+ unless $ENV{LONG_TESTS} >= 2;
+
+use Test::Deep;
+use t::common qw( new_fh );
+
+plan tests => 2;
+
+use_ok( 'DBM::Deep' );
+
+diag "This test can take up to several hours to run. Please be VERY patient.";
+
+my ($fh, $filename) = new_fh();
+my $db = DBM::Deep->new(
+ file => $filename,
+ type => DBM::Deep->TYPE_HASH,
+);
+
+my $gigs = 2;
+
+##
+# put/get many keys
+##
+my $max_keys = 4_000_000;
+my $max_record_keys = 10;
+
+for my $key_no ( 0 .. $max_keys ) {
+ for my $rec_no ( 0 .. $max_record_keys ) {
+ $db->{"key_$key_no"}{"rec_key_$rec_no"} = "rec_val_$rec_no";
+ }
+
+ my $s = -s $filename;
+ print "$key_no: $s\n";
+
+ if ( $s > $gigs * 2**30) {
+ fail "DB file ($db_fn) size exceeds $gigs GB";
+ exit;
+ }
+}
+
+ok( 1, "We passed the test!" );
projects / dbsrgits/DBM-Deep.git / commitdiff