From: Peter Rabbitson Date: Mon, 5 Nov 2012 02:35:45 +0000 (+0100) Subject: Better diagnostics in the case of missing drivers, slight ADO/ODBC refactor X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=75d3bdb243;p=dbsrgits%2FDBIx-Class-Historic.git Better diagnostics in the case of missing drivers, slight ADO/ODBC refactor --- diff --git a/Changes b/Changes index db5545f..d2d2817 100644 --- 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 --- 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 --- 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 --- 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 --- 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