use mro 'c3';
use DBIx::Class::Carp;
-use DBIx::Class::Exception;
use Scalar::Util qw/refaddr weaken reftype blessed/;
use List::Util qw/first/;
use Sub::Name 'subname';
# class, as _use_X may be hardcoded class-wide, and _supports_X calls
# _determine_supports_X which obv. needs a correct driver as well
my @rdbms_specific_methods = qw/
- deployment_statements
sqlt_type
sql_maker
build_datetime_parser
return $self->$run_target($self->_get_dbh, @_)
if $self->{_in_do_block} or $self->transaction_depth;
- my $args = \@_;
+ # take a ref instead of a copy, to preserve @_ aliasing
+ # semantics within the coderef, but only if needed
+ # (pseudoforking doesn't like this trick much)
+ my $args = @_ ? \@_ : [];
DBIx::Class::Storage::BlockRunner->new(
storage => $self,
SQL_TXN_ISOLATION_OPTION
/
) {
- my $v = $self->_dbh_get_info($inf);
+ # some drivers barf on things they do not know about instead
+ # of returning undef
+ my $v = try { $self->_dbh_get_info($inf) };
next unless defined $v;
#my $key = sprintf( '%s(%s)', $inf, $DBI::Const::GetInfoType::GetInfoType{$inf} );
$dbh = DBI->connect(@info);
}
- if (!$dbh) {
- die $DBI::errstr;
- }
+ die $DBI::errstr unless $dbh;
+
+ die sprintf ("%s fresh DBI handle with a *false* 'Active' attribute. "
+ . 'This handle is disconnected as far as DBIC is concerned, and we can '
+ . 'not continue',
+ ref $info[0] eq 'CODE'
+ ? "Connection coderef $info[0] returned a"
+ : 'DBI->connect($schema->storage->connect_info) resulted in a'
+ ) unless $dbh->FETCH('Active');
+ # sanity checks unless asked otherwise
unless ($self->unsafe) {
$self->throw_exception(
sub _gen_sql_bind {
my ($self, $op, $ident, $args) = @_;
- my ($sql, @bind) = $self->sql_maker->$op(
- blessed($ident) ? $ident->from : $ident,
- @$args,
- );
+ my ($colinfos, $from);
+ if ( blessed($ident) ) {
+ $from = $ident->from;
+ $colinfos = $ident->columns_info;
+ }
+
+ my ($sql, @bind) = $self->sql_maker->$op( ($from || $ident), @$args );
if (
! $ENV{DBIC_DT_SEARCH_OK}
}
return( $sql, $self->_resolve_bindattrs(
- $ident, [ @{$args->[2]{bind}||[]}, @bind ]
+ $ident, [ @{$args->[2]{bind}||[]}, @bind ], $colinfos
));
}
my ($sql, $bind) = $self->_prep_for_execute($op, $ident, \@args);
- shift->dbh_do( # retry over disconnects
- '_dbh_execute',
+ shift->dbh_do( _dbh_execute => # retry over disconnects
$sql,
$bind,
- $ident,
+ $self->_dbi_attrs_for_bind($ident, $bind),
);
}
sub _dbh_execute {
- my ($self, undef, $sql, $bind, $ident) = @_;
+ my ($self, $dbh, $sql, $bind, $bind_attrs) = @_;
$self->_query_start( $sql, $bind );
- my $bind_attrs = $self->_dbi_attrs_for_bind($ident, $bind);
+ my $sth = $self->_bind_sth_params(
+ $self->_prepare_sth($dbh, $sql),
+ $bind,
+ $bind_attrs,
+ );
+
+ # Can this fail without throwing an exception anyways???
+ my $rv = $sth->execute();
+ $self->throw_exception(
+ $sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...'
+ ) if !$rv;
+
+ $self->_query_end( $sql, $bind );
+
+ return (wantarray ? ($rv, $sth, @$bind) : $rv);
+}
+
+sub _prepare_sth {
+ my ($self, $dbh, $sql) = @_;
+
+ # 3 is the if_active parameter which avoids active sth re-use
+ my $sth = $self->disable_sth_caching
+ ? $dbh->prepare($sql)
+ : $dbh->prepare_cached($sql, {}, 3);
+
+ # XXX You would think RaiseError would make this impossible,
+ # but apparently that's not true :(
+ $self->throw_exception(
+ $dbh->errstr
+ ||
+ sprintf( "\$dbh->prepare() of '%s' through %s failed *silently* without "
+ .'an exception and/or setting $dbh->errstr',
+ length ($sql) > 20
+ ? substr($sql, 0, 20) . '...'
+ : $sql
+ ,
+ 'DBD::' . $dbh->{Driver}{Name},
+ )
+ ) if !$sth;
+
+ $sth;
+}
- my $sth = $self->_sth($sql);
+sub _bind_sth_params {
+ my ($self, $sth, $bind, $bind_attrs) = @_;
for my $i (0 .. $#$bind) {
if (ref $bind->[$i][1] eq 'SCALAR') { # any scalarrefs are assumed to be bind_inouts
}
}
- # Can this fail without throwing an exception anyways???
- my $rv = $sth->execute();
- $self->throw_exception(
- $sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...'
- ) if !$rv;
-
- $self->_query_end( $sql, $bind );
-
- return (wantarray ? ($rv, $sth, @$bind) : $rv);
+ $sth;
}
sub _prefetch_autovalues {
- my ($self, $source, $to_insert) = @_;
-
- my $colinfo = $source->columns_info;
+ my ($self, $source, $colinfo, $to_insert) = @_;
my %values;
for my $col (keys %$colinfo) {
sub insert {
my ($self, $source, $to_insert) = @_;
- my $prefetched_values = $self->_prefetch_autovalues($source, $to_insert);
+ my $col_infos = $source->columns_info;
+
+ my $prefetched_values = $self->_prefetch_autovalues($source, $col_infos, $to_insert);
# fuse the values, but keep a separate list of prefetched_values so that
# they can be fused once again with the final return
# FIXME - we seem to assume undef values as non-supplied. This is wrong.
# Investigate what does it take to s/defined/exists/
- my $col_infos = $source->columns_info;
my %pcols = map { $_ => 1 } $source->primary_columns;
my (%retrieve_cols, $autoinc_supplied, $retrieve_autoinc_col);
for my $col ($source->columns) {
my $guard = $self->txn_scope_guard;
$self->_query_start( $sql, @$proto_bind ? [[undef => '__BULK_INSERT__' ]] : () );
- my $sth = $self->_sth($sql);
+ my $sth = $self->_prepare_sth($self->_dbh, $sql);
my $rv = do {
if (@$proto_bind) {
# proto bind contains the information on which pieces of $data to pull
$self->_select_args(@_);
# my ($sql, $prepared_bind) = $self->_gen_sql_bind($op, $ident, [ $select, $cond, $rs_attrs, $rows, $offset ]);
- my ($sql, $prepared_bind) = $self->_gen_sql_bind($op, $ident, \@args);
- $prepared_bind ||= [];
+ my ($sql, $bind) = $self->_gen_sql_bind($op, $ident, \@args);
- return wantarray
- ? ($sql, $prepared_bind)
- : \[ "($sql)", @$prepared_bind ]
- ;
+ # reuse the bind arrayref
+ unshift @{$bind}, "($sql)";
+ \$bind;
}
sub _select_args {
=cut
-sub _dbh_sth {
- my ($self, $dbh, $sql) = @_;
-
- # 3 is the if_active parameter which avoids active sth re-use
- my $sth = $self->disable_sth_caching
- ? $dbh->prepare($sql)
- : $dbh->prepare_cached($sql, {}, 3);
-
- # XXX You would think RaiseError would make this impossible,
- # but apparently that's not true :(
- $self->throw_exception(
- $dbh->errstr
- ||
- sprintf( "\$dbh->prepare() of '%s' through %s failed *silently* without "
- .'an exception and/or setting $dbh->errstr',
- length ($sql) > 20
- ? substr($sql, 0, 20) . '...'
- : $sql
- ,
- 'DBD::' . $dbh->{Driver}{Name},
- )
- ) if !$sth;
-
- $sth;
-}
-
-sub sth {
- carp_unique 'sth was mistakenly marked/documented as public, stop calling it (will be removed before DBIC v0.09)';
- shift->_sth(@_);
-}
-
-sub _sth {
- my ($self, $sql) = @_;
- $self->dbh_do('_dbh_sth', $sql); # retry over disconnects
-}
-
sub _dbh_columns_info_for {
my ($self, $dbh, $table) = @_;
projects / dbsrgits/DBIx-Class.git / blobdiff