No longer explicitly disconnect on ::Storage DESTROY

[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 3440ebb..2cc0219 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -72,7 +72,6 @@ my @rdbms_specific_methods = qw/
   build_datetime_parser
   datetime_parser_type
 
-
   insert
   insert_bulk
   update
@@ -82,6 +81,9 @@ my @rdbms_specific_methods = qw/
 
   get_use_dbms_capability
   get_dbms_capability
+
+  _server_info
+  _get_server_version
 /;
 
 for my $meth (@rdbms_specific_methods) {
@@ -94,9 +96,15 @@ for my $meth (@rdbms_specific_methods) {
   *{__PACKAGE__ ."::$meth"} = subname $meth => sub {
     if (not $_[0]->_driver_determined and not $_[0]->{_in_determine_driver}) {
       $_[0]->_determine_driver;
-      goto $_[0]->can($meth);
+
+      # This for some reason crashes and burns on perl 5.8.1
+      # IFF the method ends up throwing an exception
+      #goto $_[0]->can ($meth);
+
+      my $cref = $_[0]->can ($meth);
+      goto $cref;
     }
-    $orig->(@_);
+    goto $orig;
   };
 }
 
@@ -179,17 +187,8 @@ sub new {
 sub DESTROY {
   my $self = shift;
 
-  # destroy just the object if not native to this process/thread
-  $self->_preserve_foreign_dbh;
-
-  # some databases need this to stop spewing warnings
-  if (my $dbh = $self->_dbh) {
-    try {
-      %{ $dbh->{CachedKids} } = ();
-      $dbh->disconnect;
-    };
-  }
-
+  # some databases spew warnings on implicit disconnect
+  local $SIG{__WARN__} = sub {};
   $self->_dbh(undef);
 }
 
@@ -800,8 +799,6 @@ sub txn_do {
     my $args = \@_;
 
     try {
-      $self->_get_dbh;
-
       $self->txn_begin;
       if($want_array) {
           @result = $coderef->(@$args);
@@ -838,7 +835,7 @@ 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};
+      if $ENV{DBIC_TXNRETRY_DEBUG};
     $self->_populate_dbh;
   }
 }