Tighten up select list processing in ::SQLMaker
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm
CommitLineData
c443438f 1package #hide from PAUSE
2 DBIx::Class::Storage::DBIHacks;
d28bb90d 3
4#
07fadea8 5# This module contains code supporting a battery of special cases and tests for
6# many corner cases pushing the envelope of what DBIC can do. When work on
7# these utilities began in mid 2009 (51a296b402c) it wasn't immediately obvious
497d0451 8# that these pieces, despite their misleading on-first-sight-flakiness, will
07fadea8 9# become part of the generic query rewriting machinery of DBIC, allowing it to
10# both generate and process queries representing incredibly complex sets with
11# reasonable efficiency.
12#
13# Now (end of 2015), more than 6 years later the routines in this class have
14# stabilized enough, and are meticulously covered with tests, to a point where
15# an effort to formalize them into user-facing APIs might be worthwhile.
16#
17# An implementor working on publicizing and/or replacing the routines with a
18# more modern SQL generation framework should keep in mind that pretty much all
19# existing tests are constructed on the basis of real-world code used in
20# production somewhere.
21#
22# Please hack on this responsibly ;)
d28bb90d 23#
24
25use strict;
26use warnings;
27
28use base 'DBIx::Class::Storage';
29use mro 'c3';
30
6298a324 31use Scalar::Util 'blessed';
497d0451 32use DBIx::Class::_Util qw(
33 dump_value fail_on_internal_call
34);
35use DBIx::Class::SQLMaker::Util 'extract_equality_conditions';
616ca57f 36use DBIx::Class::ResultSource::FromSpec::Util qw(
37 fromspec_columns_info
38 find_join_path_to_alias
39);
e466c62b 40use DBIx::Class::Carp;
6298a324 41use namespace::clean;
d28bb90d 42
43#
052e8431 44# This code will remove non-selecting/non-restricting joins from
4b1b5ea3 45# {from} specs, aiding the RDBMS query optimizer
052e8431 46#
47sub _prune_unused_joins {
e1861c2c 48 my ($self, $attrs) = @_;
ea95892e 49
e1861c2c 50 # only standard {from} specs are supported, and we could be disabled in general
51 return ($attrs->{from}, {}) unless (
52 ref $attrs->{from} eq 'ARRAY'
53 and
54 @{$attrs->{from}} > 1
55 and
56 ref $attrs->{from}[0] eq 'HASH'
57 and
58 ref $attrs->{from}[1] eq 'ARRAY'
59 and
60 $self->_use_join_optimizer
61 );
052e8431 62
757891ed 63 my $orig_aliastypes =
64 $attrs->{_precalculated_aliastypes}
65 ||
66 $self->_resolve_aliastypes_from_select_args($attrs)
67 ;
4b1b5ea3 68
eb58c082 69 my $new_aliastypes = { %$orig_aliastypes };
70
71 # we will be recreating this entirely
72 my @reclassify = 'joining';
97e130fa 73
4b1b5ea3 74 # a grouped set will not be affected by amount of rows. Thus any
eb58c082 75 # purely multiplicator classifications can go
76 # (will be reintroduced below if needed by something else)
77 push @reclassify, qw(multiplying premultiplied)
437a9cfa 78 if $attrs->{_force_prune_multiplying_joins} or $attrs->{group_by};
4b1b5ea3 79
eb58c082 80 # nuke what will be recalculated
81 delete @{$new_aliastypes}{@reclassify};
82
e1861c2c 83 my @newfrom = $attrs->{from}[0]; # FROM head is always present
052e8431 84
eb58c082 85 # recalculate what we need once the multipliers are potentially gone
86 # ignore premultiplies, since they do not add any value to anything
a4812caa 87 my %need_joins;
eb58c082 88 for ( @{$new_aliastypes}{grep { $_ ne 'premultiplied' } keys %$new_aliastypes }) {
a4812caa 89 # add all requested aliases
90 $need_joins{$_} = 1 for keys %$_;
91
92 # add all their parents (as per joinpath which is an AoH { table => alias })
97e130fa 93 $need_joins{$_} = 1 for map { values %$_ } map { @{$_->{-parents}} } values %$_;
a4812caa 94 }
97e130fa 95
e1861c2c 96 for my $j (@{$attrs->{from}}[1..$#{$attrs->{from}}]) {
539ffe87 97 push @newfrom, $j if (
a6ef93cb 98 (! defined $j->[0]{-alias}) # legacy crap
539ffe87 99 ||
100 $need_joins{$j->[0]{-alias}}
101 );
052e8431 102 }
103
eb58c082 104 # we have a new set of joiners - for everything we nuked pull the classification
105 # off the original stack
106 for my $ctype (@reclassify) {
107 $new_aliastypes->{$ctype} = { map
108 { $need_joins{$_} ? ( $_ => $orig_aliastypes->{$ctype}{$_} ) : () }
109 keys %{$orig_aliastypes->{$ctype}}
110 }
111 }
112
113 return ( \@newfrom, $new_aliastypes );
052e8431 114}
115
052e8431 116#
d28bb90d 117# This is the code producing joined subqueries like:
8273e845 118# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
d28bb90d 119#
120sub _adjust_select_args_for_complex_prefetch {
e1861c2c 121 my ($self, $attrs) = @_;
d28bb90d 122
e1861c2c 123 $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute') unless (
124 ref $attrs->{from} eq 'ARRAY'
125 and
126 @{$attrs->{from}} > 1
127 and
128 ref $attrs->{from}[0] eq 'HASH'
129 and
130 ref $attrs->{from}[1] eq 'ARRAY'
131 );
d28bb90d 132
1e4f9fb3 133 my $root_alias = $attrs->{alias};
134
d28bb90d 135 # generate inner/outer attribute lists, remove stuff that doesn't apply
136 my $outer_attrs = { %$attrs };
e1861c2c 137 delete @{$outer_attrs}{qw(from bind rows offset group_by _grouped_by_distinct having)};
d28bb90d 138
6aa93928 139 my $inner_attrs = { %$attrs, _simple_passthrough_construction => 1 };
140 delete @{$inner_attrs}{qw(for collapse select as)};
d28bb90d 141
4df1400e 142 # there is no point of ordering the insides if there is no limit
143 delete $inner_attrs->{order_by} if (
144 delete $inner_attrs->{_order_is_artificial}
145 or
146 ! $inner_attrs->{rows}
147 );
946f6260 148
d28bb90d 149 # generate the inner/outer select lists
150 # for inside we consider only stuff *not* brought in by the prefetch
151 # on the outside we substitute any function for its alias
e1861c2c 152 $outer_attrs->{select} = [ @{$attrs->{select}} ];
36fd7f07 153
97e130fa 154 my ($root_node, $root_node_offset);
27e0370d 155
e1861c2c 156 for my $i (0 .. $#{$inner_attrs->{from}}) {
157 my $node = $inner_attrs->{from}[$i];
27e0370d 158 my $h = (ref $node eq 'HASH') ? $node
159 : (ref $node eq 'ARRAY' and ref $node->[0] eq 'HASH') ? $node->[0]
160 : next
161 ;
162
1e4f9fb3 163 if ( ($h->{-alias}||'') eq $root_alias and $h->{-rsrc} ) {
97e130fa 164 $root_node = $h;
165 $root_node_offset = $i;
27e0370d 166 last;
167 }
168 }
169
170 $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
97e130fa 171 unless $root_node;
27e0370d 172
173 # use the heavy duty resolver to take care of aliased/nonaliased naming
616ca57f 174 my $colinfo = fromspec_columns_info($inner_attrs->{from});
27e0370d 175 my $selected_root_columns;
176
e1861c2c 177 for my $i (0 .. $#{$outer_attrs->{select}}) {
178 my $sel = $outer_attrs->{select}->[$i];
d28bb90d 179
1e4f9fb3 180 next if (
181 $colinfo->{$sel} and $colinfo->{$sel}{-source_alias} ne $root_alias
182 );
183
d28bb90d 184 if (ref $sel eq 'HASH' ) {
185 $sel->{-as} ||= $attrs->{as}[$i];
e1861c2c 186 $outer_attrs->{select}->[$i] = join ('.', $root_alias, ($sel->{-as} || "inner_column_$i") );
d28bb90d 187 }
27e0370d 188 elsif (! ref $sel and my $ci = $colinfo->{$sel}) {
189 $selected_root_columns->{$ci->{-colname}} = 1;
190 }
d28bb90d 191
e1861c2c 192 push @{$inner_attrs->{select}}, $sel;
bb9bffea 193
194 push @{$inner_attrs->{as}}, $attrs->{as}[$i];
d28bb90d 195 }
196
757891ed 197 my $inner_aliastypes = $self->_resolve_aliastypes_from_select_args($inner_attrs);
198
199 # In the inner subq we will need to fetch *only* native columns which may
97e130fa 200 # be a part of an *outer* join condition, or an order_by (which needs to be
e1861c2c 201 # preserved outside), or wheres. In other words everything but the inner
202 # selector
97e130fa 203 # We can not just fetch everything because a potential has_many restricting
204 # join collapse *will not work* on heavy data types.
97e130fa 205
757891ed 206 # essentially a map of all non-selecting seen columns
207 # the sort is there for a nicer select list
208 for (
209 sort
210 map
211 { keys %{$_->{-seen_columns}||{}} }
212 map
213 { values %{$inner_aliastypes->{$_}} }
214 grep
215 { $_ ne 'selecting' }
216 keys %$inner_aliastypes
217 ) {
97e130fa 218 my $ci = $colinfo->{$_} or next;
219 if (
1e4f9fb3 220 $ci->{-source_alias} eq $root_alias
97e130fa 221 and
222 ! $selected_root_columns->{$ci->{-colname}}++
223 ) {
224 # adding it to both to keep limits not supporting dark selectors happy
e1861c2c 225 push @{$inner_attrs->{select}}, $ci->{-fq_colname};
97e130fa 226 push @{$inner_attrs->{as}}, $ci->{-fq_colname};
27e0370d 227 }
228 }
229
e1861c2c 230 # construct the inner {from} and lock it in a subquery
48580715 231 # we need to prune first, because this will determine if we need a group_by below
97e130fa 232 # throw away all non-selecting, non-restricting multijoins
eb58c082 233 # (since we def. do not care about multiplication of the contents of the subquery)
6395604e 234 my $inner_subq = do {
ea95892e 235
eb58c082 236 # must use it here regardless of user requests (vastly gentler on optimizer)
7db939de 237 local $self->{_use_join_optimizer} = 1
238 unless $self->{_use_join_optimizer};
ea95892e 239
97e130fa 240 # throw away multijoins since we def. do not care about those inside the subquery
757891ed 241 # $inner_aliastypes *will* be redefined at this point
242 ($inner_attrs->{from}, $inner_aliastypes ) = $self->_prune_unused_joins ({
243 %$inner_attrs,
244 _force_prune_multiplying_joins => 1,
245 _precalculated_aliastypes => $inner_aliastypes,
437a9cfa 246 });
ea95892e 247
eb58c082 248 # uh-oh a multiplier (which is not us) left in, this is a problem for limits
249 # we will need to add a group_by to collapse the resultset for proper counts
0a3441ee 250 if (
eb58c082 251 grep { $_ ne $root_alias } keys %{ $inner_aliastypes->{multiplying} || {} }
1e4f9fb3 252 and
560978e2 253 # if there are user-supplied groups - assume user knows wtf they are up to
254 ( ! $inner_aliastypes->{grouping} or $inner_attrs->{_grouped_by_distinct} )
0a3441ee 255 ) {
1e4f9fb3 256
eb58c082 257 my $cur_sel = { map { $_ => 1 } @{$inner_attrs->{select}} };
1e4f9fb3 258
eb58c082 259 # *possibly* supplement the main selection with pks if not already
260 # there, as they will have to be a part of the group_by to collapse
261 # things properly
262 my $inner_select_with_extras;
263 my @pks = map { "$root_alias.$_" } $root_node->{-rsrc}->primary_columns
264 or $self->throw_exception( sprintf
265 'Unable to perform complex limited prefetch off %s without declared primary key',
266 $root_node->{-rsrc}->source_name,
e1861c2c 267 );
eb58c082 268 for my $col (@pks) {
269 push @{ $inner_select_with_extras ||= [ @{$inner_attrs->{select}} ] }, $col
270 unless $cur_sel->{$col}++;
1e4f9fb3 271 }
eb58c082 272
273 ($inner_attrs->{group_by}, $inner_attrs->{order_by}) = $self->_group_over_selection({
274 %$inner_attrs,
275 $inner_select_with_extras ? ( select => $inner_select_with_extras ) : (),
276 _aliastypes => $inner_aliastypes,
277 });
0a3441ee 278 }
d28bb90d 279
e1861c2c 280 # we already optimized $inner_attrs->{from} above
97e130fa 281 # and already local()ized
282 $self->{_use_join_optimizer} = 0;
d28bb90d 283
ea95892e 284 # generate the subquery
6395604e 285 $self->_select_args_to_query (
e1861c2c 286 @{$inner_attrs}{qw(from select where)},
ea95892e 287 $inner_attrs,
288 );
d28bb90d 289 };
290
291 # Generate the outer from - this is relatively easy (really just replace
292 # the join slot with the subquery), with a major caveat - we can not
293 # join anything that is non-selecting (not part of the prefetch), but at
294 # the same time is a multi-type relationship, as it will explode the result.
295 #
296 # There are two possibilities here
297 # - either the join is non-restricting, in which case we simply throw it away
298 # - it is part of the restrictions, in which case we need to collapse the outer
299 # result by tackling yet another group_by to the outside of the query
300
27e0370d 301 # work on a shallow copy
e1861c2c 302 my @orig_from = @{$attrs->{from}};
303
052e8431 304
e1861c2c 305 $outer_attrs->{from} = \ my @outer_from;
53c29913 306
27e0370d 307 # we may not be the head
97e130fa 308 if ($root_node_offset) {
e1861c2c 309 # first generate the outer_from, up to the substitution point
310 @outer_from = splice @orig_from, 0, $root_node_offset;
27e0370d 311
e1861c2c 312 # substitute the subq at the right spot
27e0370d 313 push @outer_from, [
314 {
1e4f9fb3 315 -alias => $root_alias,
97e130fa 316 -rsrc => $root_node->{-rsrc},
1e4f9fb3 317 $root_alias => $inner_subq,
27e0370d 318 },
e1861c2c 319 # preserve attrs from what is now the head of the from after the splice
320 @{$orig_from[0]}[1 .. $#{$orig_from[0]}],
27e0370d 321 ];
322 }
323 else {
27e0370d 324 @outer_from = {
1e4f9fb3 325 -alias => $root_alias,
27e0370d 326 -rsrc => $root_node->{-rsrc},
1e4f9fb3 327 $root_alias => $inner_subq,
27e0370d 328 };
d28bb90d 329 }
330
e1861c2c 331 shift @orig_from; # what we just replaced above
97e130fa 332
ea95892e 333 # scan the *remaining* from spec against different attributes, and see which joins are needed
052e8431 334 # in what role
975b573a 335 my $outer_aliastypes = $outer_attrs->{_aliastypes} =
e1861c2c 336 $self->_resolve_aliastypes_from_select_args({ %$outer_attrs, from => \@orig_from });
052e8431 337
a4812caa 338 # unroll parents
1e4f9fb3 339 my ($outer_select_chain, @outer_nonselecting_chains) = map { +{
340 map { $_ => 1 } map { values %$_} map { @{$_->{-parents}} } values %{ $outer_aliastypes->{$_} || {} }
341 } } qw/selecting restricting grouping ordering/;
a4812caa 342
d28bb90d 343 # see what's left - throw away if not selecting/restricting
eb58c082 344 my $may_need_outer_group_by;
e1861c2c 345 while (my $j = shift @orig_from) {
d28bb90d 346 my $alias = $j->[0]{-alias};
347
a4812caa 348 if (
349 $outer_select_chain->{$alias}
350 ) {
351 push @outer_from, $j
d28bb90d 352 }
87b12551 353 elsif (grep { $_->{$alias} } @outer_nonselecting_chains ) {
d28bb90d 354 push @outer_from, $j;
eb58c082 355 $may_need_outer_group_by ||= $outer_aliastypes->{multiplying}{$alias} ? 1 : 0;
d28bb90d 356 }
357 }
358
eb58c082 359 # also throw in a synthetic group_by if a non-selecting multiplier,
360 # to guard against cross-join explosions
361 # the logic is somewhat fragile, but relies on the idea that if a user supplied
362 # a group by on their own - they know what they were doing
363 if ( $may_need_outer_group_by and $attrs->{_grouped_by_distinct} ) {
364 ($outer_attrs->{group_by}, $outer_attrs->{order_by}) = $self->_group_over_selection ({
560978e2 365 %$outer_attrs,
366 from => \@outer_from,
560978e2 367 });
36fd7f07 368 }
369
07fadea8 370 # FIXME: The {where} ends up in both the inner and outer query, i.e. *twice*
371 #
372 # This is rather horrific, and while we currently *do* have enough
373 # introspection tooling available to attempt a stab at properly deciding
374 # whether or not to include the where condition on the outside, the
375 # machinery is still too slow to apply it here.
376 # Thus for the time being we do not attempt any sanitation of the where
377 # clause and just pass it through on both sides of the subquery. This *will*
378 # be addressed at a later stage, most likely after folding the SQL generator
379 # into SQLMaker proper
d28bb90d 380 #
381 # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
07fadea8 382 #
e1861c2c 383 return $outer_attrs;
d28bb90d 384}
385
07fadea8 386# This is probably the ickiest, yet most relied upon part of the codebase:
387# this is the place where we take arbitrary SQL input and break it into its
388# constituent parts, making sure we know which *sources* are used in what
389# *capacity* ( selecting / restricting / grouping / ordering / joining, etc )
390# Although the method is pretty horrific, the worst thing that can happen is
391# for a classification failure, which in turn will result in a vocal exception,
392# and will lead to a relatively prompt fix.
393# The code has been slowly improving and is covered with a formiddable battery
394# of tests, so can be considered "reliably stable" at this point (Oct 2015).
1a736efb 395#
07fadea8 396# A note to implementors attempting to "replace" this - keep in mind that while
397# there are multiple optimization avenues, the actual "scan literal elements"
398# part *MAY NEVER BE REMOVED*, even if it is limited only ot the (future) AST
399# nodes that are deemed opaque (i.e. contain literal expressions). The use of
400# blackbox literals is at this point firmly a user-facing API, and is one of
401# *the* reasons DBIC remains as flexible as it is. In other words, when working
402# on this keep in mind that the following is widespread and *encouraged* way
403# of using DBIC in the wild when push comes to shove:
404#
405# $rs->search( {}, {
406# select => \[ $random, @stuff],
407# from => \[ $random, @stuff ],
408# where => \[ $random, @stuff ],
409# group_by => \[ $random, @stuff ],
410# order_by => \[ $random, @stuff ],
411# } )
412#
413# Various incarnations of the above are reflected in many of the tests. If one
414# gets to fail, you get to fix it. A "this is crazy, nobody does that" is not
415# acceptable going forward.
1a736efb 416#
539ffe87 417sub _resolve_aliastypes_from_select_args {
e1861c2c 418 my ( $self, $attrs ) = @_;
546f1cd9 419
ad630f4b 420 $self->throw_exception ('Unable to analyze custom {from}')
e1861c2c 421 if ref $attrs->{from} ne 'ARRAY';
546f1cd9 422
ad630f4b 423 # what we will return
964a3c71 424 my $aliases_by_type;
546f1cd9 425
ad630f4b 426 # see what aliases are there to work with
eb58c082 427 # and record who is a multiplier and who is premultiplied
ad630f4b 428 my $alias_list;
e1861c2c 429 for my $node (@{$attrs->{from}}) {
430
431 my $j = $node;
ad630f4b 432 $j = $j->[0] if ref $j eq 'ARRAY';
539ffe87 433 my $al = $j->{-alias}
434 or next;
435
436 $alias_list->{$al} = $j;
eb58c082 437
438 $aliases_by_type->{multiplying}{$al} ||= { -parents => $j->{-join_path}||[] }
a4812caa 439 # not array == {from} head == can't be multiplying
eb58c082 440 if ref($node) eq 'ARRAY' and ! $j->{-is_single};
441
442 $aliases_by_type->{premultiplied}{$al} ||= { -parents => $j->{-join_path}||[] }
443 # parts of the path that are not us but are multiplying
444 if grep { $aliases_by_type->{multiplying}{$_} }
445 grep { $_ ne $al }
446 map { values %$_ }
447 @{ $j->{-join_path}||[] }
546f1cd9 448 }
546f1cd9 449
318e3d94 450 # get a column to source/alias map (including unambiguous unqualified ones)
616ca57f 451 my $colinfo = fromspec_columns_info($attrs->{from});
1a736efb 452
ad630f4b 453 # set up a botched SQLA
454 my $sql_maker = $self->sql_maker;
07f31d19 455
4c2b30d6 456 # these are throw away results, do not pollute the bind stack
0542ec57 457 local $sql_maker->{where_bind};
458 local $sql_maker->{group_bind};
459 local $sql_maker->{having_bind};
97e130fa 460 local $sql_maker->{from_bind};
3f5b99fe 461
462 # we can't scan properly without any quoting (\b doesn't cut it
463 # everywhere), so unless there is proper quoting set - use our
464 # own weird impossible character.
465 # Also in the case of no quoting, we need to explicitly disable
466 # name_sep, otherwise sorry nasty legacy syntax like
467 # { 'count(foo.id)' => { '>' => 3 } } will stop working >:(
468 local $sql_maker->{quote_char} = $sql_maker->{quote_char};
469 local $sql_maker->{name_sep} = $sql_maker->{name_sep};
470
471 unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) {
e493ecb2 472 $sql_maker->{quote_char} = ["\x00", "\xFF"];
473 # if we don't unset it we screw up retarded but unfortunately working
474 # 'MAX(foo.bar)' => { '>', 3 }
3f5b99fe 475 $sql_maker->{name_sep} = '';
476 }
477
478 my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
07f31d19 479
1a736efb 480 # generate sql chunks
481 my $to_scan = {
482 restricting => [
a9e985b7 483 ($sql_maker->_recurse_where ($attrs->{where}))[0],
1e4f9fb3 484 $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }),
485 ],
486 grouping => [
487 $sql_maker->_parse_rs_attrs ({ group_by => $attrs->{group_by} }),
1a736efb 488 ],
97e130fa 489 joining => [
490 $sql_maker->_recurse_from (
e1861c2c 491 ref $attrs->{from}[0] eq 'ARRAY' ? $attrs->{from}[0][0] : $attrs->{from}[0],
492 @{$attrs->{from}}[1 .. $#{$attrs->{from}}],
97e130fa 493 ),
494 ],
1a736efb 495 selecting => [
fdd47fe8 496 # kill all selectors which look like a proper subquery
497 # this is a sucky heuristic *BUT* - if we get it wrong the query will simply
498 # fail to run, so we are relatively safe
499 grep
500 { $_ !~ / \A \s* \( \s* SELECT \s+ .+? \s+ FROM \s+ .+? \) \s* \z /xsi }
501 map
02562a20 502 {
503 length ref $_
504 ? ($sql_maker->_recurse_fields($_))[0]
505 : $sql_maker->_quote($_)
506 }
fdd47fe8 507 @{$attrs->{select}}
1e4f9fb3 508 ],
66bbb12c 509 ordering => [ map
510 {
511 ( my $sql = (ref $_ ? $_->[0] : $_) ) =~ s/ \s+ (?: ASC | DESC ) \s* \z //xi;
512 $sql;
513 }
514 $sql_maker->_order_by_chunks( $attrs->{order_by} ),
1a736efb 515 ],
516 };
07f31d19 517
89203568 518 # we will be bulk-scanning anyway - pieces will not matter in that case,
519 # thus join everything up
fdd47fe8 520 # throw away empty-string chunks, and make sure no binds snuck in
521 # note that we operate over @{$to_scan->{$type}}, hence the
522 # semi-mindbending ... map ... for values ...
89203568 523 ( $_ = join ' ', map {
0dadd60d 524
89203568 525 ( ! defined $_ ) ? ()
8fc4291e 526 : ( length ref $_ ) ? $self->throw_exception(
527 "Unexpected ref in scan-plan: " . dump_value $_
528 )
89203568 529 : ( $_ =~ /^\s*$/ ) ? ()
530 : $_
0dadd60d 531
89203568 532 } @$_ ) for values %$to_scan;
fdd47fe8 533
534 # throw away empty to-scan's
535 (
89203568 536 length $to_scan->{$_}
fdd47fe8 537 or
538 delete $to_scan->{$_}
539 ) for keys %$to_scan;
0dadd60d 540
07f31d19 541
89203568 542
90c9dd1d 543 # these will be used for matching in the loop below
544 my $all_aliases = join ' | ', map { quotemeta $_ } keys %$alias_list;
545 my $fq_col_re = qr/
546 $lquote ( $all_aliases ) $rquote $sep (?: $lquote ([^$rquote]+) $rquote )?
547 |
548 \b ( $all_aliases ) \. ( [^\s\)\($rquote]+ )?
549 /x;
550
89203568 551
90c9dd1d 552 my $all_unq_columns = join ' | ',
553 map
554 { quotemeta $_ }
555 grep
556 # using a regex here shows up on profiles, boggle
557 { index( $_, '.') < 0 }
558 keys %$colinfo
559 ;
560 my $unq_col_re = $all_unq_columns
89203568 561 ? qr/
562 $lquote ( $all_unq_columns ) $rquote
563 |
564 (?: \A | \s ) ( $all_unq_columns ) (?: \s | \z )
565 /x
90c9dd1d 566 : undef
567 ;
568
569
19955cdf 570 # the actual scan, per type
318e3d94 571 for my $type (keys %$to_scan) {
19955cdf 572
90c9dd1d 573
19955cdf 574 # now loop through all fully qualified columns and get the corresponding
575 # alias (should work even if they are in scalarrefs)
90c9dd1d 576 #
89203568 577 # The regex captures in multiples of 4, with one of the two pairs being
90c9dd1d 578 # undef. There may be a *lot* of matches, hence the convoluted loop
89203568 579 my @matches = $to_scan->{$type} =~ /$fq_col_re/g;
90c9dd1d 580 my $i = 0;
581 while( $i < $#matches ) {
582
583 if (
584 defined $matches[$i]
585 ) {
586 $aliases_by_type->{$type}{$matches[$i]} ||= { -parents => $alias_list->{$matches[$i]}{-join_path}||[] };
587
588 $aliases_by_type->{$type}{$matches[$i]}{-seen_columns}{"$matches[$i].$matches[$i+1]"} = "$matches[$i].$matches[$i+1]"
589 if defined $matches[$i+1];
590
591 $i += 2;
1a736efb 592 }
1a736efb 593
90c9dd1d 594 $i += 2;
595 }
1a736efb 596
07f31d19 597
90c9dd1d 598 # now loop through unqualified column names, and try to locate them within
599 # the chunks, if there are any unqualified columns in the 1st place
600 next unless $unq_col_re;
89203568 601
602 # The regex captures in multiples of 2, one of the two being undef
603 for ( $to_scan->{$type} =~ /$unq_col_re/g ) {
604 defined $_ or next;
90c9dd1d 605 my $alias = $colinfo->{$_}{-source_alias} or next;
606 $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
607 $aliases_by_type->{$type}{$alias}{-seen_columns}{"$alias.$_"} = $_
07f31d19 608 }
609 }
610
90c9dd1d 611
07f31d19 612 # Add any non-left joins to the restriction list (such joins are indeed restrictions)
19955cdf 613 (
614 $_->{-alias}
615 and
616 ! $aliases_by_type->{restricting}{ $_->{-alias} }
617 and
618 (
619 not $_->{-join_type}
07f31d19 620 or
19955cdf 621 $_->{-join_type} !~ /^left (?: \s+ outer)? $/xi
622 )
623 and
624 $aliases_by_type->{restricting}{ $_->{-alias} } = { -parents => $_->{-join_path}||[] }
625 ) for values %$alias_list;
07f31d19 626
90c9dd1d 627
19955cdf 628 # final cleanup
629 (
630 keys %{$aliases_by_type->{$_}}
631 or
632 delete $aliases_by_type->{$_}
633 ) for keys %$aliases_by_type;
1e4f9fb3 634
90c9dd1d 635
19955cdf 636 $aliases_by_type;
07f31d19 637}
638
eb58c082 639# This is the engine behind { distinct => 1 } and the general
640# complex prefetch grouper
0a3441ee 641sub _group_over_selection {
560978e2 642 my ($self, $attrs) = @_;
0a3441ee 643
616ca57f 644 my $colinfos = fromspec_columns_info($attrs->{from});
0a3441ee 645
646 my (@group_by, %group_index);
647
36fd7f07 648 # the logic is: if it is a { func => val } we assume an aggregate,
649 # otherwise if \'...' or \[...] we assume the user knows what is
650 # going on thus group over it
560978e2 651 for (@{$attrs->{select}}) {
0a3441ee 652 if (! ref($_) or ref ($_) ne 'HASH' ) {
653 push @group_by, $_;
654 $group_index{$_}++;
560978e2 655 if ($colinfos->{$_} and $_ !~ /\./ ) {
0a3441ee 656 # add a fully qualified version as well
560978e2 657 $group_index{"$colinfos->{$_}{-source_alias}.$_"}++;
0a3441ee 658 }
07f31d19 659 }
660 }
ad630f4b 661
eb58c082 662 my @order_by = $self->_extract_order_criteria($attrs->{order_by})
663 or return (\@group_by, $attrs->{order_by});
664
665 # add any order_by parts that are not already present in the group_by
666 # to maintain SQL cross-compatibility and general sanity
667 #
668 # also in case the original selection is *not* unique, or in case part
669 # of the ORDER BY refers to a multiplier - we will need to replace the
670 # skipped order_by elements with their MIN/MAX equivalents as to maintain
671 # the proper overall order without polluting the group criteria (and
672 # possibly changing the outcome entirely)
673
674 my ($leftovers, $sql_maker, @new_order_by, $order_chunks, $aliastypes);
675
676 my $group_already_unique = $self->_columns_comprise_identifying_set($colinfos, \@group_by);
677
678 for my $o_idx (0 .. $#order_by) {
679
680 # if the chunk is already a min/max function - there is nothing left to touch
681 next if $order_by[$o_idx][0] =~ /^ (?: min | max ) \s* \( .+ \) $/ix;
682
0a3441ee 683 # only consider real columns (for functions the user got to do an explicit group_by)
eb58c082 684 my $chunk_ci;
685 if (
686 @{$order_by[$o_idx]} != 1
687 or
688 # only declare an unknown *plain* identifier as "leftover" if we are called with
689 # aliastypes to examine. If there are none - we are still in _resolve_attrs, and
690 # can just assume the user knows what they want
691 ( ! ( $chunk_ci = $colinfos->{$order_by[$o_idx][0]} ) and $attrs->{_aliastypes} )
692 ) {
693 push @$leftovers, $order_by[$o_idx][0];
14e26c5f 694 }
560978e2 695
eb58c082 696 next unless $chunk_ci;
697
698 # no duplication of group criteria
699 next if $group_index{$chunk_ci->{-fq_colname}};
700
701 $aliastypes ||= (
702 $attrs->{_aliastypes}
560978e2 703 or
eb58c082 704 $self->_resolve_aliastypes_from_select_args({
705 from => $attrs->{from},
706 order_by => $attrs->{order_by},
707 })
708 ) if $group_already_unique;
709
710 # check that we are not ordering by a multiplier (if a check is requested at all)
711 if (
712 $group_already_unique
713 and
714 ! $aliastypes->{multiplying}{$chunk_ci->{-source_alias}}
715 and
716 ! $aliastypes->{premultiplied}{$chunk_ci->{-source_alias}}
560978e2 717 ) {
eb58c082 718 push @group_by, $chunk_ci->{-fq_colname};
719 $group_index{$chunk_ci->{-fq_colname}}++
560978e2 720 }
eb58c082 721 else {
722 # We need to order by external columns without adding them to the group
723 # (eiehter a non-unique selection, or a multi-external)
724 #
725 # This doesn't really make sense in SQL, however from DBICs point
726 # of view is rather valid (e.g. order the leftmost objects by whatever
727 # criteria and get the offset/rows many). There is a way around
728 # this however in SQL - we simply tae the direction of each piece
729 # of the external order and convert them to MIN(X) for ASC or MAX(X)
730 # for DESC, and group_by the root columns. The end result should be
731 # exactly what we expect
07fadea8 732 #
7fe322c8 733
734 # both populated on the first loop over $o_idx
eb58c082 735 $sql_maker ||= $self->sql_maker;
736 $order_chunks ||= [
737 map { ref $_ eq 'ARRAY' ? $_ : [ $_ ] } $sql_maker->_order_by_chunks($attrs->{order_by})
738 ];
0a3441ee 739
eb58c082 740 my ($chunk, $is_desc) = $sql_maker->_split_order_chunk($order_chunks->[$o_idx][0]);
741
07fadea8 742 # we reached that far - wrap any part of the order_by that "responded"
743 # to an ordering alias into a MIN/MAX
eb58c082 744 $new_order_by[$o_idx] = \[
745 sprintf( '%s( %s )%s',
7fe322c8 746 $self->_minmax_operator_for_datatype($chunk_ci->{data_type}, $is_desc),
eb58c082 747 $chunk,
748 ($is_desc ? ' DESC' : ''),
749 ),
750 @ {$order_chunks->[$o_idx]} [ 1 .. $#{$order_chunks->[$o_idx]} ]
751 ];
752 }
0a3441ee 753 }
754
eb58c082 755 $self->throw_exception ( sprintf
9736be65 756 'Unable to programatically derive a required group_by from the supplied '
757 . 'order_by criteria. To proceed either add an explicit group_by, or '
758 . 'simplify your order_by to only include plain columns '
759 . '(supplied order_by: %s)',
eb58c082 760 join ', ', map { "'$_'" } @$leftovers,
761 ) if $leftovers;
762
763 # recreate the untouched order parts
764 if (@new_order_by) {
765 $new_order_by[$_] ||= \ $order_chunks->[$_] for ( 0 .. $#$order_chunks );
766 }
767
768 return (
769 \@group_by,
770 (@new_order_by ? \@new_order_by : $attrs->{order_by} ), # same ref as original == unchanged
771 );
07f31d19 772}
773
7fe322c8 774sub _minmax_operator_for_datatype {
775 #my ($self, $datatype, $want_max) = @_;
776
777 $_[2] ? 'MAX' : 'MIN';
778}
779
bac358c9 780sub _extract_order_criteria {
1a736efb 781 my ($self, $order_by, $sql_maker) = @_;
c0748280 782
1a736efb 783 my $parser = sub {
e6977bbb 784 my ($sql_maker, $order_by, $orig_quote_chars) = @_;
c0748280 785
1a736efb 786 return scalar $sql_maker->_order_by_chunks ($order_by)
787 unless wantarray;
c0748280 788
e6977bbb 789 my ($lq, $rq, $sep) = map { quotemeta($_) } (
790 ($orig_quote_chars ? @$orig_quote_chars : $sql_maker->_quote_chars),
791 $sql_maker->name_sep
792 );
793
1a736efb 794 my @chunks;
bac358c9 795 for ($sql_maker->_order_by_chunks ($order_by) ) {
e6977bbb 796 my $chunk = ref $_ ? [ @$_ ] : [ $_ ];
cb3e87f5 797 ($chunk->[0]) = $sql_maker->_split_order_chunk($chunk->[0]);
e6977bbb 798
799 # order criteria may have come back pre-quoted (literals and whatnot)
800 # this is fragile, but the best we can currently do
801 $chunk->[0] =~ s/^ $lq (.+?) $rq $sep $lq (.+?) $rq $/"$1.$2"/xe
802 or $chunk->[0] =~ s/^ $lq (.+) $rq $/$1/x;
803
1a736efb 804 push @chunks, $chunk;
bac6c4fb 805 }
1a736efb 806
807 return @chunks;
808 };
809
810 if ($sql_maker) {
811 return $parser->($sql_maker, $order_by);
bac6c4fb 812 }
813 else {
1a736efb 814 $sql_maker = $self->sql_maker;
e6977bbb 815
816 # pass these in to deal with literals coming from
817 # the user or the deep guts of prefetch
818 my $orig_quote_chars = [$sql_maker->_quote_chars];
819
1a736efb 820 local $sql_maker->{quote_char};
e6977bbb 821 return $parser->($sql_maker, $order_by, $orig_quote_chars);
bac6c4fb 822 }
bac6c4fb 823}
824
7cec4356 825sub _order_by_is_stable {
5f11e54f 826 my ($self, $ident, $order_by, $where) = @_;
c0748280 827
eb58c082 828 my @cols = (
8d005ad9 829 ( map { $_->[0] } $self->_extract_order_criteria($order_by) ),
497d0451 830 ( $where ? keys %{ extract_equality_conditions( $where ) } : () ),
df4312bc 831 ) or return 0;
eb58c082 832
616ca57f 833 my $colinfo = fromspec_columns_info($ident, \@cols);
eb58c082 834
835 return keys %$colinfo
836 ? $self->_columns_comprise_identifying_set( $colinfo, \@cols )
df4312bc 837 : 0
eb58c082 838 ;
839}
c0748280 840
eb58c082 841sub _columns_comprise_identifying_set {
842 my ($self, $colinfo, $columns) = @_;
7cec4356 843
844 my $cols_per_src;
eb58c082 845 $cols_per_src -> {$_->{-source_alias}} -> {$_->{-colname}} = $_
846 for grep { defined $_ } @{$colinfo}{@$columns};
7cec4356 847
848 for (values %$cols_per_src) {
849 my $src = (values %$_)[0]->{-result_source};
850 return 1 if $src->_identifying_column_set($_);
c0748280 851 }
852
df4312bc 853 return 0;
7cec4356 854}
855
df4312bc 856# this is almost similar to _order_by_is_stable, except it takes
0e81e691 857# a single rsrc, and will succeed only if the first portion of the order
858# by is stable.
859# returns that portion as a colinfo hashref on success
df4312bc 860sub _extract_colinfo_of_stable_main_source_order_by_portion {
302d35f8 861 my ($self, $attrs) = @_;
0e81e691 862
616ca57f 863 my $nodes = find_join_path_to_alias($attrs->{from}, $attrs->{alias});
302d35f8 864
865 return unless defined $nodes;
0e81e691 866
867 my @ord_cols = map
868 { $_->[0] }
302d35f8 869 ( $self->_extract_order_criteria($attrs->{order_by}) )
0e81e691 870 ;
871 return unless @ord_cols;
872
302d35f8 873 my $valid_aliases = { map { $_ => 1 } (
874 $attrs->{from}[0]{-alias},
875 map { values %$_ } @$nodes,
876 ) };
318e3d94 877
616ca57f 878 my $colinfos = fromspec_columns_info($attrs->{from});
302d35f8 879
880 my ($colinfos_to_return, $seen_main_src_cols);
881
882 for my $col (@ord_cols) {
883 # if order criteria is unresolvable - there is nothing we can do
884 my $colinfo = $colinfos->{$col} or last;
885
886 # if we reached the end of the allowed aliases - also nothing we can do
887 last unless $valid_aliases->{$colinfo->{-source_alias}};
888
889 $colinfos_to_return->{$col} = $colinfo;
890
891 $seen_main_src_cols->{$colinfo->{-colname}} = 1
892 if $colinfo->{-source_alias} eq $attrs->{alias};
0e81e691 893 }
894
497d0451 895 # FIXME: the condition may be singling out things on its own, so we
896 # conceivably could come back with "stable-ordered by nothing"
897 # not confident enough in the parser yet, so punt for the time being
302d35f8 898 return unless $seen_main_src_cols;
0e81e691 899
302d35f8 900 my $main_src_fixed_cols_from_cond = [ $attrs->{where}
901 ? (
902 map
903 {
904 ( $colinfos->{$_} and $colinfos->{$_}{-source_alias} eq $attrs->{alias} )
905 ? $colinfos->{$_}{-colname}
906 : ()
907 }
497d0451 908 keys %{ extract_equality_conditions( $attrs->{where} ) }
302d35f8 909 )
910 : ()
911 ];
0e81e691 912
302d35f8 913 return $attrs->{result_source}->_identifying_column_set([
914 keys %$seen_main_src_cols,
915 @$main_src_fixed_cols_from_cond,
916 ]) ? $colinfos_to_return : ();
0e81e691 917}
918
616ca57f 919sub _resolve_column_info :DBIC_method_is_indirect_sugar {
920 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
921 carp_unique("_resolve_column_info() is deprecated, ask on IRC for a better alternative");
922
923 fromspec_columns_info( @_[1,2] );
924}
925
926sub _find_join_path_to_node :DBIC_method_is_indirect_sugar {
927 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
928 carp_unique("_find_join_path_to_node() is deprecated, ask on IRC for a better alternative");
929
930 find_join_path_to_alias( @_[1,2] );
931}
932
497d0451 933sub _collapse_cond :DBIC_method_is_indirect_sugar {
934 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
935 carp_unique("_collapse_cond() is deprecated, ask on IRC for a better alternative");
135ac69d 936
497d0451 937 shift;
938 DBIx::Class::SQLMaker::Util::normalize_sqla_condition(@_);
8d005ad9 939}
940
497d0451 941sub _extract_fixed_condition_columns :DBIC_method_is_indirect_sugar {
942 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
943 carp_unique("_extract_fixed_condition_columns() is deprecated, ask on IRC for a better alternative");
8d005ad9 944
497d0451 945 shift;
946 extract_equality_conditions(@_);
c0748280 947}
bac6c4fb 948
1e8d85b3 949sub _resolve_ident_sources :DBIC_method_is_indirect_sugar {
950 DBIx::Class::Exception->throw(
951 '_resolve_ident_sources() has been removed with no replacement, '
952 . 'ask for advice on IRC if this affected you'
953 );
954}
955
956sub _inner_join_to_node :DBIC_method_is_indirect_sugar {
957 DBIx::Class::Exception->throw(
958 '_inner_join_to_node() has been removed with no replacement, '
959 . 'ask for advice on IRC if this affected you'
960 );
961}
962
d28bb90d 9631;