#
# This module contains code that should never have seen the light of day,
# does not belong in the Storage, or is otherwise unfit for public
-# display. The arrival of SQLA2 should immediately oboslete 90% of this
+# display. The arrival of SQLA2 should immediately obsolete 90% of this
#
use strict;
use base 'DBIx::Class::Storage';
use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
use List::Util 'first';
use Scalar::Util 'blessed';
use namespace::clean;
my @newfrom = $from->[0]; # FROM head is always present
- my %need_joins = (map { %{$_||{}} } (values %$aliastypes) );
+ my %need_joins;
+ for (values %$aliastypes) {
+ # add all requested aliases
+ $need_joins{$_} = 1 for keys %$_;
+
+ # add all their parents (as per joinpath which is an AoH { table => alias })
+ $need_joins{$_} = 1 for map { values %$_ } map { @$_ } values %$_;
+ }
for my $j (@{$from}[1..$#$from]) {
push @newfrom, $j if (
(! $j->[0]{-alias}) # legacy crap
my ($self, $from, $select, $where, $attrs) = @_;
$self->throw_exception ('Nothing to prefetch... how did we get here?!')
- if not @{$attrs->{_prefetch_select}};
+ if not @{$attrs->{_prefetch_selector_range}};
$self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
my $inner_attrs = { %$attrs };
- delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
+ delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range _collapse_order_by select as/;
# bring over all non-collapse-induced order_by into the inner query (if any)
# on the outside we substitute any function for its alias
my $outer_select = [ @$select ];
my $inner_select = [];
- for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) {
+
+ my ($p_start, $p_end) = @{$outer_attrs->{_prefetch_selector_range}};
+ for my $i (0 .. $p_start - 1, $p_end + 1 .. $#$outer_select) {
my $sel = $outer_select->[$i];
if (ref $sel eq 'HASH' ) {
# the fake group_by is so that the pruner throws away all non-selecting, non-restricting
# multijoins (since we def. do not care about those inside the subquery)
- my $subq_joinspec = do {
+ my $inner_subq = do {
# must use it here regardless of user requests
local $self->{_use_join_optimizer} = 1;
group_by => ['dummy'], %$inner_attrs,
});
- # if a multi-type join was needed in the subquery - add a group_by to simulate the
- # collapse in the subq
+ my $inner_aliastypes =
+ $self->_resolve_aliastypes_from_select_args( $inner_from, $inner_select, $where, $inner_attrs );
+
+ # we need to simulate collapse in the subq if a multiplying join is pulled
+ # by being a non-selecting restrictor
if (
! $inner_attrs->{group_by}
and
- first { ! $_->[0]{-is_single} } (@{$inner_from}[1 .. $#$inner_from])
+ first {
+ $inner_aliastypes->{restricting}{$_}
+ and
+ ! $inner_aliastypes->{selecting}{$_}
+ } ( keys %{$inner_aliastypes->{multiplying}||{}} )
) {
- $inner_attrs->{group_by} = $self->_group_over_selection (
+ my $unprocessed_order_chunks;
+ ($inner_attrs->{group_by}, $unprocessed_order_chunks) = $self->_group_over_selection (
$inner_from, $inner_select, $inner_attrs->{order_by}
);
+
+ $self->throw_exception (
+ 'A required group_by clause could not be constructed automatically due to a complex '
+ . 'order_by criteria. Either order_by columns only (no functions) or construct a suitable '
+ . 'group_by by hand'
+ ) if $unprocessed_order_chunks;
}
# we already optimized $inner_from above
local $self->{_use_join_optimizer} = 0;
# generate the subquery
- my $subq = $self->_select_args_to_query (
+ $self->_select_args_to_query (
$inner_from,
$inner_select,
$where,
$inner_attrs,
);
-
- +{
- -alias => $attrs->{alias},
- -source_handle => $inner_from->[0]{-source_handle},
- $attrs->{alias} => $subq,
- };
};
# Generate the outer from - this is relatively easy (really just replace
$j = [ $j ] unless ref $j eq 'ARRAY'; # promote the head-from to an AoH
if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap
+
push @outer_from, [
- $subq_joinspec,
+ {
+ -alias => $attrs->{alias},
+ -rsrc => $j->[0]{-rsrc},
+ $attrs->{alias} => $inner_subq,
+ },
@{$j}[1 .. $#$j],
];
last; # we'll take care of what's left in $from below
my $outer_aliastypes =
$self->_resolve_aliastypes_from_select_args( $from, $outer_select, $where, $outer_attrs );
+ # unroll parents
+ my ($outer_select_chain, $outer_restrict_chain) = map { +{
+ map { $_ => 1 } map { values %$_} map { @$_ } values %{ $outer_aliastypes->{$_} || {} }
+ } } qw/selecting restricting/;
+
# see what's left - throw away if not selecting/restricting
- # also throw in a group_by if restricting to guard against
- # cross-join explosions
- #
+ # also throw in a group_by if a non-selecting multiplier,
+ # to guard against cross-join explosions
+ my $need_outer_group_by;
while (my $j = shift @$from) {
my $alias = $j->[0]{-alias};
- if ($outer_aliastypes->{selecting}{$alias}) {
- push @outer_from, $j;
+ if (
+ $outer_select_chain->{$alias}
+ ) {
+ push @outer_from, $j
}
- elsif ($outer_aliastypes->{restricting}{$alias}) {
+ elsif ($outer_restrict_chain->{$alias}) {
push @outer_from, $j;
- $outer_attrs->{group_by} ||= $outer_select unless $j->[0]{-is_single};
+ $need_outer_group_by ||= $outer_aliastypes->{multiplying}{$alias} ? 1 : 0;
}
}
# demote the outer_from head
$outer_from[0] = $outer_from[0][0];
+ if ($need_outer_group_by and ! $outer_attrs->{group_by}) {
+
+ my $unprocessed_order_chunks;
+ ($outer_attrs->{group_by}, $unprocessed_order_chunks) = $self->_group_over_selection (
+ \@outer_from, $outer_select, $outer_attrs->{order_by}
+ );
+
+ $self->throw_exception (
+ 'A required group_by clause could not be constructed automatically due to a complex '
+ . 'order_by criteria. Either order_by columns only (no functions) or construct a suitable '
+ . 'group_by by hand'
+ ) if $unprocessed_order_chunks;
+
+ }
+
# 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
or next;
$alias_list->{$al} = $j;
- $aliases_by_type->{multiplying}{$al} = 1
- if ref($_) eq 'ARRAY' and ! $j->{-is_single}; # not array == {from} head == can't be multiplying
+ $aliases_by_type->{multiplying}{$al} ||= $j->{-join_path}||[] if (
+ # not array == {from} head == can't be multiplying
+ ( ref($_) eq 'ARRAY' and ! $j->{-is_single} )
+ or
+ # a parent of ours is already a multiplier
+ ( grep { $aliases_by_type->{multiplying}{$_} } @{ $j->{-join_path}||[] } )
+ );
}
# get a column to source/alias map (including unqualified ones)
my $sql_maker = $self->sql_maker;
# these are throw away results, do not pollute the bind stack
- local $sql_maker->{having_bind};
local $sql_maker->{select_bind};
+ local $sql_maker->{where_bind};
+ local $sql_maker->{group_bind};
+ local $sql_maker->{having_bind};
# we can't scan properly without any quoting (\b doesn't cut it
# everywhere), so unless there is proper quoting set - use our
for my $type (keys %$to_scan) {
for my $piece (@{$to_scan->{$type}}) {
- $aliases_by_type->{$type}{$alias} = 1 if ($piece =~ $al_re);
+ $aliases_by_type->{$type}{$alias} ||= $alias_list->{$alias}{-join_path}||[]
+ if ($piece =~ $al_re);
}
}
}
for my $type (keys %$to_scan) {
for my $piece (@{$to_scan->{$type}}) {
- $aliases_by_type->{$type}{$colinfo->{$col}{-source_alias}} = 1 if ($piece =~ $col_re);
+ if ($piece =~ $col_re) {
+ my $alias = $colinfo->{$col}{-source_alias};
+ $aliases_by_type->{$type}{$alias} ||= $alias_list->{$alias}{-join_path}||[];
+ }
}
}
}
# Add any non-left joins to the restriction list (such joins are indeed restrictions)
for my $j (values %$alias_list) {
my $alias = $j->{-alias} or next;
- $aliases_by_type->{restricting}{$alias} = 1 if (
+ $aliases_by_type->{restricting}{$alias} ||= $j->{-join_path}||[] if (
(not $j->{-join_type})
or
($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
);
}
- # mark all restricting/selecting join parents as such
- # (e.g. join => { cds => 'tracks' } - tracks will need to bring cds too )
- for my $type (qw/restricting selecting/) {
- for my $alias (keys %{$aliases_by_type->{$type}||{}}) {
- $aliases_by_type->{$type}{$_} = 1
- for (map { values %$_ } @{ $alias_list->{$alias}{-join_path} || [] });
- }
- }
-
return $aliases_by_type;
}
my (@group_by, %group_index);
+ # the logic is: if it is a { func => val } we assume an aggregate,
+ # otherwise if \'...' or \[...] we assume the user knows what is
+ # going on thus group over it
for (@$select) {
if (! ref($_) or ref ($_) ne 'HASH' ) {
push @group_by, $_;
# add any order_by parts that are not already present in the group_by
# we need to be careful not to add any named functions/aggregates
# i.e. order_by => [ ... { count => 'foo' } ... ]
+ my @leftovers;
for ($self->_extract_order_criteria($order_by)) {
# only consider real columns (for functions the user got to do an explicit group_by)
- next if @$_ != 1;
+ if (@$_ != 1) {
+ push @leftovers, $_;
+ next;
+ }
my $chunk = $_->[0];
- my $colinfo = $rs_column_list->{$chunk} or next;
+ my $colinfo = $rs_column_list->{$chunk} or do {
+ push @leftovers, $_;
+ next;
+ };
$chunk = "$colinfo->{-source_alias}.$chunk" if $chunk !~ /\./;
push @group_by, $chunk unless $group_index{$chunk}++;
}
- return \@group_by;
+ return wantarray
+ ? (\@group_by, (@leftovers ? \@leftovers : undef) )
+ : \@group_by
+ ;
}
sub _resolve_ident_sources {
$tabinfo = $_->[0];
}
- $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve
- if ($tabinfo->{-source_handle});
+ $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-rsrc}
+ if ($tabinfo->{-rsrc});
}
}
or next;
$return{$col} = {
- %{ ( $colinfos->{$source_alias} ||= $rsrc->columns_info )->{$colname} },
+ %{
+ ( $colinfos->{$source_alias} ||= $rsrc->columns_info )->{$colname}
+ ||
+ $self->throw_exception(
+ "No such column '$colname' on source " . $rsrc->source_name
+ );
+ },
-result_source => $rsrc,
-source_alias => $source_alias,
};
return \@new_from;
}
-# Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
-# a condition containing 'me' or other table prefixes will not work
-# at all. What this code tries to do (badly) is introspect the condition
-# and remove all column qualifiers. If it bails out early (returns undef)
-# the calling code should try another approach (e.g. a subquery)
-sub _strip_cond_qualifiers {
- my ($self, $where) = @_;
-
- my $cond = {};
-
- # No-op. No condition, we're updating/deleting everything
- return $cond unless $where;
-
- if (ref $where eq 'ARRAY') {
- $cond = [
- map {
- my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }
- \%hash;
- } @$where
- ];
- }
- elsif (ref $where eq 'HASH') {
- if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
- $cond->{-and} = [];
- my @cond = @{$where->{-and}};
- for (my $i = 0; $i < @cond; $i++) {
- my $entry = $cond[$i];
- my $hash;
- my $ref = ref $entry;
- if ($ref eq 'HASH' or $ref eq 'ARRAY') {
- $hash = $self->_strip_cond_qualifiers($entry);
- }
- elsif (! $ref) {
- $entry =~ /([^.]+)$/;
- $hash->{$1} = $cond[++$i];
- }
- else {
- $self->throw_exception ("_strip_cond_qualifiers() is unable to handle a condition reftype $ref");
- }
- push @{$cond->{-and}}, $hash;
- }
- }
- else {
- foreach my $key (keys %$where) {
- if ($key eq '-or' && ref $where->{$key} eq 'ARRAY') {
- $cond->{$key} = $self->_strip_cond_qualifiers($where->{$key});
- }
- else {
- $key =~ /([^.]+)$/;
- $cond->{$1} = $where->{$key};
- }
- }
- }
- }
- else {
- return undef;
- }
-
- return $cond;
-}
-
sub _extract_order_criteria {
my ($self, $order_by, $sql_maker) = @_;