use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use Scalar::Util qw/blessed weaken/;
+use List::Util();
__PACKAGE__->mk_group_accessors('simple' =>
qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
=over
+=item a scalar
+
+This contains one SQL statement to execute.
+
=item an array reference
This contains SQL statements to execute in order. Each element contains
my @info = @{$self->_dbi_connect_info || []};
$self->_dbh($self->_connect(@info));
+ $self->_conn_pid($$);
+ $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
+
+ $self->_determine_driver;
+
# Always set the transaction depth on connect, since
# there is no transaction in progress by definition
$self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
- if(ref $self eq 'DBIx::Class::Storage::DBI') {
- my $driver = $self->_dbh->{Driver}->{Name};
+ my $connection_do = $self->on_connect_do;
+ $self->_do_connection_actions($connection_do) if $connection_do;
+}
+
+sub _determine_driver {
+ my ($self) = @_;
+
+ if (ref $self eq 'DBIx::Class::Storage::DBI') {
+ my $driver;
+
+ if ($self->_dbh) { # we are connected
+ $driver = $self->_dbh->{Driver}{Name};
+ } else {
+ # try to use dsn to not require being connected, the driver may still
+ # force a connection in _rebless to determine version
+ ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ }
+
if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
bless $self, "DBIx::Class::Storage::DBI::${driver}";
$self->_rebless();
}
}
-
- $self->_conn_pid($$);
- $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
-
- my $connection_do = $self->on_connect_do;
- $self->_do_connection_actions($connection_do) if ref($connection_do);
}
sub _do_connection_actions {
my $self = shift;
my $connection_do = shift;
- if (ref $connection_do eq 'ARRAY') {
+ if (!ref $connection_do) {
+ $self->_do_query($connection_do);
+ }
+ elsif (ref $connection_do eq 'ARRAY') {
$self->_do_query($_) foreach @$connection_do;
}
elsif (ref $connection_do eq 'CODE') {
$connection_do->($self);
}
+ else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
+ }
return $self;
}
#
# Genarating a single PK column subquery is trivial and supported
# by all RDBMS. However if we have a multicolumn PK, things get ugly.
-# Look at multipk_update_delete()
+# Look at _multipk_update_delete()
sub subq_update_delete {
my $self = shift;
my ($rs, $op, $values) = @_;
- if ($rs->result_source->primary_columns == 1) {
- return $self->_onepk_update_delete (@_);
+ my $rsrc = $rs->result_source;
+
+ # we already check this, but double check naively just in case. Should be removed soon
+ my $sel = $rs->_resolved_attrs->{select};
+ $sel = [ $sel ] unless ref $sel eq 'ARRAY';
+ my @pcols = $rsrc->primary_columns;
+ if (@$sel != @pcols) {
+ $self->throw_exception (
+ 'Subquery update/delete can not be called on resultsets selecting a'
+ .' number of columns different than the number of primary keys'
+ );
+ }
+
+ if (@pcols == 1) {
+ return $self->$op (
+ $rsrc,
+ $op eq 'update' ? $values : (),
+ { $pcols[0] => { -in => $rs->as_query } },
+ );
}
+
else {
return $self->_multipk_update_delete (@_);
}
}
-# Generally a single PK resultset operation is trivially expressed
-# with PK IN (subquery). However some databases (mysql) do not support
-# modification of a table mentioned in the subselect. This method
-# should be overriden in the appropriate storage class to be smarter
-# in such situations
-sub _onepk_update_delete {
-
- my $self = shift;
- my ($rs, $op, $values) = @_;
-
- my $rsrc = $rs->result_source;
- my $attrs = $rs->_resolved_attrs;
- my @pcols = $rsrc->primary_columns;
-
- $self->throw_exception ('_onepk_update_delete can not be called on resultsets selecting multiple columns')
- if (ref $attrs->{select} eq 'ARRAY' and @{$attrs->{select}} > 1);
-
- return $self->$op (
- $rsrc,
- $op eq 'update' ? $values : (),
- { $pcols[0] => { -in => $rs->as_query } },
- );
+# ANSI SQL does not provide a reliable way to perform a multicol-PK
+# resultset update/delete involving subqueries. So by default resort
+# to simple (and inefficient) delete_all style per-row opearations,
+# while allowing specific storages to override this with a faster
+# implementation.
+#
+sub _multipk_update_delete {
+ return shift->_per_row_update_delete (@_);
}
-# ANSI SQL does not provide a reliable way to perform a multicol-PK
-# resultset update/delete involving subqueries. So resort to simple
-# (and inefficient) delete_all style per-row opearations, while allowing
-# specific storages to override this with a faster implementation.
+# This is the default loop used to delete/update rows for multi PK
+# resultsets, and used by mysql exclusively (because it can't do anything
+# else).
#
# We do not use $row->$op style queries, because resultset update/delete
# is not expected to cascade (this is what delete_all/update_all is for).
#
# There should be no race conditions as the entire operation is rolled
# in a transaction.
-sub _multipk_update_delete {
+#
+sub _per_row_update_delete {
my $self = shift;
my ($rs, $op, $values) = @_;
my $rsrc = $rs->result_source;
my @pcols = $rsrc->primary_columns;
- my $attrs = $rs->_resolved_attrs;
-
- $self->throw_exception ('Number of columns selected by supplied resultset does not match number of primary keys')
- if ( ref $attrs->{select} ne 'ARRAY' or @{$attrs->{select}} != @pcols );
my $guard = $self->txn_scope_guard;
return 1;
}
-
sub _select {
my $self = shift;
my $sql_maker = $self->sql_maker;
my $sql_maker = $self->sql_maker;
$sql_maker->{for} = $for;
- if (exists $attrs->{group_by} || $attrs->{having}) {
+ my @in_order_attrs = qw/group_by having _virtual_order_by/;
+ if (List::Util::first { exists $attrs->{$_} } (@in_order_attrs) ) {
$order = {
- group_by => $attrs->{group_by},
- having => $attrs->{having},
- ($order ? (order_by => $order) : ())
+ ($order
+ ? (order_by => $order)
+ : ()
+ ),
+ ( map { $_ => $attrs->{$_} } (@in_order_attrs) )
};
}
my $bind_attrs = {}; ## Future support
my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $condition, $order);
if ($attrs->{software_limit} ||
- $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
+ $sql_maker->_default_limit_syntax eq "GenericSubQ") {
$attrs->{software_limit} = 1;
} else {
$self->throw_exception("rows attribute must be positive if present")