fix up txn_begin and the ping_count test

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 3c34088..094b508 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -441,14 +441,17 @@ sub connect_info {
     # _connect() never looks past $args[0] in this case
     %attrs = ()
   } else {
-    %attrs = (%{ $self->_dbi_connect_attributes }, %attrs);
+    %attrs = (
+      %{ $self->_default_dbi_connect_attributes || {} },
+      %attrs,
+    );
   }
 
   $self->_dbi_connect_info([@args, keys %attrs ? \%attrs : ()]);
   $self->_connect_info;
 }
 
-sub _dbi_connect_attributes {
+sub _default_dbi_connect_attributes {
   return { AutoCommit => 1 };
 }
 
@@ -527,8 +530,15 @@ 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;
@@ -667,6 +677,22 @@ sub with_deferred_fk_checks {
   $sub->();
 }
 
+=head2 connected
+
+=over
+
+=item Arguments: none
+
+=item Return Value: 1|0
+
+=back
+
+Verifies that the the current database handle is active and ready to execute
+an SQL statement (i.e. the connection did not get stale, server is still
+answering, etc.) This method is used internally by L</dbh>.
+
+=cut
+
 sub connected {
   my ($self) = @_;
 
@@ -718,7 +744,9 @@ sub ensure_connected {
 
 =head2 dbh
 
-Returns the dbh - a data base handle of class L<DBI>.
+Returns a C<$dbh> - a data base handle of class L<DBI>. The returned handle
+is guaranteed to be healthy by implicitly calling L</connected>, and if
+necessary performing a reconnection before returning.
 
 =cut
 
@@ -733,12 +761,19 @@ sub dbh {
   return $self->_dbh;
 }
 
-sub _get_dbh {
-  my $self = shift;
+=head2 last_dbh
 
-  if (not $self->_dbh) {
-    $self->_populate_dbh;
-  }
+This returns the B<last> available C<$dbh> if any, or attempts to
+connect and returns the resulting handle. This method differs from
+L</dbh> by not validating if a preexisting handle is still healthy
+via L</connected>. Make sure you take appropriate precautions
+when using this method, as the C<$dbh> may be useless at this point.
+
+=cut
+
+sub last_dbh {
+  my $self = shift;
+  $self->_populate_dbh unless $self->_dbh;
   return $self->_dbh;
 }
 
@@ -748,7 +783,7 @@ sub _sql_maker_args {
     return (
       bindtype=>'columns',
       array_datatypes => 1,
-      limit_dialect => $self->_get_dbh,
+      limit_dialect => $self->last_dbh,
       %{$self->_sql_maker_opts}
     );
 }
@@ -1028,7 +1063,7 @@ sub txn_begin {
     # this isn't ->_dbh-> because
     #  we should reconnect on begin_work
     #  for AutoCommit users
-    $self->dbh_do(sub { $_[1]->begin_work });
+    $self->_do_with_reconnect(sub { $_[1]->begin_work });
   } elsif ($self->auto_savepoint) {
     $self->svp_begin;
   }
@@ -1203,7 +1238,7 @@ sub insert {
         $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
           'nextval',
           $col_info->{sequence} ||
-            $self->_dbh_get_autoinc_seq($self->_get_dbh, $source)
+            $self->_dbh_get_autoinc_seq($self->last_dbh, $source)
         );
       }
     }
@@ -1993,7 +2028,7 @@ Returns the database driver name.
 
 =cut
 
-sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
+sub sqlt_type { shift->last_dbh->{Driver}->{Name} }
 
 =head2 bind_attribute_by_data_type
 
@@ -2240,7 +2275,7 @@ See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>.
 sub deployment_statements {
   my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
   # Need to be connected to get the correct sqlt_type
-  $self->_get_dbh() unless $type;
+  $self->last_dbh() unless $type;
   $type ||= $self->sqlt_type;
   $version ||= $schema->schema_version || '1.x';
   $dir ||= './';
@@ -2285,7 +2320,10 @@ sub deploy {
     return if $line =~ /^\s+$/; # skip whitespace only
     $self->_query_start($line);
     eval {
-      $self->_get_dbh->do($line);
+      # a previous error may invalidate $dbh - thus we need to use dbh()
+      # to guarantee a healthy $dbh (this is temporary until we get
+      # proper error handling on deploy() )
+      $self->dbh->do($line);
     };
     if ($@) {
       carp qq{$@ (running "${line}")};
@@ -2314,7 +2352,7 @@ Returns the datetime parser class
 sub datetime_parser {
   my $self = shift;
   return $self->{datetime_parser} ||= do {
-    $self->_get_dbh;
+    $self->last_dbh;
     $self->build_datetime_parser(@_);
   };
 }
@@ -2398,7 +2436,7 @@ sub DESTROY {
 
 DBIx::Class can do some wonderful magic with handling exceptions,
 disconnections, and transactions when you use C<< AutoCommit => 1 >>
-combined with C<txn_do> for transaction support.
+(the default) combined with C<txn_do> for transaction support.
 
 If you set C<< AutoCommit => 0 >> in your connect info, then you are always
 in an assumed transaction between commits, and you're telling us you'd
@@ -2410,7 +2448,6 @@ cases if you choose the C<< AutoCommit => 0 >> path, just as you would
 be with raw DBI.
 
 
-
 =head1 AUTHORS
 
 Matt S. Trout <mst@shadowcatsystems.co.uk>