r12193@rob-kinyons-computer-2 (orig r10512): rkinyon | 2008-01-10 23:43:35 -0500
Fixes for 1.0007
'FileHandle::Fmode' => '0.05',
},
optional => {
+ 'Pod::Usage' => '1.3',
},
build_requires => {
'File::Path' => '0.01',
Revision history for DBM::Deep.
+1.0007 Jan 10 00:00:00 2008 EDT
+ - (This version is compatible with 1.0006)
+ - Applied a patch+failing test submitted by sprout@cpan.org. Thanks!
+ - Turns out that the case of 17 keys with the same first character in the
+ MD5 hash wasn't being tested for. This was a crashbug.
+ - A fix has been made to upgrade_db.pl (RT# 30067)
+ - The version determinations were in the wrong order or evaluation. This
+ meant that upgrade_db.pl wouldn't work as expected (or at all).
+ - Added a minimum Pod::Usage requirement (RT# 29976)
+ - It's an optional item in Build.PL
+ - utils/upgrade_db.pl now checks for that version, as does the test.
+
1.0006 Oct 01 23:15:00 2007 EDT
- (This version is compatible with 1.0005)
- Removed Clone and replaced it with a hand-written datastructure walker.
t/43_transaction_maximum.t
t/44_upgrade_db.t
t/45_references.t
+t/46_blist_reindex.t
t/97_dump_file.t
t/98_pod.t
t/99_pod_coverage.t
use strict;
use warnings;
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
use Fcntl qw( :flock );
use strict;
use warnings;
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
# This is to allow DBM::Deep::Array to handle negative indices on
# its own. Otherwise, Perl would intercept the call to negative
use strict;
use warnings;
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
use Scalar::Util ();
$sector->find_md5( $args->{key_md5} );
# See whether or not we need to reindex the bucketlist
- if ( !$sector->has_md5 && $args->{create} && $sector->{idx} == -1 ) {
+ # Yes, the double-braces are there for a reason. if() doesn't create a redo-able block,
+ # so we have to create a bare block within the if() for redo-purposes. Patch and idea
+ # submitted by sprout@cpan.org. -RobK, 2008-01-09
+ if ( !$sector->has_md5 && $args->{create} && $sector->{idx} == -1 ) {{
+ my $redo;
+
my $new_index = DBM::Deep::Engine::Sector::Index->new({
engine => $engine,
});
# Handle the new item separately.
{
my $idx = ord( substr( $args->{key_md5}, $i, 1 ) );
- my $blist = $blist_cache{$idx}
- ||= DBM::Deep::Engine::Sector::BucketList->new({
- engine => $engine,
- });
-
- $new_index->set_entry( $idx => $blist->offset );
- #XXX THIS IS HACKY!
- $blist->find_md5( $args->{key_md5} );
- $blist->write_md5({
- key => $args->{key},
- key_md5 => $args->{key_md5},
- value => DBM::Deep::Engine::Sector::Null->new({
- engine => $engine,
- data => undef,
- }),
- });
+ # If all the previous blist's items have been thrown into one
+ # blist and the new item belongs in there too, we need
+ # another index.
+ if ( keys %blist_cache == 1 and each %blist_cache == $idx ) {
+ ++$i, ++$redo;
+ } else {
+ my $blist = $blist_cache{$idx}
+ ||= DBM::Deep::Engine::Sector::BucketList->new({
+ engine => $engine,
+ });
+
+ $new_index->set_entry( $idx => $blist->offset );
+
+ #XXX THIS IS HACKY!
+ $blist->find_md5( $args->{key_md5} );
+ $blist->write_md5({
+ key => $args->{key},
+ key_md5 => $args->{key_md5},
+ value => DBM::Deep::Engine::Sector::Null->new({
+ engine => $engine,
+ data => undef,
+ }),
+ });
+ }
+# my $blist = $blist_cache{$idx}
+# ||= DBM::Deep::Engine::Sector::BucketList->new({
+# engine => $engine,
+# });
+#
+# $new_index->set_entry( $idx => $blist->offset );
+#
+# #XXX THIS IS HACKY!
+# $blist->find_md5( $args->{key_md5} );
+# $blist->write_md5({
+# key => $args->{key},
+# key_md5 => $args->{key_md5},
+# value => DBM::Deep::Engine::Sector::Null->new({
+# engine => $engine,
+# data => undef,
+# }),
+# });
}
if ( $last_sector ) {
$sector->clear;
$sector->free;
+ if ( $redo ) {
+ (undef, $sector) = %blist_cache;
+ $last_sector = $new_index;
+ redo;
+ }
+
$sector = $blist_cache{ ord( substr( $args->{key_md5}, $i, 1 ) ) };
$sector->find_md5( $args->{key_md5} );
- }
+ }}
return $sector;
}
use strict;
use warnings;
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
use Fcntl qw( :DEFAULT :flock :seek );
use strict;
use warnings;
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
use base 'DBM::Deep';
# Add skips here
BEGIN {
my @failures;
- eval { use Pod::Usage; }; push @failures, 'Pod::Usage' if $@;
+ eval { use Pod::Usage 1.3; }; push @failures, 'Pod::Usage' if $@;
eval { use IO::Scalar; }; push @failures, 'IO::Scalar' if $@;
if ( @failures ) {
my $missing = join ',', @failures;
}
}
-plan tests => 222;
+plan tests => 232;
use t::common qw( new_fh );
use File::Spec;
"Input is not a DBM::Deep file",
);
+unlink $input_filename;unlink $output_filename;
+
# All files are of the form:
# $db->{foo} = [ 1 .. 3 ];
'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.0003', '1.0004', '1.0005', '1.0006', '1.0007',
);
foreach my $input_filename (
die "$output\n" if $output;
my $db;
- if ( $v =~ /^0/ ) {
- push @INC, File::Spec->catdir( 'utils', 'lib' );
- eval "use DBM::Deep::09830";
- $db = DBM::Deep::09830->new( $output_filename );
+ if ( $v =~ /^1\.000[3-7]/ ) {
+ push @INC, 'lib';
+ eval "use DBM::Deep";
+ $db = DBM::Deep->new( $output_filename );
}
elsif ( $v =~ /^1\.000?[0-2]?/ ) {
push @INC, File::Spec->catdir( 'utils', 'lib' );
eval "use DBM::Deep::10002";
$db = DBM::Deep::10002->new( $output_filename );
}
- elsif ( $v =~ /^1\.000[3-6]/ ) {
- push @INC, 'lib';
- eval "use DBM::Deep";
- $db = DBM::Deep->new( $output_filename );
+ elsif ( $v =~ /^0/ ) {
+ push @INC, File::Spec->catdir( 'utils', 'lib' );
+ eval "use DBM::Deep::09830";
+ $db = DBM::Deep::09830->new( $output_filename );
}
else {
die "How did we get here?!\n";
--- /dev/null
+# This test (and accompanying patch) was submitted by Father Chrysostomos (sprout@cpan.org)
+
+use 5.006;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More tests => 5;
+
+use t::common qw( new_fh );
+
+use_ok( 'DBM::Deep' );
+
+{
+ my ($fh, $filename) = new_fh();
+ my $db = DBM::Deep->new( $filename );
+
+ ok eval {
+ for ( # the checksums of all these begin with ^@:
+ qw/ s340l 1970 thronos /,
+ "\320\277\320\276\320\262\320\265\320\273\320\265\320\275".
+ "\320\275\320\276\320\265", qw/ mr094 despite
+ geographically binding bed handmaiden infer lela infranarii
+ lxv evtropia recognizes maladies /
+ ) {
+ $db->{$_} = undef;
+ }
+ 1;
+ }, '2 indices can be created at once';
+
+ is_deeply [sort keys %$db], [ sort
+ qw/ s340l 1970 thronos /,
+ "\320\277\320\276\320\262\320\265\320\273\320\265\320\275".
+ "\320\275\320\276\320\265", qw/ mr094 despite
+ geographically binding bed handmaiden infer lela infranarii
+ lxv evtropia recognizes maladies /
+ ], 'and the keys were stored correctly';
+}
+
+{
+ my ($fh, $filename) = new_fh();
+ my $db = DBM::Deep->new( $filename );
+
+ ok eval {
+ for ( # the checksums of all these begin with ^@^@^@:
+ qw/ dzqtz aqkdqz cxzysd czclmy ktajsi kvlybo kyxowd lvlsda
+ lyzfdi mbethb mcoqeq VMPJC ATZMZZ AXXJDX BXUUFN EIVTII
+ FMOKOI HITVDG JSSJSZ JXQPFK LCVVXW /
+ ) {
+ $db->{$_} = undef;
+ }
+ 1;
+ }, 'multiple nested indices can be created at once';
+
+ is_deeply [sort keys %$db], [ sort
+ qw/ dzqtz aqkdqz cxzysd czclmy ktajsi kvlybo kyxowd lvlsda
+ lyzfdi mbethb mcoqeq VMPJC ATZMZZ AXXJDX BXUUFN EIVTII
+ FMOKOI HITVDG JSSJSZ JXQPFK LCVVXW /
+ ], 'and the keys were stored correctly';
+}
+
+__END__
-package t::common;
+package # Hide from PAUSE
+ t::common;
use 5.006_000;
my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
my $dir = tempdir( CLEANUP => 1, DIR => $parent );
+#my $dir = tempdir( DIR => '.' );
sub new_fh {
my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir );
1;
__END__
-
use lib File::Spec->catdir( $FindBin::Bin, '..', 'lib' );
use Getopt::Long qw( GetOptions );
-use Pod::Usage;
+use Pod::Usage 1.3;
my %headerver_to_module = (
'0' => 'DBM::Deep::09830',
my %opts = (
man => 0,
help => 0,
- version => '1.0006',
+ version => '1.0007',
autobless => 1,
);
GetOptions( \%opts,
{
my $ver = $opts{version};
- if ( $ver =~ /^0\.9[1-8]/ ) {
- $ver = 0;
- }
- elsif ( $ver =~ /^0\.99/) {
- $ver = 1;
+ if ( $ver =~ /^1\.000[3-7]/) {
+ $ver = 3;
}
elsif ( $ver =~ /^1\.000?[0-2]?/) {
$ver = 2;
}
- elsif ( $ver =~ /^1\.000[3-6]/) {
- $ver = 3;
+ elsif ( $ver =~ /^0\.99/) {
+ $ver = 1;
+ }
+ elsif ( $ver =~ /^0\.9[1-8]/ ) {
+ $ver = 0;
}
else {
_exit( "'$ver' is an unrecognized version." );
projects / dbsrgits/DBM-Deep.git / commitdiff