use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
+use List::Util 'first';
+use Scalar::Util 'blessed';
+use namespace::clean;
+
+#
+# This code will remove non-selecting/non-restricting joins from
+# {from} specs, aiding the RDBMS query optimizer
+#
+sub _prune_unused_joins {
+ my ($self) = shift;
+
+ my ($from, $select, $where, $attrs) = @_;
+
+ if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY') {
+ return $from; # only standard {from} specs are supported
+ }
+
+ my $aliastypes = $self->_resolve_aliastypes_from_select_args(@_);
+
+ # a grouped set will not be affected by amount of rows. Thus any
+ # {multiplying} joins can go
+ delete $aliastypes->{multiplying} if $attrs->{group_by};
+
+
+ my @newfrom = $from->[0]; # FROM head is always present
+
+ my %need_joins = (map { %{$_||{}} } (values %$aliastypes) );
+ for my $j (@{$from}[1..$#$from]) {
+ push @newfrom, $j if (
+ (! $j->[0]{-alias}) # legacy crap
+ ||
+ $need_joins{$j->[0]{-alias}}
+ );
+ }
+
+ return \@newfrom;
+}
#
# This is the code producing joined subqueries like:
];
}
-
# generate the inner/outer select lists
# for inside we consider only stuff *not* brought in by the prefetch
# on the outside we substitute any function for its alias
}
push @$inner_select, $sel;
- }
-
- # scan the from spec against different attributes, and see which joins are needed
- # in what role
- my $inner_aliastypes =
- $self->_resolve_aliases_from_select_args( $from, $where, $inner_select, $inner_attrs );
- my $outer_aliastypes =
- $self->_resolve_aliases_from_select_args( $from, $where, $outer_select, $outer_attrs );
-
-
-
- # normalize a copy of $from, so it will be easier to work with further
- # down (i.e. promote the initial hashref to an AoH)
- $from = [ @$from ];
- $from->[0] = [ $from->[0] ];
-
-
- # construct the inner $from for the subquery
- my %inner_joins = (map { %$_ } (values %$inner_aliastypes) );
- my @inner_from;
- for my $j (@$from) {
- push @inner_from, $j if $inner_joins{$j->[0]{-alias}};
+ push @{$inner_attrs->{as}}, $attrs->{as}[$i];
}
+ # construct the inner $from for the subquery
+ # we need to prune first, because this will determine if we need a group_by below
+ my $inner_from = $self->_prune_unused_joins ($from, $inner_select, $where, $inner_attrs);
- # 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
- unless ($inner_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"}) {
- $inner_attrs->{group_by} ||= $inner_select;
- last;
- }
- }
- }
-
- # demote the inner_from head
- $inner_from[0] = $inner_from[0][0];
+ # if a multi-type join was needed in the subquery - add a group_by to simulate the
+ # collapse in the subq
+ $inner_attrs->{group_by} ||= $inner_select
+ if first { ! $_->[0]{-is_single} } (@{$inner_from}[1 .. $#$inner_from]);
# generate the subquery
my $subq = $self->_select_args_to_query (
- \@inner_from,
+ $inner_from,
$inner_select,
$where,
$inner_attrs,
my $subq_joinspec = {
-alias => $attrs->{alias},
- -source_handle => $inner_from[0]{-source_handle},
+ -source_handle => $inner_from->[0]{-source_handle},
$attrs->{alias} => $subq,
};
# - it is part of the restrictions, in which case we need to collapse the outer
# result by tackling yet another group_by to the outside of the query
+ # normalize a copy of $from, so it will be easier to work with further
+ # down (i.e. promote the initial hashref to an AoH)
+ $from = [ @$from ];
+ $from->[0] = [ $from->[0] ];
+
# so first generate the outer_from, up to the substitution point
my @outer_from;
while (my $j = shift @$from) {
}
}
+ # scan the from spec against different attributes, and see which joins are needed
+ # in what role
+ my $outer_aliastypes =
+ $self->_resolve_aliastypes_from_select_args( $from, $outer_select, $where, $outer_attrs );
+
# see what's left - throw away if not selecting/restricting
# also throw in a group_by if restricting to guard against
# cross-join explosions
while (my $j = shift @$from) {
my $alias = $j->[0]{-alias};
- if ($outer_aliastypes->{select}{$alias}) {
+ if ($outer_aliastypes->{selecting}{$alias}) {
push @outer_from, $j;
}
- elsif ($outer_aliastypes->{restrict}{$alias}) {
+ elsif ($outer_aliastypes->{restricting}{$alias}) {
push @outer_from, $j;
-
- # FIXME - this should be obviated by SQLA2, as I'll be able to
- # have restrict_inner and restrict_outer... or something to that
- # effect... I think...
-
- # FIXME2 - I can't find a clean way to determine if a particular join
- # is a multi - instead I am just treating everything as a potential
- # explosive join (ribasushi)
- #
- # if (my $handle = $j->[0]{-source_handle}) {
- # my $rsrc = $handle->resolve;
- # ... need to bail out of the following if this is not a multi,
- # as it will be much easier on the db ...
-
- $outer_attrs->{group_by} ||= $outer_select;
- # }
+ $outer_attrs->{group_by} ||= $outer_select unless $j->[0]{-is_single};
}
}
return (\@outer_from, $outer_select, $where, $outer_attrs);
}
+#
+# I KNOW THIS SUCKS! GET SQLA2 OUT THE DOOR SO THIS CAN DIE!
+#
# Due to a lack of SQLA2 we fall back to crude scans of all the
# select/where/order/group attributes, in order to determine what
# aliases are neded to fulfill the query. This information is used
# throughout the code to prune unnecessary JOINs from the queries
# in an attempt to reduce the execution time.
# Although the method is pretty horrific, the worst thing that can
-# happen is for it to fail due to an unqualified column, which in
-# turn will result in a vocal exception. Qualifying the column will
-# invariably solve the problem.
-sub _resolve_aliases_from_select_args {
- my ( $self, $from, $where, $select, $attrs ) = @_;
+# happen is for it to fail due to some scalar SQL, which in turn will
+# result in a vocal exception.
+sub _resolve_aliastypes_from_select_args {
+ my ( $self, $from, $select, $where, $attrs ) = @_;
$self->throw_exception ('Unable to analyze custom {from}')
if ref $from ne 'ARRAY';
# see what aliases are there to work with
my $alias_list;
- my @from = @$from; # if I don't copy weird shit happens
- for my $j (@from) {
+ for (@$from) {
+ my $j = $_;
$j = $j->[0] if ref $j eq 'ARRAY';
- $alias_list->{$j->{-alias}} = $j;
+ my $al = $j->{-alias}
+ or next;
+
+ $alias_list->{$al} = $j;
+ $aliases_by_type->{multiplying}{$al} = 1
+ unless $j->{-is_single};
}
+ # get a column to source/alias map (including unqualified ones)
+ my $colinfo = $self->_resolve_column_info ($from);
+
# set up a botched SQLA
my $sql_maker = $self->sql_maker;
my $sep = quotemeta ($self->_sql_maker_opts->{name_sep} || '.');
- local $sql_maker->{quote_char}; # so that we can regex away
-
- my $select_sql = $sql_maker->_recurse_fields ($select);
- my $where_sql = $sql_maker->where ($where);
- my $group_by_sql = $sql_maker->_order_by({
- map { $_ => $attrs->{$_} } qw/group_by having/
+ my ($orig_lquote, $orig_rquote) = map { quotemeta $_ } (do {
+ if (ref $sql_maker->{quote_char} eq 'ARRAY') {
+ @{$sql_maker->{quote_char}}
+ }
+ else {
+ ($sql_maker->{quote_char} || '') x 2;
+ }
});
- my @order_by_chunks = (map
- { ref $_ ? $_->[0] : $_ }
- $sql_maker->_order_by_chunks ($attrs->{order_by})
- );
- # match every alias to the sql chunks above
+ local $sql_maker->{quote_char} = "\x00"; # so that we can regex away
+
+ # generate sql chunks
+ my $to_scan = {
+ restricting => [
+ $sql_maker->_recurse_where ($where),
+ $sql_maker->_order_by({
+ map { $_ => $attrs->{$_} } (qw/group_by having/)
+ }),
+ ],
+ selecting => [
+ $self->_parse_order_by ($attrs->{order_by}, $sql_maker),
+ $sql_maker->_recurse_fields ($select),
+ ],
+ };
+
+ # throw away empty chunks
+ $_ = [ map { $_ || () } @$_ ] for values %$to_scan;
+
+ # first loop through all fully qualified columns and get the corresponding
+ # alias (should work even if they are in scalarrefs)
for my $alias (keys %$alias_list) {
- my $al_re = qr/\b $alias $sep/x;
+ my $al_re = qr/
+ \x00 $alias \x00 $sep
+ |
+ \b $alias $sep
+ /x;
+
+ # add matching for possible quoted literal sql
+ $al_re = qr/ $al_re | $orig_lquote $alias $orig_rquote /x
+ if ($orig_lquote && $orig_rquote);
+
- for my $piece ($where_sql, $group_by_sql) {
- $aliases_by_type->{restrict}{$alias} = 1 if ($piece =~ $al_re);
+ for my $type (keys %$to_scan) {
+ for my $piece (@{$to_scan->{$type}}) {
+ $aliases_by_type->{$type}{$alias} = 1 if ($piece =~ $al_re);
+ }
}
+ }
+
+ # now loop through unqualified column names, and try to locate them within
+ # the chunks
+ for my $col (keys %$colinfo) {
+ next if $col =~ $sep; # if column is qualified it was caught by the above
+
+ my $col_re = qr/ \x00 $col \x00 /x;
+
+ $col_re = qr/ $col_re | $orig_lquote $col $orig_rquote /x
+ if ($orig_lquote && $orig_rquote);
- for my $piece ($select_sql, @order_by_chunks ) {
- $aliases_by_type->{select}{$alias} = 1 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);
+ }
}
}
# 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->{restrict}{$alias} = 1 if (
+ $aliases_by_type->{restricting}{$alias} = 1 if (
(not $j->{-join_type})
or
($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
for my $type (keys %$aliases_by_type) {
for my $alias (keys %{$aliases_by_type->{$type}}) {
$aliases_by_type->{$type}{$_} = 1
- for (@{ $alias_list->{$alias}{-join_path} || [] });
+ for (map { values %$_ } @{ $alias_list->{$alias}{-join_path} || [] });
}
}
# 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") ) {
+ if ( blessed $ident && $ident->isa("DBIx::Class::ResultSource") ) {
# this is compat mode for insert/update/delete which do not deal with aliases
$alias2source->{me} = $ident;
$rs_alias = 'me';
# anyway, and deep cloning is just too fucking expensive
# So replace the first hashref in the node arrayref manually
my @new_from = ($from->[0]);
- my $sw_idx = { map { $_ => 1 } @$switch_branch };
+ my $sw_idx = { map { (values %$_), 1 } @$switch_branch }; #there's one k/v per join-path
for my $j (@{$from}[1 .. $#$from]) {
my $jalias = $j->[0]{-alias};
for (my $i = 0; $i < @cond; $i++) {
my $entry = $cond[$i];
my $hash;
- if (ref $entry eq 'HASH') {
+ my $ref = ref $entry;
+ if ($ref eq 'HASH' or $ref eq 'ARRAY') {
$hash = $self->_strip_cond_qualifiers($entry);
}
- else {
+ 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;
}
}
return $cond;
}
+sub _parse_order_by {
+ my ($self, $order_by, $sql_maker) = @_;
+
+ my $parser = sub {
+ my ($sql_maker, $order_by) = @_;
+
+ return scalar $sql_maker->_order_by_chunks ($order_by)
+ unless wantarray;
+
+ my @chunks;
+ for my $chunk (map { ref $_ ? @$_ : $_ } ($sql_maker->_order_by_chunks ($order_by) ) ) {
+ $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
+ push @chunks, $chunk;
+ }
+
+ return @chunks;
+ };
+
+ if ($sql_maker) {
+ return $parser->($sql_maker, $order_by);
+ }
+ else {
+ $sql_maker = $self->sql_maker;
+ local $sql_maker->{quote_char};
+ return $parser->($sql_maker, $order_by);
+ }
+}
1;