view release on metacpan or  search on metacpan

lib/DBIx/Class/Storage/DBI.pm  view on Meta::CPAN

        if ($self->load_optional_class($storage_class)) {
          mro::set_mro($storage_class, 'c3');
          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.'
        );
      }
    }

    $self->_driver_determined(1);

    Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;

    if ($self->can('source_bind_attributes')) {
      $self->throw_exception(
        "Your storage subclass @{[ ref $self ]} provides (or inherits) the method "
      . 'source_bind_attributes() for which support has been removed as of Jan 2013. '
      . 'If you are not sure how to proceed please contact the development team via '
      . DBIx::Class::_ENV_::HELP_URL
      );
    }

    $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 = "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, $method_prefix, $call, @args) = @_;

  try {
    if (not ref($call)) {

lib/DBIx/Class/Storage/DBI.pm  view on Meta::CPAN

=cut

sub lag_behind_master {
    return;
}

=head2 relname_to_table_alias

=over 4

=item Arguments: $relname, $join_count

=item Return Value: $alias

=back

L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
queries.

This hook is to allow specific L<DBIx::Class::Storage> drivers to change the
way these aliases are named.

The default behavior is C<< "$relname_$join_count" if $join_count > 1 >>,
otherwise C<"$relname">.

=cut

sub relname_to_table_alias {
  my ($self, $relname, $join_count) = @_;

  my $alias = ($join_count && $join_count > 1 ?
    join('_', $relname, $join_count) : $relname);

  return $alias;
}

# The size in bytes to use for DBI's ->bind_param_inout, this is the generic
# version and it may be necessary to amend or override it for a specific storage
# if such binds are necessary.
sub _max_column_bytesize {
  my ($self, $attr) = @_;

  my $max_size;

  if ($attr->{sqlt_datatype}) {
    my $data_type = lc($attr->{sqlt_datatype});

    if ($attr->{sqlt_size}) {

      # String/sized-binary types
      if ($data_type =~ /^(?:
          l? (?:var)? char(?:acter)? (?:\s*varying)?
            |
          (?:var)? binary (?:\s*varying)?
            |
          raw
        )\b/x
      ) {
        $max_size = $attr->{sqlt_size};
      }
      # Other charset/unicode types, assume scale of 4
      elsif ($data_type =~ /^(?:
          national \s* character (?:\s*varying)?
            |
          nchar
            |
          univarchar
            |
          nvarchar
        )\b/x
      ) {
        $max_size = $attr->{sqlt_size} * 4;
      }
    }

    if (!$max_size and !$self->_is_lob_type($data_type)) {
      $max_size = 100 # for all other (numeric?) datatypes
    }
  }

  $max_size || $self->_dbic_connect_attributes->{LongReadLen} || $self->_get_dbh->{LongReadLen} || 8000;
}

# Determine if a data_type is some type of BLOB
sub _is_lob_type {
  my ($self, $data_type) = @_;
  $data_type && ($data_type =~ /lob|bfile|text|image|bytea|memo/i
    || $data_type =~ /^long(?:\s+(?:raw|bit\s*varying|varbit|binary
                                  |varchar|character\s*varying|nvarchar
                                  |national\s*character\s*varying))?\z/xi);
}

sub _is_binary_lob_type {
  my ($self, $data_type) = @_;
  $data_type && ($data_type =~ /blob|bfile|image|bytea/i
    || $data_type =~ /^long(?:\s+(?:raw|bit\s*varying|varbit|binary))?\z/xi);
}

sub _is_text_lob_type {
  my ($self, $data_type) = @_;
  $data_type && ($data_type =~ /^(?:clob|memo)\z/i
    || $data_type =~ /^long(?:\s+(?:varchar|character\s*varying|nvarchar
                        |national\s*character\s*varying))\z/xi);
}

# Determine if a data_type is some type of a binary type
sub _is_binary_type {
  my ($self, $data_type) = @_;
  $data_type && ($self->_is_binary_lob_type($data_type)
    || $data_type =~ /(?:var)?(?:binary|bit|graphic)(?:\s*varying)?/i);
}

1;

=head1 USAGE NOTES

=head2 DBIx::Class and AutoCommit

DBIx::Class can do some wonderful magic with handling exceptions,
disconnections, and transactions when you use C<< AutoCommit => 1 >>
(the default) combined with L<txn_do|DBIx::Class::Storage/txn_do> for