my @args = @{ $info->{arguments} };
- $self->_dbi_connect_info([@args,
- %attrs && !(ref $args[0] eq 'CODE') ? \%attrs : ()]);
+ if (keys %attrs and ref $args[0] ne 'CODE') {
+ carp
+ 'You provided explicit AutoCommit => 0 in your connection_info. '
+ . 'This is almost universally a bad idea (see the footnotes of '
+ . 'DBIx::Class::Storage::DBI for more info). If you still want to '
+ . 'do this you can set $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK} to disable '
+ . 'this warning.'
+ if ! $attrs{AutoCommit} and ! $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK};
+
+ push @args, \%attrs if keys %attrs;
+ }
+ $self->_dbi_connect_info(\@args);
# FIXME - dirty:
# save attributes them in a separate accessor so they are always
return \%info;
}
-sub _default_dbi_connect_attributes {
- return {
+sub _default_dbi_connect_attributes () {
+ +{
AutoCommit => 1,
- RaiseError => 1,
PrintError => 0,
+ RaiseError => 1,
+ ShowErrorStatement => 1,
};
}
unless ($self->unsafe) {
+ $self->throw_exception(
+ 'Refusing clobbering of {HandleError} installed on externally supplied '
+ ."DBI handle $dbh. Either remove the handler or use the 'unsafe' attribute."
+ ) if $dbh->{HandleError} and ref $dbh->{HandleError} ne '__DBIC__DBH__ERROR__HANDLER__';
+
+ # 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'
+
+ ? "The 'RaiseError' of the externally supplied DBI handle is set to false. "
+ ."DBIx::Class will toggle it back to true, unless the 'unsafe' connect "
+ .'attribute has been supplied'
+
+ : 'RaiseError => 0 supplied in your connection_info, without an explicit '
+ .'unsafe => 1. Toggling RaiseError back to true'
+ );
+
+ $dbh->{RaiseError} = 1;
+ }
+
# this odd anonymous coderef dereference is in fact really
# necessary to avoid the unwanted effect described in perl5
# RT#75792
my $weak_self = $_[0];
weaken $weak_self;
- $_[1]->{HandleError} = sub {
+ # the coderef is blessed so we can distinguish it from externally
+ # supplied handles (which must be preserved)
+ $_[1]->{HandleError} = bless sub {
if ($weak_self) {
$weak_self->throw_exception("DBI Exception: $_[0]");
}
# the scope of DBIC
croak ("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
}
- };
+ }, '__DBIC__DBH__ERROR__HANDLER__';
}->($self, $dbh);
-
- $dbh->{ShowErrorStatement} = 1;
- $dbh->{RaiseError} = 1;
- $dbh->{PrintError} = 0;
}
}
catch {
sub txn_commit {
my $self = shift;
- if ($self->{transaction_depth} == 1) {
+ if (! $self->_dbh) {
+ $self->throw_exception('cannot COMMIT on a disconnected handle');
+ }
+ elsif ($self->{transaction_depth} == 1) {
$self->debugobj->txn_commit()
if ($self->debug);
$self->_dbh_commit;
$self->svp_release
if $self->auto_savepoint;
}
+ elsif (! $self->_dbh->FETCH('AutoCommit') ) {
+
+ carp "Storage transaction_depth $self->{transaction_depth} does not match "
+ ."false AutoCommit of $self->{_dbh}, attempting COMMIT anyway";
+
+ $self->debugobj->txn_commit()
+ if ($self->debug);
+ $self->_dbh_commit;
+ $self->{transaction_depth} = 0
+ if $self->_dbh_autocommit;
+ }
else {
$self->throw_exception( 'Refusing to commit without a started transaction' );
}
$err = shift;
};
+ # Not all DBDs are create equal. Some throw on error, some return
+ # an undef $rv, and some set $sth->err - try whatever we can
+ $err = ($sth->errstr || 'UNKNOWN ERROR ($sth->errstr is unset)') if (
+ ! defined $err
+ and
+ ( !defined $rv or $sth->err )
+ );
+
# Statement must finish even if there was an exception.
try {
$sth->finish
$err = shift unless defined $err
};
- $err = $sth->errstr
- if (! defined $err and $sth->err);
-
if (defined $err) {
my $i = 0;
++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
from => $ident,
where => $where,
$rs_alias && $alias2source->{$rs_alias}
- ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
+ ? ( _rsroot_rsrc => $alias2source->{$rs_alias} )
: ()
,
};
&&
@{$attrs->{group_by}}
&&
- $attrs->{_prefetch_select}
- &&
- @{$attrs->{_prefetch_select}}
+ $attrs->{_prefetch_selector_range}
)
) {
($ident, $select, $where, $attrs)