use DBIx::Class::Carp;
use Scalar::Util qw/refaddr weaken reftype blessed/;
-use List::Util qw/first/;
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
undef;
}
- sub CLONE {
+ sub DBIx::Class::__DBI_Storage_iThreads_handler__::CLONE {
# As per DBI's recommendation, DBIC disconnects all handles as
# soon as possible (DBIC will reconnect only on demand from within
# the thread)
my $g = scope_guard {
- {
- local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
- eval { $self->_dbh->disconnect };
- }
+ defined( $self->_dbh )
+ and dbic_internal_try { $self->_dbh->disconnect };
$self->_dbh(undef);
$self->_dbh_details({});
if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
my $started_connected = 0;
- local $self->{_in_determine_driver} = 1;
+
+ local $self->{_in_determine_driver} = 1
+ unless $self->{_in_determine_driver};
if (ref($self) eq __PACKAGE__) {
my $driver;
if ($driver) {
my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
if ($self->load_optional_class($storage_class)) {
- mro::set_mro($storage_class, 'c3');
+
+ no strict 'refs';
+ mro::set_mro($storage_class, 'c3') if
+ (
+ ${"${storage_class}::__INITIAL_MRO_UPON_DBIC_LOAD__"}
+ ||= mro::get_mro($storage_class)
+ )
+ ne
+ 'c3'
+ ;
+
bless $self, $storage_class;
$self->_rebless();
}
# 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};
}
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
);
}
and
$op eq 'select'
and
- first {
+ grep {
length ref $_->[1]
and
blessed($_->[1])
map {
defined( $_ && $_->[1] )
- ? qq{'$_->[1]'}
+ ? sprintf( "'%s'", "$_->[1]" ) # because overload
: q{NULL}
} @{$_[1] || []};
}
$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
- }),
+ };
}
);
};
$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) },
);
}
sub deployment_statements {
my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
+
+ $self->throw_exception(
+ 'Calling deployment_statements() in void context makes no sense'
+ ) unless defined wantarray;
+
$type ||= $self->sqlt_type;
$version ||= $schema->schema_version || '1.x';
$dir ||= './';