X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=84969f62eb8ce19aa51b15f0b2dc8c5972b1cac7;hb=086901c30dcd1c87b678c44bfd1d42ace0b5e18f;hp=f1a977eb609d6e65269aa117c55b7c652a02f04d;hpb=7c4de2c37d9577b3579fe6a1e621f95a36f50363;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index f1a977e..84969f6 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1,10 +1,12 @@ 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; @@ -13,8 +15,8 @@ use Scalar::Util(); 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 @@ -761,23 +763,27 @@ sub _populate_dbh { 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); } } @@ -1140,12 +1146,17 @@ sub _execute { 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); @@ -1376,16 +1387,20 @@ sub _select_args_to_query { 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) { @@ -1395,8 +1410,21 @@ sub _select_args { 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}; + } } } @@ -1424,7 +1452,7 @@ sub _select_args { ( $attrs->{rows} && keys %{$attrs->{collapse}} ) || ( $attrs->{group_by} && @{$attrs->{group_by}} && - $attrs->{prefetch_select} && @{$attrs->{prefetch_select}} ) + $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} ) ) { ($ident, $select, $where, $attrs) = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs); @@ -1445,40 +1473,46 @@ sub _select_args { 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); } +# +# 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) = @_; + $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 }; - $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute') - if (ref $from ne 'ARRAY'); - # separate attributes my $sub_attrs = { %$attrs }; 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/; + delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/; - my $alias = $attrs->{alias}; + my $select_root_alias = $attrs->{alias}; + my $sql_maker = $self->sql_maker; - # create subquery select list - loop only over primary columns + # create subquery select list - consider only stuff *not* brought in by the prefetch my $sub_select = []; - for my $i (0 .. @{$attrs->{select}} - @{$attrs->{prefetch_select}} - 1) { + 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] = join ('.', $attrs->{alias}, ($attrs->{as}[$i] || "select_$i") ); } push @$sub_select, $sel; @@ -1493,29 +1527,15 @@ sub _adjust_select_args_for_complex_prefetch { ]; } - # mangle {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 @@ -1535,8 +1555,9 @@ sub _adjust_select_args_for_complex_prefetch { # 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] : $_ } @@ -1544,6 +1565,7 @@ sub _adjust_select_args_for_complex_prefetch { ); 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) { @@ -1551,8 +1573,8 @@ sub _adjust_select_args_for_complex_prefetch { # 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; } } @@ -1575,21 +1597,22 @@ sub _adjust_select_args_for_complex_prefetch { } # 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; + } } } @@ -1600,14 +1623,42 @@ sub _adjust_select_args_for_complex_prefetch { $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 @@ -1622,14 +1673,14 @@ sub _resolve_ident_sources { 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') { @@ -1637,7 +1688,7 @@ sub _resolve_ident_sources { 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]; @@ -1648,7 +1699,7 @@ sub _resolve_ident_sources { } } - return ($alias2source, $root_alias); + return ($alias2source, $rs_alias); } # Takes $ident, \@column_names @@ -1666,6 +1717,18 @@ sub _resolve_column_info { $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;