__PACKAGE__->mk_group_accessors(
'simple' =>
qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
- cursor on_connect_do transaction_depth/
+ disable_sth_caching cursor on_connect_do transaction_depth/
);
BEGIN {
# While we're at it, this should make LIMIT queries more efficient,
# without digging into things too deeply
+use Scalar::Util 'blessed';
sub _find_syntax {
my ($self, $syntax) = @_;
- my $dbhname = ref $syntax eq 'HASH' ? $syntax->{Driver}{Name} : '';
+ my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
+# print STDERR "Found DBH $syntax >$dbhname< ", $syntax->{Driver}->{Name}, "\n";
if(ref($self) && $dbhname && $dbhname eq 'DB2') {
return 'RowNumberOver';
}
$new->cursor("DBIx::Class::Storage::DBI::Cursor");
$new->transaction_depth(0);
$new->_sql_maker_opts({});
+ $new->{_in_dbh_do} = 0;
+ $new->{_dbh_gen} = 0;
$new;
}
be executed immediately after making the connection to the database
every time we [re-]connect.
+=item disable_sth_caching
+
+If set to a true value, this option will disable the caching of
+statement handles via L<DBI/prepare_cached>.
+
=item limit_dialect
Sets the limit dialect. This is useful for JDBC-bridge among others
quote_char => q{`},
name_sep => q{@},
on_connect_do => ['SET search_path TO myschema,otherschema,public'],
+ disable_sth_caching => 1,
},
]
);
my $info = [ @$info_arg ]; # copy because we can alter it
my $last_info = $info->[-1];
if(ref $last_info eq 'HASH') {
- if(my $on_connect_do = delete $last_info->{on_connect_do}) {
- $self->on_connect_do($on_connect_do);
+ for my $storage_opt (qw/on_connect_do disable_sth_caching/) {
+ if(my $value = delete $last_info->{$storage_opt}) {
+ $self->$storage_opt($value);
+ }
}
for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
if(my $opt_val = delete $last_info->{$sql_maker_opt}) {
my $self = shift;
my $coderef = shift;
- return $coderef->($self, $self->_dbh, @_) if $self->{_in_txn_do};
-
ref $coderef eq 'CODE' or $self->throw_exception
('$coderef must be a CODE reference');
+ return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do};
+ local $self->{_in_dbh_do} = 1;
+
my @result;
my $want_array = wantarray;
# This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
# It also informs dbh_do to bypass itself while under the direction of txn_do,
-# via $self->{_in_txn_do} (this saves some redundant eval and errorcheck, etc)
+# via $self->{_in_dbh_do} (this saves some redundant eval and errorcheck, etc)
sub txn_do {
my $self = shift;
my $coderef = shift;
ref $coderef eq 'CODE' or $self->throw_exception
('$coderef must be a CODE reference');
- local $self->{_in_txn_do} = 1;
+ local $self->{_in_dbh_do} = 1;
my @result;
my $want_array = wantarray;
$self->_dbh->rollback unless $self->_dbh->{AutoCommit};
$self->_dbh->disconnect;
$self->_dbh(undef);
+ $self->{_dbh_gen}++;
}
}
if(my $dbh = $self->_dbh) {
if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
- return $self->_dbh(undef);
+ $self->_dbh(undef);
+ $self->{_dbh_gen}++;
+ return;
}
else {
$self->_verify_pid;
$self->_dbh->{InactiveDestroy} = 1;
$self->_dbh(undef);
+ $self->{_dbh_gen}++;
return;
}
$dbh = DBI->connect(@info);
$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;
+ $dbh->{PrintWarn} = 0;
}
};
}
}
-sub _execute {
+# This used to be the top-half of _execute. It was split out to make it
+# easier to override in NoBindVars without duping the rest. It takes up
+# all of _execute's args, and emits $sql, @bind.
+sub _prep_for_execute {
my ($self, $op, $extra_bind, $ident, @args) = @_;
+
my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
unshift(@bind, @$extra_bind) if $extra_bind;
+ @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+
+ return ($sql, @bind);
+}
+
+sub _execute {
+ my $self = shift;
+
+ my ($sql, @bind) = $self->_prep_for_execute(@_);
+
if ($self->debug) {
my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
$self->debugobj->query_start($sql, @debug_bind);
}
- my $sth = eval { $self->sth($sql,$op) };
- if (!$sth || $@) {
- $self->throw_exception(
- 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
- );
- }
- @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+ my $sth = $self->sth($sql);
+
my $rv;
if ($sth) {
my $time = time();
$self->throw_exception("'$sql' did not generate a statement.");
}
if ($self->debug) {
- my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+ my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
$self->debugobj->query_end($sql, @debug_bind);
}
return (wantarray ? ($rv, $sth, @bind) : $rv);
return $to_insert;
}
+## Still not quite perfect, and EXPERIMENTAL
+## Currently it is assumed that all values passed will be "normal", i.e. not
+## scalar refs, or at least, all the same type as the first set, the statement is
+## only prepped once.
+sub insert_bulk {
+ my ($self, $table, $cols, $data) = @_;
+ my %colvalues;
+ @colvalues{@$cols} = (0..$#$cols);
+ my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
+# print STDERR "BIND".Dumper(\@bind);
+
+ if ($self->debug) {
+ my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
+ $self->debugobj->query_start($sql, @debug_bind);
+ }
+ my $sth = $self->sth($sql);
+
+# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+
+ my $rv;
+ ## This must be an arrayref, else nothing works!
+ my $tuple_status = [];
+# use Data::Dumper;
+# print STDERR Dumper($data);
+ if ($sth) {
+ my $time = time();
+ $rv = eval { $sth->execute_array({ ArrayTupleFetch => sub { my $values = shift @$data; return if !$values; return [ @{$values}[@bind] ]},
+ ArrayTupleStatus => $tuple_status }) };
+# print STDERR Dumper($tuple_status);
+# print STDERR "RV: $rv\n";
+ if ($@ || !defined $rv) {
+ my $errors = '';
+ foreach my $tuple (@$tuple_status)
+ {
+ $errors .= "\n" . $tuple->[1] if(ref $tuple);
+ }
+ $self->throw_exception("Error executing '$sql': ".($@ || $errors));
+ }
+ } else {
+ $self->throw_exception("'$sql' did not generate a statement.");
+ }
+ if ($self->debug) {
+ my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+ $self->debugobj->query_end($sql, @debug_bind);
+ }
+ return (wantarray ? ($rv, $sth, @bind) : $rv);
+}
+
sub update {
return shift->_execute('update' => [], @_);
}
sub _dbh_sth {
my ($self, $dbh, $sql) = @_;
+
# 3 is the if_active parameter which avoids active sth re-use
- $dbh->prepare_cached($sql, {}, 3);
+ my $sth = $self->disable_sth_caching
+ ? $dbh->prepare($sql)
+ : $dbh->prepare_cached($sql, {}, 3);
+
+ $self->throw_exception(
+ 'no sth generated via sql (' . ($@ || $dbh->errstr) . "): $sql"
+ ) if !$sth;
+
+ $sth;
}
sub sth {