From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 8 Aug 2009 15:40:19 +0000 (+0000)
Subject: A more straightforward txn_begin fix, some more test fixes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d68d84f81423572b0551f1ed14b1c6da627fbaea;p=dbsrgits%2FDBIx-Class-Historic.git

A more straightforward txn_begin fix, some more test fixes
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 094b508..8a0b8cc 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -530,15 +530,8 @@ sub dbh_do {
 
   local $self->{_in_dbh_do} = 1;
 
-  $self->_do_with_reconnect($code, @_);
-}
-
-sub _do_with_reconnect {
-  my $self = shift;
-  my $code = shift;
   my @result;
   my $want_array = wantarray;
-  my $dbh = $self->_dbh;
 
   eval {
     $self->_verify_pid if $dbh;
@@ -608,7 +601,7 @@ sub txn_do {
     my $exception = $@;
     if(!$exception) { return $want_array ? @result : $result[0] }
 
-    if($tried++ > 0 || $self->connected) {
+    if($tried++ || $self->connected) {
       eval { $self->txn_rollback };
       my $rollback_exception = $@;
       if($rollback_exception) {
@@ -1060,10 +1053,14 @@ sub txn_begin {
   if($self->{transaction_depth} == 0) {
     $self->debugobj->txn_begin()
       if $self->debug;
-    # this isn't ->_dbh-> because
-    #  we should reconnect on begin_work
-    #  for AutoCommit users
-    $self->_do_with_reconnect(sub { $_[1]->begin_work });
+
+    # being here implies we have AutoCommit => 1
+    # if the user is utilizing txn_do - good for
+    # him, otherwise we need to ensure that the
+    # $dbh is healthy on BEGIN
+    my $dbh_method = $self->{_in_dbh_do} ? '_dbh' : 'dbh';
+    $self->$dbh_method->begin_work;
+
   } elsif ($self->auto_savepoint) {
     $self->svp_begin;
   }
diff --git a/t/92storage_ping_count.t b/t/92storage_ping_count.t
index 9987283..9dddd64 100644
--- a/t/92storage_ping_count.t
+++ b/t/92storage_ping_count.t
@@ -1,20 +1,14 @@
 use strict;
 use warnings;  
 
-# Stolen from 76joins.t (a good test for this purpose)
-
 use Test::More;
 use lib qw(t/lib);
 use DBICTest;
 use Data::Dumper;
 use DBIC::SqlMakerTest;
 
-plan tests => 1;
-
 my $ping_count = 0;
 
-my $schema = DBICTest->init_schema();
-
 {
   local $SIG{__WARN__} = sub {};
   require DBIx::Class::Storage::DBI;
@@ -27,6 +21,19 @@ my $schema = DBICTest->init_schema();
   };
 }
 
+
+# We do not count pings during deploy() because of the flux
+# around sqlt. Eventually there should be no pings at all
+my $schema = DBICTest->init_schema( sqlite_use_file => 1, no_populate => 1 );
+
+TODO: {
+  local $TODO = 'Unable to fix before proper deploy() error handling';
+  is ($ping_count, 0, 'no _ping() calls during deploy');
+  $ping_count = 0;
+}
+
+DBICTest->populate_schema ($schema);
+
 # perform some operations and make sure they don't ping
 
 $schema->resultset('CD')->create({
@@ -52,3 +59,5 @@ $schema->txn_do(sub {
 });
 
 is $ping_count, 0, 'no _ping() calls';
+
+done_testing;