package DBIx::Class::Storage::DBI;
# -*- mode: cperl; cperl-indent-level: 2 -*-
-use base 'DBIx::Class::Storage';
-
use strict;
use warnings;
+
+use base 'DBIx::Class::Storage';
+use mro 'c3';
+
use Carp::Clan qw/^DBIx::Class/;
use DBI;
use DBIx::Class::Storage::DBI::Cursor;
use List::Util();
__PACKAGE__->mk_group_accessors('simple' =>
- qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
- _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
+ qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid
+ _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints/
);
# the values for these accessors are picked out (and deleted) from
$self->_verify_pid;
return 0 if !$self->_dbh;
}
- return ($dbh->FETCH('Active') && $dbh->ping);
+ return ($dbh->FETCH('Active') && $self->_ping);
}
return 0;
}
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ return $dbh->ping;
+}
+
# handle pid changes correctly
# NOTE: assumes $self->_dbh is a valid $dbh
sub _verify_pid {
sub _determine_driver {
my ($self) = @_;
- if (ref $self eq 'DBIx::Class::Storage::DBI') {
- my $driver;
+ if (not $self->_driver_determined) {
+ if (ref($self) eq __PACKAGE__) {
+ 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->_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;
+ }
- my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
- if ($self->load_optional_class($storage_class)) {
- mro::set_mro($storage_class, 'c3');
- bless $self, $storage_class;
- $self->_rebless();
+ my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
+ if ($self->load_optional_class($storage_class)) {
+ mro::set_mro($storage_class, 'c3');
+ bless $self, $storage_class;
+ $self->_rebless();
+ }
}
+
+ $self->_driver_determined(1);
}
}
sub insert {
my ($self, $source, $to_insert) = @_;
+# redispatch to insert method of storage we reblessed into, if necessary
+ if (not $self->_driver_determined) {
+ $self->_determine_driver;
+ goto $self->can('insert');
+ }
+
my $ident = $source->from;
my $bind_attributes = $self->source_bind_attributes($source);
my $updated_cols = {};
- $self->ensure_connected;
foreach my $col ( $source->columns ) {
if ( !defined $to_insert->{$col} ) {
my $col_info = $source->column_info($col);
sub _select_args {
my ($self, $ident, $select, $where, $attrs) = @_;
+ my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident);
+
my $sql_maker = $self->sql_maker;
$sql_maker->{_dbic_rs_attrs} = {
%$attrs,
select => $select,
from => $ident,
where => $where,
+ $rs_alias
+ ? ( _source_handle => $alias2source->{$rs_alias}->handle )
+ : ()
+ ,
};
- my ($alias2source, $root_alias) = $self->_resolve_ident_sources ($ident);
-
# calculate bind_attrs before possible $ident mangling
my $bind_attrs = {};
for my $alias (keys %$alias2source) {
my $fqcn = join ('.', $alias, $col);
$bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
- # so that unqualified searches can be bound too
- $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $root_alias;
+ # Unqialified column names are nice, but at the same time can be
+ # rather ambiguous. What we do here is basically go along with
+ # the loop, adding an unqualified column slot to $bind_attrs,
+ # alongside the fully qualified name. As soon as we encounter
+ # another column by that name (which would imply another table)
+ # we unset the unqualified slot and never add any info to it
+ # to avoid erroneous type binding. If this happens the users
+ # only choice will be to fully qualify his column name
+
+ if (exists $bind_attrs->{$col}) {
+ $bind_attrs->{$col} = {};
+ }
+ else {
+ $bind_attrs->{$col} = $bind_attrs->{$fqcn};
+ }
}
}
- my @limit;
- if ($attrs->{software_limit} ||
- $sql_maker->_default_limit_syntax eq "GenericSubQ") {
- $attrs->{software_limit} = 1;
- } else {
+ # adjust limits
+ if (
+ $attrs->{software_limit}
+ ||
+ $sql_maker->_default_limit_syntax eq "GenericSubQ"
+ ) {
+ $attrs->{software_limit} = 1;
+ }
+ else {
$self->throw_exception("rows attribute must be positive if present")
if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
# MySQL actually recommends this approach. I cringe.
$attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
+ }
- if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
- ($ident, $select, $where, $attrs)
- = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
- }
- else {
- push @limit, $attrs->{rows}, $attrs->{offset};
- }
+ my @limit;
+
+ # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
+ # otherwise delegate the limiting to the storage, unless software limit was requested
+ if (
+ ( $attrs->{rows} && keys %{$attrs->{collapse}} )
+ ||
+ ( $attrs->{group_by} && @{$attrs->{group_by}} &&
+ $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+ ) {
+ ($ident, $select, $where, $attrs)
+ = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
+ }
+ elsif (! $attrs->{software_limit} ) {
+ push @limit, $attrs->{rows}, $attrs->{offset};
}
###
my $order = { map
{ $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () }
- (qw/order_by group_by having _virtual_order_by/ )
+ (qw/order_by group_by having/ )
};
-
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
-sub _adjust_select_args_for_limited_prefetch {
+#
+# This is the code producing joined subqueries like:
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
+#
+sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
- if ($attrs->{group_by} && @{$attrs->{group_by}}) {
- $self->throw_exception ('has_many prefetch with limit (rows/offset) is not supported on grouped resultsets');
- }
-
- $self->throw_exception ('has_many prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
+ $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY');
+ # copies for mangling
+ $from = [ @$from ];
+ $select = [ @$select ];
+ $attrs = { %$attrs };
# separate attributes
my $sub_attrs = { %$attrs };
- delete $attrs->{$_} for qw/where bind rows offset/;
- delete $sub_attrs->{$_} for qw/for collapse select as order_by/;
+ delete $attrs->{$_} for qw/where bind rows offset group_by having/;
+ delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
+
+ my $select_root_alias = $attrs->{alias};
+ my $sql_maker = $self->sql_maker;
- my $alias = $attrs->{alias};
+ # create subquery select list - consider only stuff *not* brought in by the prefetch
+ my $sub_select = [];
+ my $sub_group_by;
+ for my $i (0 .. @{$attrs->{select}} - @{$attrs->{_prefetch_select}} - 1) {
+ my $sel = $attrs->{select}[$i];
+
+ # alias any functions to the dbic-side 'as' label
+ # adjust the outer select accordingly
+ if (ref $sel eq 'HASH' && !$sel->{-select}) {
+ $sel = { -select => $sel, -as => $attrs->{as}[$i] };
+ $select->[$i] = join ('.', $attrs->{alias}, ($attrs->{as}[$i] || "select_$i") );
+ }
- # create subquery select list
- my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
+ push @$sub_select, $sel;
+ }
# bring over all non-collapse-induced order_by into the inner query (if any)
# the outer one will have to keep them all
+ delete $sub_attrs->{order_by};
if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
$sub_attrs->{order_by} = [
- @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
+ @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
];
}
- # mangle {from}
- $from = [ @$from ];
- my $select_root = shift @$from;
- my @outer_from = @$from;
+ # mangle {from}, keep in mind that $from is "headless" from here on
+ my $join_root = shift @$from;
my %inner_joins;
my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
- # in complex search_related chains $alias may *not* be 'me'
- # so always include it in the inner join, and also shift away
- # from the outer stack, so that the two datasets actually do
- # meet
- if ($select_root->{-alias} ne $alias) {
- $inner_joins{$alias} = 1;
-
- while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
- shift @outer_from;
- }
- if (! @outer_from) {
- $self->throw_exception ("Unable to find '$alias' in the {from} stack, something is wrong");
- }
-
- shift @outer_from; # the new subquery will represent this alias, so get rid of it
- }
+ # in complex search_related chains $select_root_alias may *not* be
+ # 'me' so always include it in the inner join
+ $inner_joins{$select_root_alias} = 1 if ($join_root->{-alias} ne $select_root_alias);
# decide which parts of the join will remain on the inside
# It may not be very efficient, but it's a reasonable stop-gap
{
# produce stuff unquoted, so it can be scanned
- my $sql_maker = $self->sql_maker;
local $sql_maker->{quote_char};
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ $sep = "\Q$sep\E";
my @order_by = (map
{ ref $_ ? $_->[0] : $_ }
);
my $where_sql = $sql_maker->where ($where);
+ my $select_sql = $sql_maker->_recurse_fields ($sub_select);
# sort needed joins
for my $alias (keys %join_info) {
# any table alias found on a column name in where or order_by
# gets included in %inner_joins
# Also any parent joins that are needed to reach this particular alias
- for my $piece ($where_sql, @order_by ) {
- if ($piece =~ /\b$alias\./) {
+ for my $piece ($select_sql, $where_sql, @order_by ) {
+ if ($piece =~ /\b $alias $sep/x) {
$inner_joins{$alias} = 1;
}
}
}
# construct the inner $from for the subquery
- my $inner_from = [ $select_root ];
+ my $inner_from = [ $join_root ];
for my $j (@$from) {
push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
}
# if a multi-type join was needed in the subquery ("multi" is indicated by
# presence in {collapse}) - add a group_by to simulate the collapse in the subq
-
- for my $alias (keys %inner_joins) {
-
- # the dot comes from some weirdness in collapse
- # remove after the rewrite
- if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} = $sub_select;
- last;
+ unless ($sub_attrs->{group_by}) {
+ for my $alias (keys %inner_joins) {
+
+ # the dot comes from some weirdness in collapse
+ # remove after the rewrite
+ if ($attrs->{collapse}{".$alias"}) {
+ $sub_attrs->{group_by} ||= $sub_select;
+ last;
+ }
}
}
$where,
$sub_attrs
);
-
- # put it in the new {from}
- unshift @outer_from, {
- -alias => $alias,
- -source_handle => $select_root->{-source_handle},
- $alias => $subq,
+ my $subq_joinspec = {
+ -alias => $select_root_alias,
+ -source_handle => $join_root->{-source_handle},
+ $select_root_alias => $subq,
};
+ # Generate a new from (really just replace the join slot with the subquery)
+ # Before we would start the outer chain from the subquery itself (i.e.
+ # SELECT ... FROM (SELECT ... ) alias JOIN ..., but this turned out to be
+ # a bad idea for search_related, as the root of the chain was effectively
+ # lost (i.e. $artist_rs->search_related ('cds'... ) would result in alias
+ # of 'cds', which would prevent from doing things like order_by artist.*)
+ # See t/prefetch/via_search_related.t for a better idea
+ my @outer_from;
+ if ($join_root->{-alias} eq $select_root_alias) { # just swap the root part and we're done
+ @outer_from = (
+ $subq_joinspec,
+ @$from,
+ )
+ }
+ else { # this is trickier
+ @outer_from = ($join_root);
+
+ for my $j (@$from) {
+ if ($j->[0]{-alias} eq $select_root_alias) {
+ push @outer_from, [
+ $subq_joinspec,
+ @{$j}[1 .. $#$j],
+ ];
+ }
+ else {
+ push @outer_from, $j;
+ }
+ }
+ }
+
# This is totally horrific - the $where ends up in both the inner and outer query
# Unfortunately not much can be done until SQLA2 introspection arrives, and even
# then if where conditions apply to the *right* side of the prefetch, you may have
my ($self, $ident) = @_;
my $alias2source = {};
- my $root_alias;
+ my $rs_alias;
# the reason this is so contrived is that $ident may be a {from}
# structure, specifying multiple tables to join
if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
# this is compat mode for insert/update/delete which do not deal with aliases
$alias2source->{me} = $ident;
- $root_alias = 'me';
+ $rs_alias = 'me';
}
elsif (ref $ident eq 'ARRAY') {
my $tabinfo;
if (ref $_ eq 'HASH') {
$tabinfo = $_;
- $root_alias = $tabinfo->{-alias};
+ $rs_alias = $tabinfo->{-alias};
}
if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
$tabinfo = $_->[0];
}
}
- return ($alias2source, $root_alias);
+ return ($alias2source, $rs_alias);
}
# Takes $ident, \@column_names
$sep = "\Q$sep\E";
my (%return, %converted);
+
+ if (not $colnames) {
+ $colnames = [ map {
+ my $alias = $_;
+ my $source = $alias2src->{$alias};
+ map "${alias}${sep}$_", $source->columns
+ } keys %$alias2src ];
+
+# also add unqualified columns for 'me' table
+ push @$colnames, $alias2src->{$root_alias}->columns;
+ }
+
foreach my $col (@$colnames) {
my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;