Fix parsing DSN when the driver part includes DBI attributes

[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 1f66d71..adcd6b4 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -14,7 +14,7 @@ use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use SQL::Abstract qw(is_plain_value is_literal_value);
 use DBIx::Class::_Util qw(
-  quote_sub perlstring serialize
+  quote_sub perlstring serialize dump_value
   dbic_internal_try
   detected_reinvoked_destructor scope_guard
   mkdir_p
@@ -1377,7 +1377,16 @@ sub _extract_driver_from_connect_info {
     # try to use dsn to not require being connected, the driver may still
     # force a connection later in _rebless to determine version
     # (dsn may not be supplied at all if all we do is make a mock-schema)
-    ($drv) = ($self->_dbi_connect_info->[0] || '') =~ /^dbi:([^:]+):/i;
+    #
+    # Use the same regex as the one used by DBI itself (even if the use of
+    # \w is odd given unicode):
+    # https://metacpan.org/source/TIMB/DBI-1.634/DBI.pm#L621
+    #
+    # DO NOT use https://metacpan.org/source/TIMB/DBI-1.634/DBI.pm#L559-566
+    # as there is a long-standing precedent of not loading DBI.pm until the
+    # very moment we are actually connecting
+    #
+    ($drv) = ($self->_dbi_connect_info->[0] || '') =~ /^dbi:(\w*)/i;
     $drv ||= $ENV{DBI_DRIVER};
   }
 
@@ -1419,12 +1428,10 @@ sub _get_rdbms_name { shift->_dbh_get_info('SQL_DBMS_NAME') }
 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)
+  . dump_value $self->_describe_connection
   );
 }
 
@@ -2200,13 +2207,12 @@ sub _insert_bulk {
       $msg,
       $cols->[$c_idx],
       do {
-        require Data::Dumper::Concise;
         local $Data::Dumper::Maxdepth = 5;
-        Data::Dumper::Concise::Dumper ({
+        dump_value {
           map { $cols->[$_] =>
             $data->[$r_idx][$_]
           } 0..$#$cols
-        }),
+        };
       }
     );
   };
@@ -2403,10 +2409,9 @@ sub _dbh_execute_for_fetch {
     $self->throw_exception("Unexpected populate error: $err")
       if ($i > $#$tuple_status);
 
-    require Data::Dumper::Concise;
     $self->throw_exception(sprintf "execute_for_fetch() aborted with '%s' at populate slice:\n%s",
       ($tuple_status->[$i][1] || $err),
-      Data::Dumper::Concise::Dumper( { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } ),
+      dump_value { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) },
     );
   }