Better diagnostics in the case of missing drivers, slight ADO/ODBC refactor

diff --git a/Changes b/Changes
index db5545f..d2d2817 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,9 @@ Revision history for DBIx::Class
         - Fix API mismatch between new_result() and new_related() (originally
           broken by fea3d045)
         - Fix test failure on perl 5.8
+    * Misc
+        - Much more extensive diagnostics when a new RDBMS/DSN combination is
+          encountered (RT#80431)
 
 0.08203 2012-10-18
     * Fixes

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index adf99a7..6825e15 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1143,6 +1143,63 @@ sub _dbh_get_info {
   return $res;
 }
 
+sub _describe_connection {
+  require DBI::Const::GetInfoReturn;
+
+  my $self = shift;
+  $self->ensure_connected;
+
+  my $res = {
+    DBIC_DSN => $self->_dbi_connect_info->[0],
+    DBI_VER => DBI->VERSION,
+    DBIC_VER => DBIx::Class->VERSION,
+    DBIC_DRIVER => ref $self,
+  };
+
+  for my $inf (
+    #keys %DBI::Const::GetInfoType::GetInfoType,
+    qw/
+      SQL_CURSOR_COMMIT_BEHAVIOR
+      SQL_CURSOR_ROLLBACK_BEHAVIOR
+      SQL_CURSOR_SENSITIVITY
+      SQL_DATA_SOURCE_NAME
+      SQL_DBMS_NAME
+      SQL_DBMS_VER
+      SQL_DEFAULT_TXN_ISOLATION
+      SQL_DM_VER
+      SQL_DRIVER_NAME
+      SQL_DRIVER_ODBC_VER
+      SQL_DRIVER_VER
+      SQL_EXPRESSIONS_IN_ORDERBY
+      SQL_GROUP_BY
+      SQL_IDENTIFIER_CASE
+      SQL_IDENTIFIER_QUOTE_CHAR
+      SQL_MAX_CATALOG_NAME_LEN
+      SQL_MAX_COLUMN_NAME_LEN
+      SQL_MAX_IDENTIFIER_LEN
+      SQL_MAX_TABLE_NAME_LEN
+      SQL_MULTIPLE_ACTIVE_TXN
+      SQL_MULT_RESULT_SETS
+      SQL_NEED_LONG_DATA_LEN
+      SQL_NON_NULLABLE_COLUMNS
+      SQL_ODBC_VER
+      SQL_QUALIFIER_NAME_SEPARATOR
+      SQL_QUOTED_IDENTIFIER_CASE
+      SQL_TXN_CAPABLE
+      SQL_TXN_ISOLATION_OPTION
+    /
+  ) {
+    my $v = $self->_dbh_get_info($inf);
+    next unless defined $v;
+
+    #my $key = sprintf( '%s(%s)', $inf, $DBI::Const::GetInfoType::GetInfoType{$inf} );
+    my $expl = DBI::Const::GetInfoReturn::Explain($inf, $v);
+    $res->{$inf} = DBI::Const::GetInfoReturn::Format($inf, $v) . ( $expl ? " ($expl)" : '' );
+  }
+
+  $res;
+}
+
 sub _determine_driver {
   my ($self) = @_;
 
@@ -1155,7 +1212,8 @@ sub _determine_driver {
       if ($self->_dbh) { # we are connected
         $driver = $self->_dbh->{Driver}{Name};
         $started_connected = 1;
-      } else {
+      }
+      else {
         # if connect_info is a CODEREF, we have no choice but to connect
         if (ref $self->_dbi_connect_info->[0] &&
             reftype $self->_dbi_connect_info->[0] eq 'CODE') {
@@ -1179,6 +1237,18 @@ sub _determine_driver {
           bless $self, $storage_class;
           $self->_rebless();
         }
+        else {
+          $self->_warn_undetermined_driver(
+            'This version of DBIC does not yet seem to supply a driver for '
+          . "your particular RDBMS and/or connection method ('$driver')."
+          );
+        }
+      }
+      else {
+        $self->_warn_undetermined_driver(
+          'Unable to extract a driver name from connect info - this '
+        . 'should not have happened.'
+        );
       }
     }
 
@@ -1193,6 +1263,48 @@ sub _determine_driver {
   }
 }
 
+sub _determine_connector_driver {
+  my ($self, $conn) = @_;
+
+  my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME');
+
+  if (not $dbtype) {
+    $self->_warn_undetermined_driver(
+      'Unable to retrieve RDBMS type (SQL_DBMS_NAME) of the engine behind your '
+    . "$conn connector - this should not have happened."
+    );
+    return;
+  }
+
+  $dbtype =~ s/\W/_/gi;
+
+  my $subclass = "DBIx::Class::Storage::DBI::${conn}::${dbtype}";
+  return if $self->isa($subclass);
+
+  if ($self->load_optional_class($subclass)) {
+    bless $self, $subclass;
+    $self->_rebless;
+  }
+  else {
+    $self->_warn_undetermined_driver(
+      'This version of DBIC does not yet seem to supply a driver for '
+    . "your particular RDBMS and/or connection method ('$conn/$dbtype')."
+    );
+  }
+}
+
+sub _warn_undetermined_driver {
+  my ($self, $msg) = @_;
+
+  require Data::Dumper::Concise;
+
+  carp_once ($msg . ' While we will attempt to continue anyway, the results '
+  . 'are likely to be underwhelming. Please upgrade DBIC, and if this message '
+  . "does not go away, file a bugreport including the following info:\n"
+  . Data::Dumper::Concise::Dumper($self->_describe_connection)
+  );
+}
+
 sub _do_connection_actions {
   my $self          = shift;
   my $method_prefix = shift;

diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm
index 8cca22d..469564d 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/ADO.pm
+++ b/lib/DBIx/Class/Storage/DBI/ADO.pm
@@ -19,31 +19,7 @@ should be transparent to the user.
 
 =cut
 
-sub _rebless {
-  my $self = shift;
-
-  my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME');
-
-  if (not $dbtype) {
-    warn "Unable to determine ADO driver, failling back to generic support.\n";
-    return;
-  }
-
-  $dbtype =~ s/\W/_/gi;
-
-  my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}";
-
-  return if $self->isa($subclass);
-
-  if ($self->load_optional_class($subclass)) {
-    bless $self, $subclass;
-    $self->_rebless;
-  }
-  else {
-    warn "Expected driver '$subclass' not found, using generic support. " .
-         "Please file an RT.\n";
-  }
-}
+sub _rebless { shift->_determine_connector_driver('ADO') }
 
 # cleanup some warnings from DBD::ADO
 # RT#65563, not fixed as of DBD::ADO v2.98

diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm
index d9852e7..a464b5e 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/ODBC.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm
@@ -4,31 +4,9 @@ use warnings;
 use base qw/DBIx::Class::Storage::DBI/;
 use mro 'c3';
 
-sub _rebless {
-  my ($self) = @_;
-
-  if (my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME')) {
-    # Translate the backend name into a perl identifier
-    $dbtype =~ s/\W/_/gi;
-    my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
-
-    return if $self->isa($subclass);
-
-    if ($self->load_optional_class($subclass)) {
-      bless $self, $subclass;
-      $self->_rebless;
-    }
-    else {
-      warn "Expected driver '$subclass' not found, using generic support. " .
-           "Please file an RT.\n";
-    }
-  }
-  else {
-    warn "Could not determine your database type, using generic support.\n";
-  }
-}
+sub _rebless { shift->_determine_connector_driver('ODBC') }
 
-# Whether or not we are connecting via the freetds ODBC driver.
+# Whether or not we are connecting via the freetds ODBC driver
 sub _using_freetds {
   my $self = shift;
 

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 84d0c5d..046b30e 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -341,6 +341,10 @@ my $method_dispatch = {
     _dbh_details
     _dbh_get_info
 
+    _determine_connector_driver
+    _describe_connection
+    _warn_undetermined_driver
+
     sql_limit_dialect
     sql_quote_char
     sql_name_sep