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 detect_reinvoked_destructor);
+use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor);
use namespace::clean;
# default cursor class, overridable in connect_info attributes
my $orig = __PACKAGE__->can ($meth)
or die "$meth is not a ::Storage::DBI method!";
- my $is_getter = $storage_accessor_idx->{$meth} ? 0 : 1;
+ my $possibly_a_setter = $storage_accessor_idx->{$meth} ? 1 : 0;
quote_sub
- __PACKAGE__ ."::$meth", sprintf( <<'EOC', $is_getter, perlstring $meth ), { '$orig' => \$orig };
+ __PACKAGE__ ."::$meth", sprintf( <<'EOC', $possibly_a_setter, perlstring $meth ), { '$orig' => \$orig };
if (
+ # if this is an actual *setter* - just set it, no need to connect
+ # and determine the driver
+ !( %1$s and @_ > 1 )
+ and
# only fire when invoked on an instance, a valid class-based invocation
# would e.g. be setting a default for an inherited accessor
ref $_[0]
and
! $_[0]->{_in_determine_driver}
and
- # if this is a known *setter* - just set it, no need to connect
- # and determine the driver
- ( %1$s or @_ <= 1 )
- and
# 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
}
sub DESTROY {
- return if &detect_reinvoked_destructor;
+ return if &detected_reinvoked_destructor;
$_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
# some databases spew warnings on implicit disconnect
sub _server_info {
my $self = shift;
- my $info;
- unless ($info = $self->_dbh_details->{info}) {
+ # FIXME - ideally this needs to be an ||= assignment, and the final
+ # assignment at the end of this do{} should be gone entirely. However
+ # this confuses CXSA: https://rt.cpan.org/Ticket/Display.html?id=103296
+ $self->_dbh_details->{info} || do {
- $info = {};
+ # this guarantees that problematic conninfo won't be hidden
+ # by the try{} below
+ $self->ensure_connected;
+
+ my $info = {};
my $server_version = try {
$self->_get_server_version
}
$self->_dbh_details->{info} = $info;
- }
-
- return $info;
+ };
}
sub _get_server_version {
sub _determine_connector_driver {
my ($self, $conn) = @_;
- my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME');
+ my $dbtype = $self->_get_rdbms_name;
if (not $dbtype) {
$self->_warn_undetermined_driver(
}
}
+sub _get_rdbms_name { shift->_dbh_get_info('SQL_DBMS_NAME') }
+
sub _warn_undetermined_driver {
my ($self, $msg) = @_;
}
sub _do_connection_actions {
- my $self = shift;
- my $method_prefix = shift;
- my $call = shift;
-
- if (not ref($call)) {
- my $method = $method_prefix . $call;
- $self->$method(@_);
- } elsif (ref($call) eq 'CODE') {
- $self->$call(@_);
- } elsif (ref($call) eq 'ARRAY') {
- if (ref($call->[0]) ne 'ARRAY') {
- $self->_do_connection_actions($method_prefix, $_) for @$call;
- } else {
- $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ my ($self, $method_prefix, $call, @args) = @_;
+
+ try {
+ if (not ref($call)) {
+ my $method = $method_prefix . $call;
+ $self->$method(@args);
+ }
+ elsif (ref($call) eq 'CODE') {
+ $self->$call(@args);
+ }
+ elsif (ref($call) eq 'ARRAY') {
+ if (ref($call->[0]) ne 'ARRAY') {
+ $self->_do_connection_actions($method_prefix, $_) for @$call;
+ }
+ else {
+ $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ }
+ }
+ else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
- } else {
- $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
+ catch {
+ if ( $method_prefix =~ /^connect/ ) {
+ # this is an on_connect cycle - we can't just throw while leaving
+ # a handle in an undefined state in our storage object
+ # kill it with fire and rethrow
+ $self->_dbh(undef);
+ $self->throw_exception( $_[0] );
+ }
+ else {
+ carp "Disconnect action failed: $_[0]";
+ }
+ };
return $self;
}
) {
carp_unique 'DateTime objects passed to search() are not supported '
. 'properly (InflateColumn::DateTime formats and settings are not '
- . 'respected.) See "Formatting DateTime objects in queries" in '
- . 'DBIx::Class::Manual::Cookbook. To disable this warning for good '
+ . 'respected.) See ".. format a DateTime object for searching?" in '
+ . 'DBIx::Class::Manual::FAQ. To disable this warning for good '
. 'set $ENV{DBIC_DT_SEARCH_OK} to true'
}
# scope guard
my $guard = $self->txn_scope_guard;
- $self->_query_start( $sql, @$proto_bind ? [[undef => '__BULK_INSERT__' ]] : () );
+ $self->_query_start( $sql, @$proto_bind ? [[ {} => '__BULK_INSERT__' ]] : () );
my $sth = $self->_prepare_sth($self->_dbh, $sql);
my $rv = do {
if (@$proto_bind) {
}
};
- $self->_query_end( $sql, @$proto_bind ? [[ undef => '__BULK_INSERT__' ]] : () );
+ $self->_query_end( $sql, @$proto_bind ? [[ {} => '__BULK_INSERT__' ]] : () );
$guard->commit;