view release on metacpan or  search on metacpan

lib/DBIO/Storage/DBI.pm  view on Meta::CPAN

        if ($storage_class && $self->load_optional_class($storage_class)) {
          mro::set_mro($storage_class, 'c3');
          bless $self, $storage_class;
          $self->_rebless();

          # Expose this driver's bundled agent skills (see DBIO::Skills).
          DBIO::Skills->register_class($storage_class);
        }
        elsif ($storage_class) {
          $self->throw_exception(
            "The DBIO driver '$storage_class' for DBD driver '$driver' could not be loaded. "
          . "Install the corresponding distribution (e.g. cpanm DBIO::PostgreSQL for dbi:Pg)."
          );
        }
        else {
          $self->throw_exception(
            "No DBIO driver registered for DBD driver '$driver'. "
          . "Install the appropriate DBIO::* distribution for your database, "
          . "or register a custom driver via DBIO::Storage::DBI->register_driver."
          );
        }
      }
      else {
        $self->_warn_undetermined_driver(
          'Unable to extract a driver name from connect info.'
        );
      }
    }

    $self->_driver_determined(1);

    Class::C3->reinitialize() if old_mro();

    $self->_init; # run driver-specific initializations

    $self->_run_connection_actions
        if !$started_connected && defined $self->_dbh;
  }
}

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)
    #
    # 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};
  }

  return $drv;
}

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 = $_connector_registry{$dbtype};

  if ($subclass) {
    return if $self->isa($subclass);

    if ($self->load_optional_class($subclass)) {
      bless $self, $subclass;
      $self->_rebless;
    }
    else {
      $self->throw_exception(
        "The DBIO driver '$subclass' for $conn/$dbtype could not be loaded. "
      . "Install the corresponding distribution."
      );
    }
  }
  else {
    $self->throw_exception(
      "No DBIO driver registered for connector '$conn/$dbtype'. "
    . "Install the appropriate DBIO::* distribution for your database, "
    . "or register via DBIO::Storage::DBI->register_connector_driver."
    );
  }
}

sub _warn_undetermined_driver {
  my ($self, $msg) = @_;

  carp_once ($msg . ' While we will attempt to continue anyway, the results '
  . 'are likely to be underwhelming. Please upgrade DBIO, and if this message '
  . "does not go away, file a bugreport including the following info:\n"
  . dump_value($self->_describe_connection)