From: Rob Kinyon <rob.kinyon@gmail.com>
Date: Sun, 14 Feb 2010 17:42:13 +0000 (-0500)
Subject: Apply some changes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8385c429c0fb14033edd484e9daf138cd799c432;p=dbsrgits%2FDBM-Deep.git

Apply some changes
---

diff --git a/Build.PL b/Build.PL
index 758f756..02a2d47 100644
--- a/Build.PL
+++ b/Build.PL
@@ -3,26 +3,31 @@ use Module::Build 0.28; # for prepare_metadata
 use strict;
 use warnings FATAL => 'all';
 
-my $class = Module::Build->subclass(
+my $build = Module::Build->subclass(
     class => "Module::Build::Custom",
-    code => <<'SUBCLASS' );
-
-sub ACTION_test {
-    my $self = shift;
-    if ( $self->notes('TEST_MYSQL_DSN') ) {
-        $ENV{$_} = $self->notes($_) for qw(
-            TEST_MYSQL_DSN TEST_MYSQL_USER TEST_MYSQL_PASS
-        );
-    }
-    foreach my $name ( qw( LONG_TESTS TEST_SQLITE ) ) {
-        $ENV{$name} = 1 if $self->notes( $name );
-    }
+    code => '
+        sub prepare_metadata {
+            my $node = shift->SUPER::prepare_metadata(@_);
+            my $ver = $node->{version};
+            $_->{version} = $ver for values %{$node->{provides}};
+            $node;
+        }
 
-    $self->SUPER::ACTION_test( @_ );
-}
-SUBCLASS
+        sub ACTION_test {
+            my $self = shift;
+            if ( $self->notes('TEST_MYSQL_DSN') ) {
+                $ENV{$_} = $self->notes($_) for qw(
+                    TEST_MYSQL_DSN TEST_MYSQL_USER TEST_MYSQL_PASS
+                );
+            }
+            foreach my $name ( qw( LONG_TESTS TEST_SQLITE ) ) {
+                $ENV{$name} = 1 if $self->notes( $name );
+            }
 
-my $build = $class->new(
+            $self->SUPER::ACTION_test( @_ );
+        }
+    ',
+)->new(
     module_name => 'DBM::Deep',
     license => 'perl',
     requires => {
diff --git a/Changes b/Changes
index 5576df8..4b51f1c 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,4 @@
-Revision history for DBM::Deep.
+Revision history for DBM::Deep (ordered by revision number).
 
 1.0019_003 Jan XX XX:XX:00 2010 EST
     (This is the third developer release for 1.0020.)
@@ -47,6 +47,19 @@ Revision history for DBM::Deep.
     - Hopefully, this multi-engine support will allow deprecation of the file
       format in the future.
 
+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!)
+
 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)
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 7640810..3458bc2 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings FATAL => 'all';
 
-our $VERSION = q(1.0019_002);
+our $VERSION = q(1.0019_003);
 
 use Scalar::Util ();
 
@@ -163,7 +163,7 @@ sub _copy_value {
             __PACKAGE__->_throw_error( "Unknown type for '$value'" );
         }
 
-        if ( eval { local $SIG{__DIE__}; $tied->isa( __PACKAGE__ ) } ) {
+        if ( eval { local $SIG{'__DIE__'}; $tied->isa( __PACKAGE__ ) } ) {
             ${$spot} = $tied->_repr;
             $tied->_copy_node( ${$spot} );
         }
@@ -412,7 +412,10 @@ sub supports {
 sub begin_work {
     my $self = shift->_get_self;
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->begin_work( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->begin_work( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -422,7 +425,10 @@ sub begin_work {
 sub rollback {
     my $self = shift->_get_self;
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->rollback( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->rollback( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -432,7 +438,10 @@ sub rollback {
 sub commit {
     my $self = shift->_get_self;
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->commit( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->commit( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -490,6 +499,7 @@ sub STORE {
     }
 
     eval {
+        local $SIG{'__DIE__'};
         $self->_engine->write_value( $self, $key, $value );
     }; if ( my $e = $@ ) {
         $self->unlock;
diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod
index 8fcba6f..ea44fc7 100644
--- a/lib/DBM/Deep.pod
+++ b/lib/DBM/Deep.pod
@@ -1060,8 +1060,28 @@ returns a new, blessed and tied hash or array to the same level in the DB.
 
   my $copy = $db->clone();
 
-B<Note>: Since clone() here is cloning the object, not the database location, any
-modifications to either $db or $copy will be visible to both.
+B<Note>: Since clone() here is cloning the object, not the database location,
+any modifications to either $db or $copy will be visible to both.
+
+=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 subsequentl
+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;
 
 =head2 Large Arrays
 
diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 247d730..252a5b8 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -4,8 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
-
-our $VERSION = $DBM::Deep::VERSION;
+no warnings 'recursion';
 
 # This is to allow DBM::Deep::Array to handle negative indices on
 # its own. Otherwise, Perl would intercept the call to negative
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 84f1a6c..7ebeb40 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -4,8 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
-
-our $VERSION = $DBM::Deep::VERSION;
+no warnings 'recursion';
 
 use DBM::Deep::Iterator ();
 
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index ec7a7a7..1671788 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -4,8 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
-
-our $VERSION = $DBM::Deep::VERSION;
+no warnings 'recursion';
 
 use base 'DBM::Deep';