__PACKAGE__->mk_group_accessors('simple' =>
qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
- _conn_pid _conn_tid disable_sth_caching cursor on_connect_do
+ _conn_pid _conn_tid disable_sth_caching on_connect_do
on_disconnect_do transaction_depth unsafe _dbh_autocommit/
);
+__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
+
BEGIN {
package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
sub new {
my $new = shift->next::method(@_);
- $new->cursor("DBIx::Class::Storage::DBI::Cursor");
$new->transaction_depth(0);
$new->_sql_maker_opts({});
$new->{_in_dbh_do} = 0;
my $last_info = $dbi_info->[-1];
if(ref $last_info eq 'HASH') {
$last_info = { %$last_info }; # so delete is non-destructive
- my @storage_option =
- qw/on_connect_do on_disconnect_do disable_sth_caching unsafe/;
+ my @storage_option = qw(
+ on_connect_do on_disconnect_do disable_sth_caching unsafe cursor_class
+ );
for my $storage_opt (@storage_option) {
if(my $value = delete $last_info->{$storage_opt}) {
$self->$storage_opt($value);
}
else {
$self->_verify_pid;
+ return 0 if !$self->_dbh;
}
return ($dbh->FETCH('Active') && $dbh->ping);
}
$action->($self);
}
else {
- $self->debugobj->query_start($action) if $self->debug();
- $self->_dbh->do($action);
- $self->debugobj->query_end($action) if $self->debug();
+ my @to_run = (ref $action eq 'ARRAY') ? (@$action) : ($action);
+ $self->_query_start(@to_run);
+ $self->_dbh->do(@to_run);
+ $self->_query_end(@to_run);
}
return $self;
$dbh = DBI->connect(@info);
}
- if(!$self->unsafe) {
+ if($dbh && !$self->unsafe) {
my $weak_self = $self;
weaken($weak_self);
$dbh->{HandleError} = sub {
return ($sql, \@bind);
}
+sub _fix_bind_params {
+ my ($self, @bind) = @_;
+
+ ### Turn @bind from something like this:
+ ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
+ ### to this:
+ ### ( "'1'", "'1'", "'3'" )
+ return
+ map {
+ if ( defined( $_ && $_->[1] ) ) {
+ map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ];
+ }
+ else { q{'NULL'}; }
+ } @bind;
+}
+
+sub _query_start {
+ my ( $self, $sql, @bind ) = @_;
+
+ if ( $self->debug ) {
+ @bind = $self->_fix_bind_params(@bind);
+ $self->debugobj->query_start( $sql, @bind );
+ }
+}
+
+sub _query_end {
+ my ( $self, $sql, @bind ) = @_;
+
+ if ( $self->debug ) {
+ @bind = $self->_fix_bind_params(@bind);
+ $self->debugobj->query_end( $sql, @bind );
+ }
+}
+
sub _dbh_execute {
my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
- if ($self->debug) {
- my @debug_bind =
- map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind;
- $self->debugobj->query_start($sql, @debug_bind);
- }
+ $self->_query_start( $sql, @$bind );
my $sth = $self->sth($sql,$op);
my $rv = $sth->execute();
$self->throw_exception($sth->errstr) if !$rv;
- if ($self->debug) {
- my @debug_bind =
- map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind;
- $self->debugobj->query_end($sql, @debug_bind);
- }
+ $self->_query_end( $sql, @$bind );
return (wantarray ? ($rv, $sth, @$bind) : $rv);
}
@colvalues{@$cols} = (0..$#$cols);
my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
- if ($self->debug) {
- my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind;
- $self->debugobj->query_start($sql, @debug_bind);
- }
+ $self->_query_start( $sql, @bind );
my $sth = $self->sth($sql);
# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv = $sth->execute_array({ArrayTupleStatus => $tuple_status});
$self->throw_exception($sth->errstr) if !$rv;
- if ($self->debug) {
- my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
- $self->debugobj->query_end($sql, @debug_bind);
- }
+ $self->_query_end( $sql, @bind );
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
sub select {
my $self = shift;
my ($ident, $select, $condition, $attrs) = @_;
- return $self->cursor->new($self, \@_, $attrs);
+ return $self->cursor_class->new($self, \@_, $attrs);
}
sub select_single {
next if($line =~ /^BEGIN TRANSACTION/m);
next if($line =~ /^COMMIT/m);
next if $line =~ /^\s+$/; # skip whitespace only
- $self->debugobj->query_start($line) if $self->debug;
+ $self->_query_start($line);
eval {
$self->dbh->do($line); # shouldn't be using ->dbh ?
};
if ($@) {
warn qq{$@ (running "${line}")};
}
- $self->debugobj->query_end($line) if $self->debug;
+ $self->_query_end($line);
}
}
}