Merge 'trunk' into 'sybase'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 7a7bd60..a872e95 100644 (file)
@@ -441,15 +441,22 @@ 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 {
-  return { AutoCommit => 1 };
+sub _default_dbi_connect_attributes {
+  return {
+    AutoCommit => 1,
+    RaiseError => 1,
+    PrintError => 0,
+  };
 }
 
 =head2 on_connect_do
@@ -548,6 +555,7 @@ sub dbh_do {
     }
   };
 
+  # ->connected might unset $@ - copy
   my $exception = $@;
   if(!$exception) { return $want_array ? @result : $result[0] }
 
@@ -555,6 +563,8 @@ sub dbh_do {
 
   # We were not connected - reconnect and retry, but let any
   #  exception fall right through this time
+  carp "Retrying $code after catching disconnected exception: $exception"
+    if $ENV{DBIC_DBIRETRY_DEBUG};
   $self->_populate_dbh;
   $self->$code($self->_dbh, @_);
 }
@@ -595,10 +605,11 @@ sub txn_do {
       $self->txn_commit;
     };
 
+    # ->connected might unset $@ - copy
     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) {
@@ -616,6 +627,8 @@ sub txn_do {
 
     # We were not connected, and was first try - reconnect and retry
     # via the while loop
+    carp "Retrying $coderef after catching disconnected exception: $exception"
+      if $ENV{DBIC_DBIRETRY_DEBUG};
     $self->_populate_dbh;
   }
 }
@@ -638,7 +651,8 @@ sub disconnect {
 
     $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
 
-    $self->_dbh->rollback unless $self->_dbh_autocommit;
+    $self->_dbh_rollback unless $self->_dbh_autocommit;
+
     $self->_dbh->disconnect;
     $self->_dbh(undef);
     $self->{_dbh_gen}++;
@@ -667,23 +681,49 @@ 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) = @_;
+  my $self = shift;
+  return 0 unless $self->_seems_connected;
 
-  if(my $dbh = $self->_dbh) {
-      if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
-          $self->_dbh(undef);
-          $self->{_dbh_gen}++;
-          return;
-      }
-      else {
-          $self->_verify_pid;
-          return 0 if !$self->_dbh;
-      }
-      return ($dbh->FETCH('Active') && $self->_ping);
+  #be on the safe side
+  local $self->_dbh->{RaiseError} = 1;
+
+  return $self->_ping;
+}
+
+sub _seems_connected {
+  my $self = shift;
+
+  my $dbh = $self->_dbh
+    or return 0;
+
+  if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
+    $self->_dbh(undef);
+    $self->{_dbh_gen}++;
+    return 0;
+  }
+  else {
+    $self->_verify_pid;
+    return 0 if !$self->_dbh;
   }
 
-  return 0;
+  return $dbh->FETCH('Active');
 }
 
 sub _ping {
@@ -718,7 +758,11 @@ 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. Keep in mind that this
+is very B<expensive> on some database engines. Consider using L<dbh_do>
+instead.
 
 =cut
 
@@ -733,12 +777,10 @@ sub dbh {
   return $self->_dbh;
 }
 
+# this is the internal "get dbh or connect (don't check)" method
 sub _get_dbh {
   my $self = shift;
-
-  if (not $self->_dbh) {
-    $self->_populate_dbh;
-  }
+  $self->_populate_dbh unless $self->_dbh;
   return $self->_dbh;
 }
 
@@ -769,6 +811,7 @@ sub _populate_dbh {
   my ($self) = @_;
 
   my @info = @{$self->_dbi_connect_info || []};
+  $self->_dbh(undef); # in case ->connected failed we might get sent here
   $self->_dbh($self->_connect(@info));
 
   $self->_conn_pid($$);
@@ -796,18 +839,19 @@ sub _run_connection_actions {
 sub _determine_driver {
   my ($self) = @_;
 
-  if (not $self->_driver_determined) {
-    if (ref($self) eq __PACKAGE__) {
-      my $driver;
+  if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
     my $started_unconnected = 0;
     local $self->{_in_determine_driver} = 1;
 
+    if (ref($self) eq __PACKAGE__) {
+      my $driver;
       if ($self->_dbh) { # we are connected
         $driver = $self->_dbh->{Driver}{Name};
       } else {
         # try to use dsn to not require being connected, the driver may still
         # force a connection in _rebless to determine version
         ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+        $started_unconnected = 1;
       }
 
       my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
@@ -816,7 +860,6 @@ sub _determine_driver {
         bless $self, $storage_class;
         $self->_rebless();
       }
-      $started_unconnected = 1;
     }
 
     $self->_driver_determined(1);
@@ -1025,23 +1068,31 @@ 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->dbh_do(sub { $_[1]->begin_work });
-  } elsif ($self->auto_savepoint) {
+    $self->_dbh_begin_work;
+  }
+  elsif ($self->auto_savepoint) {
     $self->svp_begin;
   }
   $self->{transaction_depth}++;
 }
 
+sub _dbh_begin_work {
+  my $self = shift;
+  # 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;
+}
+
 sub txn_commit {
   my $self = shift;
   if ($self->{transaction_depth} == 1) {
     my $dbh = $self->_dbh;
     $self->debugobj->txn_commit()
       if ($self->debug);
-    $dbh->commit;
+    $self->_dbh_commit;
     $self->{transaction_depth} = 0
       if $self->_dbh_autocommit;
   }
@@ -1052,6 +1103,11 @@ sub txn_commit {
   }
 }
 
+sub _dbh_commit {
+  my $self = shift;
+  $self->_dbh->commit;
+}
+
 sub txn_rollback {
   my $self = shift;
   my $dbh = $self->_dbh;
@@ -1061,7 +1117,7 @@ sub txn_rollback {
         if ($self->debug);
       $self->{transaction_depth} = 0
         if $self->_dbh_autocommit;
-      $dbh->rollback;
+      $self->_dbh_rollback;
     }
     elsif($self->{transaction_depth} > 1) {
       $self->{transaction_depth}--;
@@ -1084,6 +1140,11 @@ sub txn_rollback {
   }
 }
 
+sub _dbh_rollback {
+  my $self = shift;
+  $self->_dbh->rollback;
+}
+
 # This used to be the top-half of _execute.  It was split out to make it
 #  easier to override in NoBindVars without duping the rest.  It takes up
 #  all of _execute's args, and emits $sql, @bind.
@@ -1284,12 +1345,17 @@ sub insert_bulk {
 }
 
 sub update {
-  my $self = shift @_;
-  my $source = shift @_;
-  $self->_determine_driver;
+  my ($self, $source, @args) = @_; 
+
+# redispatch to update method of storage we reblessed into, if necessary
+  if (not $self->_driver_determined) {
+    $self->_determine_driver;
+    goto $self->can('update');
+  }
+
   my $bind_attributes = $self->source_bind_attributes($source);
 
-  return $self->_execute('update' => [], $source, $bind_attributes, @_);
+  return $self->_execute('update' => [], $source, $bind_attributes, @args);
 }
 
 
@@ -1821,6 +1887,21 @@ sub _subq_count_select {
   return @pcols ? \@pcols : [ 1 ];
 }
 
+#
+# Returns an ordered list of column names before they are used
+# in a SELECT statement. By default simply returns the list
+# passed in.
+#
+# This may be overridden in a specific storage when there are
+# requirements such as moving BLOB columns to the end of the 
+# SELECT list.
+sub _order_select_columns {
+  #my ($self, $source, $columns) = @_;
+  return @{$_[2]};
+}
+
+
+
 
 sub source_bind_attributes {
   my ($self, $source) = @_;
@@ -2239,8 +2320,6 @@ 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;
   $type ||= $self->sqlt_type;
   $version ||= $schema->schema_version || '1.x';
   $dir ||= './';
@@ -2285,7 +2364,9 @@ sub deploy {
     return if $line =~ /^\s+$/; # skip whitespace only
     $self->_query_start($line);
     eval {
-      $self->_get_dbh->do($line);
+      # do a dbh_do cycle here, as we need some error checking in
+      # place (even though we will ignore errors)
+      $self->dbh_do (sub { $_[1]->do($line) });
     };
     if ($@) {
       carp qq{$@ (running "${line}")};
@@ -2314,7 +2395,7 @@ Returns the datetime parser class
 sub datetime_parser {
   my $self = shift;
   return $self->{datetime_parser} ||= do {
-    $self->_get_dbh;
+    $self->_populate_dbh unless $self->_dbh;
     $self->build_datetime_parser(@_);
   };
 }
@@ -2385,8 +2466,13 @@ sub lag_behind_master {
 
 sub DESTROY {
   my $self = shift;
-  return if !$self->_dbh;
-  $self->_verify_pid;
+  $self->_verify_pid if $self->_dbh;
+
+  # some databases need this to stop spewing warnings
+  if (my $dbh = $self->_dbh) {
+    eval { $dbh->disconnect };
+  }
+
   $self->_dbh(undef);
 }
 
@@ -2398,7 +2484,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 +2496,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>