From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 10 Dec 2013 03:53:44 +0000 (+0100)
Subject: Streamline connection codepath, fix $ENV{DBI_DSN} regression from d87929a4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=37b5ab5186b53c5e786e32127d2589bd6dc9b3e0;p=dbsrgits%2FDBIx-Class-Historic.git

Streamline connection codepath, fix $ENV{DBI_DSN} regression from d87929a4

Break out _dbi_connect_info to always take into account $ENV{DBI_DSN} on
a case-by-case basis. This allows to centralize handling of "whose driver
is this anyway" and let more exotic configs still function properly. As a
side effect need to move the _dbi_connect_info() population earlier in the
connect_info() codepath

Also break out the DBI_DRIVER reader, and use it if possible in the
_describe_connection codepath

Additionaly refactor of _connect since there is no point passing the DSN when
we can grab it from $self (this also fixed ::Replicated's _connect() loop
never actually having worked)
---

diff --git a/Changes b/Changes
index 6f7daab..64191a6 100644
--- a/Changes
+++ b/Changes
@@ -22,6 +22,7 @@ Revision history for DBIx::Class
         - Back out self-cleaning from DBIx::Class::Carp for the time being
           (as a side effect fixes RT#86267)
         - Fix incorrect internal use of implicit list context in copy()
+        - Fix 0.08250 regression in driver determination when DBI_DSN is used
         - Tests no longer fail if $ENV{DBI_DSN} is set
         - Throw clearer exception on ->new_related() with a non-existent
           relationship.
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9678c28..f45a612 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -32,7 +32,7 @@ __PACKAGE__->datetime_parser_type('DateTime::Format::MySQL'); # historic default
 __PACKAGE__->sql_name_sep('.');
 
 __PACKAGE__->mk_group_accessors('simple' => qw/
-  _connect_info _dbi_connect_info _dbic_connect_attributes _driver_determined
+  _connect_info _dbic_connect_attributes _driver_determined
   _dbh _dbh_details _conn_pid _sql_maker _sql_maker_opts _dbh_autocommit
   _perform_autoinc_retrieval _autoinc_supplied_for_op
 /);
@@ -129,7 +129,10 @@ for my $meth (@rdbms_specific_methods) {
         and
       ! $_[0]->{_in_determine_driver}
         and
-      ($_[0]->_dbi_connect_info||[])->[0]
+      # Only try to determine stuff if we have *something* that either is or can
+      # provide a DSN. Allows for bare $schema's generated with a plain ->connect()
+      # to still be marginally useful
+      $_[0]->_dbi_connect_info->[0]
     ) {
       $_[0]->_determine_driver;
 
@@ -608,23 +611,6 @@ sub connect_info {
   $info = $self->_normalize_connect_info($info)
     if ref $info eq 'ARRAY';
 
-  for my $storage_opt (keys %{ $info->{storage_options} }) {
-    my $value = $info->{storage_options}{$storage_opt};
-
-    $self->$storage_opt($value);
-  }
-
-  # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
-  #  the new set of options
-  $self->_sql_maker(undef);
-  $self->_sql_maker_opts({});
-
-  for my $sql_maker_opt (keys %{ $info->{sql_maker_options} }) {
-    my $value = $info->{sql_maker_options}{$sql_maker_opt};
-
-    $self->_sql_maker_opts->{$sql_maker_opt} = $value;
-  }
-
   my %attrs = (
     %{ $self->_default_dbi_connect_attributes || {} },
     %{ $info->{attributes} || {} },
@@ -643,16 +629,58 @@ sub connect_info {
 
     push @args, \%attrs if keys %attrs;
   }
+
+  # this is the authoritative "always an arrayref" thing fed to DBI->connect
+  # OR a single-element coderef-based $dbh factory
   $self->_dbi_connect_info(\@args);
 
+  # extract the individual storage options
+  for my $storage_opt (keys %{ $info->{storage_options} }) {
+    my $value = $info->{storage_options}{$storage_opt};
+
+    $self->$storage_opt($value);
+  }
+
+  # Extract the individual sqlmaker options
+  #
+  # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
+  #  the new set of options
+  $self->_sql_maker(undef);
+  $self->_sql_maker_opts({});
+
+  for my $sql_maker_opt (keys %{ $info->{sql_maker_options} }) {
+    my $value = $info->{sql_maker_options}{$sql_maker_opt};
+
+    $self->_sql_maker_opts->{$sql_maker_opt} = $value;
+  }
+
   # FIXME - dirty:
-  # save attributes them in a separate accessor so they are always
+  # save attributes in a separate accessor so they are always
   # introspectable, even in case of a CODE $dbhmaker
   $self->_dbic_connect_attributes (\%attrs);
 
   return $self->_connect_info;
 }
 
+sub _dbi_connect_info {
+  my $self = shift;
+
+  return $self->{_dbi_connect_info} = $_[0]
+    if @_;
+
+  my $conninfo = $self->{_dbi_connect_info} || [];
+
+  # last ditch effort to grab a DSN
+  if ( ! defined $conninfo->[0] and $ENV{DBI_DSN} ) {
+    my @new_conninfo = @$conninfo;
+    $new_conninfo[0] = $ENV{DBI_DSN};
+    $conninfo = \@new_conninfo;
+  }
+
+  return $conninfo;
+}
+
+
 sub _normalize_connect_info {
   my ($self, $info_arg) = @_;
   my %info;
@@ -1009,11 +1037,10 @@ sub _init {}
 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_details({}); # reset everything we know
 
-  $self->_dbh($self->_connect(@info));
+  $self->_dbh($self->_connect);
 
   $self->_conn_pid($$) unless DBIx::Class::_ENV_::BROKEN_FORK; # on win32 these are in fact threads
 
@@ -1144,15 +1171,28 @@ sub _describe_connection {
   require DBI::Const::GetInfoReturn;
 
   my $self = shift;
-  $self->ensure_connected;
+
+  my $drv;
+  try {
+    $drv = $self->_extract_driver_from_connect_info;
+    $self->ensure_connected;
+  };
+
+  $drv = "DBD::$drv" if $drv;
 
   my $res = {
     DBIC_DSN => $self->_dbi_connect_info->[0],
     DBI_VER => DBI->VERSION,
     DBIC_VER => DBIx::Class->VERSION,
     DBIC_DRIVER => ref $self,
+    $drv ? (
+      DBD => $drv,
+      DBD_VER => try { $drv->VERSION },
+    ) : (),
   };
 
+  # try to grab data even if we never managed to connect
+  # will cover us in cases of an oddly broken half-connect
   for my $inf (
     #keys %DBI::Const::GetInfoType::GetInfoType,
     qw/
@@ -1213,20 +1253,7 @@ sub _determine_driver {
         $started_connected = 1;
       }
       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') {
-          $self->_populate_dbh;
-          $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
-          # (dsn may not be supplied at all if all we do is make a mock-schema)
-          my $dsn = $self->_dbi_connect_info->[0] || $ENV{DBI_DSN} || '';
-          ($driver) = $dsn =~ /dbi:([^:]+):/i;
-          $driver ||= $ENV{DBI_DRIVER};
-        }
+        $driver = $self->_extract_driver_from_connect_info;
       }
 
       if ($driver) {
@@ -1271,6 +1298,31 @@ sub _determine_driver {
   }
 }
 
+sub _extract_driver_from_connect_info {
+  my $self = shift;
+
+  my $drv;
+
+  # if connect_info is a CODEREF, we have no choice but to connect
+  if (
+    ref $self->_dbi_connect_info->[0]
+      and
+    reftype $self->_dbi_connect_info->[0] eq 'CODE'
+  ) {
+    $self->_populate_dbh;
+    $drv = $self->_dbh->{Driver}{Name};
+  }
+  else {
+    # 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;
+    $drv ||= $ENV{DBI_DRIVER};
+  }
+
+  return $drv;
+}
+
 sub _determine_connector_driver {
   my ($self, $conn) = @_;
 
@@ -1377,10 +1429,12 @@ sub _do_query {
 }
 
 sub _connect {
-  my ($self, @info) = @_;
+  my $self = shift;
+
+  my $info = $self->_dbi_connect_info;
 
   $self->throw_exception("You did not provide any connection_info")
-    if ( ! defined $info[0] and ! $ENV{DBI_DSN} and ! $ENV{DBI_DRIVER} );
+    unless defined $info->[0];
 
   my ($old_connect_via, $dbh);
 
@@ -1410,12 +1464,12 @@ sub _connect {
   };
 
   try {
-    if(ref $info[0] eq 'CODE') {
-      $dbh = $info[0]->();
+    if(ref $info->[0] eq 'CODE') {
+      $dbh = $info->[0]->();
     }
     else {
       require DBI;
-      $dbh = DBI->connect(@info);
+      $dbh = DBI->connect(@$info);
     }
 
     die $DBI::errstr unless $dbh;
@@ -1423,8 +1477,8 @@ sub _connect {
     die sprintf ("%s fresh DBI handle with a *false* 'Active' attribute. "
       . 'This handle is disconnected as far as DBIC is concerned, and we can '
       . 'not continue',
-      ref $info[0] eq 'CODE'
-        ? "Connection coderef $info[0] returned a"
+      ref $info->[0] eq 'CODE'
+        ? "Connection coderef $info->[0] returned a"
         : 'DBI->connect($schema->storage->connect_info) resulted in a'
     ) unless $dbh->FETCH('Active');
 
@@ -1439,7 +1493,7 @@ sub _connect {
       # Default via _default_dbi_connect_attributes is 1, hence it was an explicit
       # request, or an external handle. Complain and set anyway
       unless ($dbh->{RaiseError}) {
-        carp( ref $info[0] eq 'CODE'
+        carp( ref $info->[0] eq 'CODE'
 
           ? "The 'RaiseError' of the externally supplied DBI handle is set to false. "
            ."DBIx::Class will toggle it back to true, unless the 'unsafe' connect "
@@ -1460,7 +1514,7 @@ sub _connect {
   };
 
   $self->_dbh_autocommit($dbh->{AutoCommit});
-  $dbh;
+  return $dbh;
 }
 
 sub txn_begin {
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 70e4980..2f4caf8 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -338,6 +338,7 @@ my $method_dispatch = {
     _dbh_get_info
 
     _determine_connector_driver
+    _extract_driver_from_connect_info
     _describe_connection
     _warn_undetermined_driver
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index 02464e4..79a449e 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -83,8 +83,7 @@ sub _ping {
 
   if ($dbh->{syb_no_child_con}) {
     return try {
-      $self->_connect(@{$self->_dbi_connect_info || [] })
-        ->do('select 1');
+      $self->_connect->do('select 1');
       1;
     }
     catch {
diff --git a/maint/gen_sqlite_schema_files b/maint/gen_sqlite_schema_files
index 03db999..a3793d3 100755
--- a/maint/gen_sqlite_schema_files
+++ b/maint/gen_sqlite_schema_files
@@ -26,6 +26,7 @@ die "You need to specify one DBIC schema class via --schema-class\n"
 die "You may not specify more than one deploy path via --deploy-to\n"
   if @{$args->{'deploy-to'}||[]} > 1;
 
+local $ENV{DBI_DSN};
 my $schema = use_module( $args->{'schema-class'}[0] )->connect(
   $args->{'deploy-to'}
     ? ( "DBI:SQLite:$args->{'deploy-to'}[0]", undef, undef, { on_connect_do => "PRAGMA synchronous = OFF" } )
diff --git a/t/storage/base.t b/t/storage/base.t
index ab7e89c..efc5938 100644
--- a/t/storage/base.t
+++ b/t/storage/base.t
@@ -147,33 +147,41 @@ for my $type (keys %$invocations) {
 }
 
 # make sure connection-less storages do not throw on _determine_driver
-{
-  local $ENV{DBI_DSN};
-  local $ENV{DBI_DRIVER};
+# but work with ENV at the same time
+SKIP: for my $env_dsn (undef, (DBICTest->_database)[0] ) {
+  skip 'Subtest relies on being connected to SQLite', 1
+    if $env_dsn and $env_dsn !~ /\:SQLite\:/;
 
-  my $s = DBICTest::Schema->connect;
+  local $ENV{DBI_DSN} = $env_dsn;
+
+  my $s = DBICTest::Schema->connect();
   is_deeply (
     $s->storage->connect_info,
     [],
-    'Starting with no connection info',
+    'Starting with no explicitly passed in connect info'
+  . ($env_dsn ? ' (with DBI_DSN)' : ''),
   );
 
-  isa_ok(
-    $s->storage->sql_maker,
-    'DBIx::Class::SQLMaker',
-    'Getting back an SQLMaker succesfully',
-  );
+  my $sm = $s->storage->sql_maker;
+
+  ok (! $s->storage->connected, 'Storage does not appear connected (SQLite determined by DSN-only analysis)');
 
-  ok (! $s->storage->_driver_determined, 'Driver undetermined');
+  if ($env_dsn) {
+    isa_ok($sm, 'DBIx::Class::SQLMaker');
 
-  ok (! $s->storage->connected, 'Storage does not appear connected');
+    ok ( $s->storage->_driver_determined, 'Driver determined (with DBI_DSN)');
+    isa_ok ( $s->storage, 'DBIx::Class::Storage::DBI::SQLite' );
+  }
+  else {
+    isa_ok($sm, 'DBIx::Class::SQLMaker');
 
-  throws_ok {
-    $s->storage->ensure_connected
-  } qr/You did not provide any connection_info/,
-  'sensible exception on empty conninfo connect'
+    ok (! $s->storage->_driver_determined, 'Driver undetermined');
+
+    throws_ok {
+      $s->storage->ensure_connected
+    } qr/You did not provide any connection_info/,
+    'sensible exception on empty conninfo connect';
+  }
 }
 
 done_testing;
-
-1;
diff --git a/t/storage/dbi_env.t b/t/storage/dbi_env.t
index fd5f1d6..462da11 100644
--- a/t/storage/dbi_env.t
+++ b/t/storage/dbi_env.t
@@ -4,6 +4,7 @@ use lib qw(t/lib);
 use DBICTest;
 use Test::More;
 use Test::Exception;
+use DBIx::Class::_Util 'sigwarn_silencer';
 
 BEGIN { delete @ENV{qw(DBI_DSN DBI_DRIVER)} }
 
@@ -16,6 +17,17 @@ my $dbname = DBICTest->_sqlite_dbname(sqlite_use_file => 1);
 
 sub count_sheep {
     my $schema = shift;
+
+    local $SIG{__WARN__} = sigwarn_silencer(
+      qr/
+        \QThis version of DBIC does not yet seem to supply a driver for your particular RDBMS\E
+          |
+        \QUnable to extract a driver name from connect info\E
+          |
+        \QYour storage class (DBIx::Class::Storage::DBI) does not set sql_limit_dialect\E
+      /x
+    );
+
     scalar $schema->resultset('Artist')->search( { name => "Exploding Sheep" } )
         ->all;
 }
@@ -87,4 +99,21 @@ $schema = DBICTest::Schema->connect;
 lives_ok { count_sheep($schema) } 'SQLite in DBI_DRIVER (not DBI_DSN)';
 isa_ok $schema->storage, 'DBIx::Class::Storage::DBI::SQLite';
 
+# make sure that dynamically setting DBI_DSN post-connect works
+{
+  local $ENV{DBI_DSN};
+
+  my $s = DBICTest::Schema->connect();
+
+  throws_ok {
+    $s->storage->ensure_connected
+  } qr/You did not provide any connection_info/,
+  'sensible exception on empty conninfo connect';
+
+  $ENV{DBI_DSN} = 'dbi:SQLite::memory:';
+
+  lives_ok { $s->storage->ensure_connected } 'Second connection attempt worked';
+  isa_ok ( $s->storage, 'DBIx::Class::Storage::DBI::SQLite' );
+}
+
 done_testing;
diff --git a/t/storage/deploy.t b/t/storage/deploy.t
index 78e2c8c..433f58e 100644
--- a/t/storage/deploy.t
+++ b/t/storage/deploy.t
@@ -15,6 +15,8 @@ BEGIN {
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')
 }
 
+local $ENV{DBI_DSN};
+
 # this is how maint/gen_schema did it (connect() to force a storage
 # instance, but no conninfo)
 # there ought to be more code like this in the wild