From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 1 Feb 2013 06:50:15 +0000 (+0100)
Subject: Revert parts of 6864429a which utterly broke dbh_do() retries
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f6986ac3a13c85fbbf0f783f47daf9304a409e1;p=dbsrgits%2FDBIx-Class-Historic.git

Revert parts of 6864429a which utterly broke dbh_do() retries

Was never noticed because of undertesting, now should behave correctly
---

diff --git a/Changes b/Changes
index 80fc232..7b2e7e3 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for DBIx::Class
 
     * Fixes
+        - Fix dbh_do() failing to properly reconnect (regression in 0.08205)
         - Extra sanity check of a fresh DBI handle ($dbh). Fixes
           connection coderefs returning garbage (seen in the wild)
 
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index d46522b..527c2fb 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -793,25 +793,14 @@ sub dbh_do {
   return $self->$run_target($self->_get_dbh, @_)
     if $self->{_in_do_block} or $self->transaction_depth;
 
-  my $cref = (ref $run_target eq 'CODE')
-    ? $run_target
-    : $self->can($run_target) || $self->throw_exception(sprintf (
-      'Can\'t locate object method "%s" via package "%s"',
-      $run_target,
-      (ref $self || $self),
-    ))
-  ;
-
   # take a ref instead of a copy, to preserve @_ aliasing
   # semantics within the coderef, but only if needed
   # (pseudoforking doesn't like this trick much)
   my $args = @_ ? \@_ : [];
-  unshift @$args, $self, $self->_get_dbh;
 
   DBIx::Class::Storage::BlockRunner->new(
     storage => $self,
-    run_code => $cref,
-    run_args => $args,
+    run_code => sub { $self->$run_target ($self->_get_dbh, @$args ) },
     wrap_txn => 0,
     retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) },
   )->run;
diff --git a/t/storage/dbh_do.t b/t/storage/dbh_do.t
index 82e33d8..0beb858 100644
--- a/t/storage/dbh_do.t
+++ b/t/storage/dbh_do.t
@@ -9,6 +9,16 @@ use DBICTest;
 my $schema = DBICTest->init_schema();
 my $storage = $schema->storage;
 
+# test (re)connection
+for my $disconnect (0, 1) {
+  $schema->storage->_dbh->disconnect if $disconnect;
+  is_deeply (
+    $schema->storage->dbh_do(sub { $_[1]->selectall_arrayref('SELECT 1') }),
+    [ [ 1 ] ],
+    'dbh_do on fresh handle worked',
+  );
+}
+
 my @args;
 my $test_func = sub { @args = @_ };
 
@@ -31,9 +41,11 @@ is_deeply (
   [ $storage, $storage->dbh, "baz", "buz" ],
 );
 
-# test aliasing
+# test nested aliasing
 my $res = 'original';
-$storage->dbh_do (sub { $_[2] = 'changed' }, $res);
+$storage->dbh_do (sub {
+  shift->dbh_do(sub { $_[3] = 'changed' }, @_)
+}, $res);
 
 is ($res, 'changed', "Arguments properly aliased for dbh_do");