'Test::More' => '0.88',
'Test::Deep' => '0.095',
'Test::Warn' => '0.08',
+ 'Test::More' => '0.88', # done_testing
'Test::Exception' => '0.21',
'IO::Scalar' => '0.01',
},
- Avoid leaving temp files lying around (RT#32462)
- (RT #48031) Fixed bug with localized $, (Thanks, SPROUT!)
+1.0016 Feb 05 22:10:00 2010 PST
+ - (This version is compatible with 1.0015)
+ - New caveat in the docs explaining stale references (RT#42129)
+ - All included modules now have the same version in META.yml, so
+ the CPAN shell will no longer try to downgrade.
+ - Fixed bug in clear() for hashes (RT#50541)
+
+1.0015 Jan 25 22:05:00 2010 PST
+ - (This version is compatible with 1.0014)
+ - Fix deep recursion errors (RT#53575)
+ - Avoid leaving temp files lying around (RT#32462)
+ - (RT #48031) Fixed bug with localized $, (Thanks, SPROUT!)
+ - (RT #40782) Fixed bug when handling a key of '0' (Thanks Sterling!)
+
1.0014 Jun 13 23:15:00 2008 EST
- (This version is compatible with 1.0013)
- Fix for RT#36781 (t/44 has an unrequired dependency)
t/53_misc_transactions.t
t/54_output_punct_vars.t
t/55_recursion.t
+t/96_virtual_functions.t
t/97_dump_file.t
t/98_pod.t
t/99_pod_coverage.t
$engine->clear( $self );
};
my $e = $@;
- warn "$e\n" if $e;
+ warn "$e\n" if $e && DEBUG;
$self->unlock;
B<NOTE:> This does not affect importing because imports do a walk over the
reference to be imported in order to explicitly leave it untied.
+=head2 Stale References
+
+If you take a reference to an array or hash from the database, it is tied
+to the database itself. This means that if the datum in question is subsequently deleted from the database, the reference to it will point to
+an invalid location and unpredictable things will happen if you try to use
+it.
+
+So a seemingly innocuous piece of code like this:
+
+ my %hash = %{ $db->{some_hash} };
+
+can fail if another process deletes or clobbers C<< $db->{some_hash} >>
+while the data are being extracted, since S<C<%{ ... }>> is not atomic.
+(This actually happened.) The solution is to lock the database before
+reading the data:
+
+ $db->lock_exclusive;
+ my %hash = %{ $db->{some_hash} };
+ $db->unlock;
+
=head1 CODE COVERAGE
L<Devel::Cover> is used to test the code coverage of the tests. Below is the
---------------------------- ------ ------ ------ ------ ------ ------ ------
File stmt bran cond sub pod time total
---------------------------- ------ ------ ------ ------ ------ ------ ------
- blib/lib/DBM/Deep.pm 100.0 90.0 81.8 100.0 100.0 32.4 98.2
+ blib/lib/DBM/Deep.pm 100.0 89.1 82.9 100.0 100.0 32.5 98.1
blib/lib/DBM/Deep/Array.pm 100.0 94.4 100.0 100.0 100.0 5.2 98.8
- blib/lib/DBM/Deep/Engine.pm 100.0 92.9 100.0 100.0 100.0 7.5 100.0
- ...ib/DBM/Deep/Engine/DBI.pm 93.3 71.2 100.0 100.0 100.0 1.5 89.0
- ...b/DBM/Deep/Engine/File.pm 91.8 77.8 88.9 100.0 100.0 4.9 89.9
- blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 3.9 100.0
+ blib/lib/DBM/Deep/Engine.pm 100.0 92.9 100.0 100.0 100.0 7.4 100.0
+ ...ib/DBM/Deep/Engine/DBI.pm 95.0 73.1 100.0 100.0 100.0 1.5 90.4
+ ...b/DBM/Deep/Engine/File.pm 92.3 78.5 88.9 100.0 100.0 4.9 90.3
+ blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 3.8 100.0
.../lib/DBM/Deep/Iterator.pm 100.0 n/a n/a 100.0 100.0 0.0 100.0
- .../DBM/Deep/Iterator/DBI.pm 100.0 100.0 n/a 100.0 100.0 1.4 100.0
+ .../DBM/Deep/Iterator/DBI.pm 100.0 100.0 n/a 100.0 100.0 1.2 100.0
...DBM/Deep/Iterator/File.pm 92.5 84.6 n/a 100.0 66.7 0.6 90.0
...erator/File/BucketList.pm 100.0 75.0 n/a 100.0 66.7 0.4 93.8
...ep/Iterator/File/Index.pm 100.0 100.0 n/a 100.0 100.0 0.2 100.0
blib/lib/DBM/Deep/Null.pm 87.5 n/a n/a 75.0 n/a 0.0 83.3
blib/lib/DBM/Deep/Sector.pm 91.7 n/a n/a 83.3 0.0 6.7 74.4
...ib/DBM/Deep/Sector/DBI.pm 96.8 83.3 n/a 100.0 0.0 1.0 89.8
- ...p/Sector/DBI/Reference.pm 98.9 86.4 100.0 100.0 0.0 2.2 89.2
+ ...p/Sector/DBI/Reference.pm 100.0 95.5 100.0 100.0 0.0 2.2 91.2
...Deep/Sector/DBI/Scalar.pm 100.0 100.0 n/a 100.0 0.0 1.1 92.9
...b/DBM/Deep/Sector/File.pm 96.0 87.5 100.0 92.3 25.0 2.2 91.0
...Sector/File/BucketList.pm 98.2 85.7 83.3 100.0 0.0 3.3 89.4
...Deep/Sector/File/Index.pm 100.0 80.0 33.3 100.0 0.0 0.8 83.1
.../Deep/Sector/File/Null.pm 100.0 100.0 n/a 100.0 0.0 0.0 91.7
.../Sector/File/Reference.pm 100.0 90.0 80.0 100.0 0.0 1.4 91.5
- ...eep/Sector/File/Scalar.pm 98.3 87.5 n/a 100.0 0.0 0.8 91.5
+ ...eep/Sector/File/Scalar.pm 98.4 87.5 n/a 100.0 0.0 0.8 91.9
blib/lib/DBM/Deep/Storage.pm 100.0 n/a n/a 100.0 100.0 0.0 100.0
...b/DBM/Deep/Storage/DBI.pm 97.3 70.8 n/a 100.0 38.5 6.7 87.0
- .../DBM/Deep/Storage/File.pm 96.6 77.1 80.0 95.7 100.0 15.8 91.8
- Total 99.2 84.8 84.7 99.8 63.3 100.0 97.6
+ .../DBM/Deep/Storage/File.pm 96.6 77.1 80.0 95.7 100.0 16.0 91.8
+ Total 99.3 85.2 84.9 99.8 63.3 100.0 97.6
---------------------------- ------ ------ ------ ------ ------ ------ ------
=head1 MORE INFORMATION
=item * setup
+=item * clear
+
=item * begin_work
=item * commit
sub next_key { (shift)->NEXTKEY(@_) }
sub _clear {
- my $self = shift->_get_self;
+ my $self = shift;
while ( defined(my $key = $self->first_key) ) {
do {
my ($db_temp) = @_;
my $key = $self->first_key();
- while ($key) {
+ while (defined $key) {
my $value = $self->get($key);
$self->_copy_value( \$db_temp->{$key}, $value );
$key = $self->next_key($key);
use strict;
use warnings FATAL => 'all';
+no warnings 'recursion';
use base qw( DBM::Deep::Sector::File::Data );
$db->exists();
} qr/Cannot use an undefined array index/, "EXISTS fails on an undefined key";
}
-done_testing;
-__END__
+
# Bug reported by Mike Schilli
# Also, RT #29583 reported by HANENKAMP
$dbm_factory = new_dbm( type => DBM::Deep->TYPE_ARRAY );
}
done_testing;
+__END__
+{ # Make sure we do not trigger a deep recursion warning [RT #53575]
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ my ($fh, $filename) = new_fh();
+ my $db = DBM::Deep->new( file => $filename, fh => $fh, );
+ my $a = [];
+ my $tmp = $a;
+ for(1..100) {
+ ($tmp) = @$tmp = [];
+ }
+ ok eval {
+ $db->{""} = $a;
+ }, 'deep recursion in array assignment' or diag $@;
+ is $w, undef, 'no warnings with deep recursion in array assignment';
+}
+
+done_testing;
});
is(\$db->{x}, 'b', "and get at stuff in the database");
__END_FH__
+
+ # The exec below prevents END blocks from doing this.
+ (my $esc_dir = $t::common::dir) =~ s/(.)/sprintf "\\x{%x}", ord $1/egg;
+ print $fh <<__END_FH_AGAIN__;
+use File::Path 'rmtree';
+rmtree "$esc_dir";
+__END_FH_AGAIN__
+
print $fh "__DATA__\n";
close $fh;
while ( my $dbm_maker = $dbm_factory->() ) {
my $db = $dbm_maker->();
- my $val1 = "a" x 1000;
+ my $val1 = "a" x 6000;
$db->{foo} = $val1;
- is( $db->{foo}, $val1, "1000 char value stored and retrieved" );
+ is( $db->{foo}, $val1, "6000 char value stored and retrieved" );
# delete $db->{foo};
# my $size = -s $filename;
# If only I could use natatime(). *sighs*
while ( @methods ) {
my ($entry, $requirements) = splice @methods, 0, 2;
- if ( $entry eq 'clear' ) {
- diag "Please ignore the spurious die for clear. I can't figure out how to prevent it"
- }
while ( @$requirements ) {
my ($class, $child_method) = splice @$requirements, 0, 2;
use Fcntl qw( :flock );
my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
-my $dir = tempdir( CLEANUP => 1, DIR => $parent );
+our $dir = tempdir( CLEANUP => 1, DIR => $parent );
sub new_fh {
my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 );
projects / dbsrgits/DBM-Deep.git / commitdiff