Centralize and sanify generation of synthetic group_by criteria
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm
index 95b4092..8a3cb02 100644 (file)
@@ -38,21 +38,28 @@ sub _prune_unused_joins {
     $self->_use_join_optimizer
   );
 
-  my $aliastypes = $self->_resolve_aliastypes_from_select_args($attrs);
+  my $orig_aliastypes = $self->_resolve_aliastypes_from_select_args($attrs);
 
-  my $orig_joins = delete $aliastypes->{joining};
-  my $orig_multiplying = $aliastypes->{multiplying};
+  my $new_aliastypes = { %$orig_aliastypes };
+
+  # we will be recreating this entirely
+  my @reclassify = 'joining';
 
   # a grouped set will not be affected by amount of rows. Thus any
-  # {multiplying} joins can go
-  delete $aliastypes->{multiplying}
+  # purely multiplicator classifications can go
+  # (will be reintroduced below if needed by something else)
+  push @reclassify, qw(multiplying premultiplied)
     if $attrs->{_force_prune_multiplying_joins} or $attrs->{group_by};
 
+  # nuke what will be recalculated
+  delete @{$new_aliastypes}{@reclassify};
+
   my @newfrom = $attrs->{from}[0]; # FROM head is always present
 
+  # recalculate what we need once the multipliers are potentially gone
+  # ignore premultiplies, since they do not add any value to anything
   my %need_joins;
-
-  for (values %$aliastypes) {
+  for ( @{$new_aliastypes}{grep { $_ ne 'premultiplied' } keys %$new_aliastypes }) {
     # add all requested aliases
     $need_joins{$_} = 1 for keys %$_;
 
@@ -68,11 +75,16 @@ sub _prune_unused_joins {
     );
   }
 
-  return ( \@newfrom, {
-    multiplying => { map { $need_joins{$_} ? ($_  => $orig_multiplying->{$_}) : () } keys %$orig_multiplying },
-    %$aliastypes,
-    joining => { map { $_ => $orig_joins->{$_} } keys %need_joins },
-  } );
+  # we have a new set of joiners - for everything we nuked pull the classification
+  # off the original stack
+  for my $ctype (@reclassify) {
+    $new_aliastypes->{$ctype} = { map
+      { $need_joins{$_} ? ( $_ => $orig_aliastypes->{$ctype}{$_} ) : () }
+      keys %{$orig_aliastypes->{$ctype}}
+    }
+  }
+
+  return ( \@newfrom, $new_aliastypes );
 }
 
 #
@@ -183,10 +195,10 @@ sub _adjust_select_args_for_complex_prefetch {
   # construct the inner {from} and lock it in a subquery
   # we need to prune first, because this will determine if we need a group_by below
   # throw away all non-selecting, non-restricting multijoins
-  # (since we def. do not care about multiplication those inside the subquery)
+  # (since we def. do not care about multiplication of the contents of the subquery)
   my $inner_subq = do {
 
-    # must use it here regardless of user requests
+    # must use it here regardless of user requests (vastly gentler on optimizer)
     local $self->{_use_join_optimizer} = 1;
 
     # throw away multijoins since we def. do not care about those inside the subquery
@@ -194,116 +206,36 @@ sub _adjust_select_args_for_complex_prefetch {
       %$inner_attrs, _force_prune_multiplying_joins => 1
     });
 
-    # uh-oh a multiplier (which is not us) left in, this is a problem
+    # uh-oh a multiplier (which is not us) left in, this is a problem for limits
+    # we will need to add a group_by to collapse the resultset for proper counts
     if (
-      $inner_aliastypes->{multiplying}
+      grep { $_ ne $root_alias } keys %{ $inner_aliastypes->{multiplying} || {} }
         and
       # if there are user-supplied groups - assume user knows wtf they are up to
       ( ! $inner_aliastypes->{grouping} or $inner_attrs->{_grouped_by_distinct} )
-        and
-      my @multipliers = grep { $_ ne $root_alias } keys %{$inner_aliastypes->{multiplying}}
     ) {
 
-      # if none of the multipliers came from an order_by (guaranteed to have been combined
-      # with a limit) - easy - just slap a group_by to simulate a collapse and be on our way
-      if (
-        ! $inner_aliastypes->{ordering}
-          or
-        ! first { $inner_aliastypes->{ordering}{$_} } @multipliers
-      ) {
+      my $cur_sel = { map { $_ => 1 } @{$inner_attrs->{select}} };
 
-        my $unprocessed_order_chunks;
-        ($inner_attrs->{group_by}, $unprocessed_order_chunks) = $self->_group_over_selection (
-          $inner_attrs,
+      # *possibly* supplement the main selection with pks if not already
+      # there, as they will have to be a part of the group_by to collapse
+      # things properly
+      my $inner_select_with_extras;
+      my @pks = map { "$root_alias.$_" } $root_node->{-rsrc}->primary_columns
+        or $self->throw_exception( sprintf
+          'Unable to perform complex limited prefetch off %s without declared primary key',
+          $root_node->{-rsrc}->source_name,
         );
-
-        $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;
+      for my $col (@pks) {
+        push @{ $inner_select_with_extras ||= [ @{$inner_attrs->{select}} ] }, $col
+          unless $cur_sel->{$col}++;
       }
-      else {
-        # We need to order by external columns and group at the same time
-        # so we can calculate the proper limit
-        # This doesn't really make sense in SQL, however from DBICs point
-        # of view is rather valid (order the leftmost objects by whatever
-        # criteria and get the offset/rows many). There is a way around
-        # this however in SQL - we simply tae the direction of each piece
-        # of the foreign order and convert them to MIN(X) for ASC or MAX(X)
-        # for DESC, and group_by the root columns. The end result should be
-        # exactly what we expect
-
-        # supplement the main selection with pks if not already there,
-        # as they will have to be a part of the group_by to collapse
-        # things properly
-        my $cur_sel = { map { $_ => 1 } @{$inner_attrs->{select}} };
-
-        my @pks = map { "$root_alias.$_" } $root_node->{-rsrc}->primary_columns
-          or $self->throw_exception( sprintf
-            'Unable to perform complex limited prefetch off %s without declared primary key',
-            $root_node->{-rsrc}->source_name,
-          );
-        for my $col (@pks) {
-          push @{$inner_attrs->{select}}, $col
-            unless $cur_sel->{$col}++;
-        }
-
-        # wrap any part of the order_by that "responds" to an ordering alias
-        # into a MIN/MAX
-        # FIXME - this code is a joke, will need to be completely rewritten in
-        # the DQ branch. But I need to push a POC here, otherwise the
-        # pesky tests won't pass
-        my $sql_maker = $self->sql_maker;
-        my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
-        my $own_re = qr/ $lquote \Q$root_alias\E $rquote $sep | \b \Q$root_alias\E $sep /x;
-        my @order_chunks = map { ref $_ eq 'ARRAY' ? $_ : [ $_ ] } $sql_maker->_order_by_chunks($attrs->{order_by});
-        my @new_order = map { \$_ } @order_chunks;
-        my $inner_columns_info = $self->_resolve_column_info($inner_attrs->{from});
-
-        # loop through and replace stuff that is not "ours" with a min/max func
-        # everything is a literal at this point, since we are likely properly
-        # quoted and stuff
-        for my $i (0 .. $#new_order) {
-          my $chunk = $order_chunks[$i][0];
-
-          # skip ourselves
-          next if $chunk =~ $own_re;
-
-          ($chunk, my $is_desc) = $sql_maker->_split_order_chunk($chunk);
-
-          # maybe our own unqualified column
-          my $ord_bit = (
-            $lquote and $sep and $chunk =~ /^ $lquote ([^$sep]+) $rquote $/x
-          ) ? $1 : $chunk;
-
-          next if (
-            $ord_bit
-              and
-            $inner_columns_info->{$ord_bit}
-              and
-            $inner_columns_info->{$ord_bit}{-source_alias} eq $root_alias
-          );
-
-          $new_order[$i] = \[
-            sprintf(
-              '%s(%s)%s',
-              ($is_desc ? 'MAX' : 'MIN'),
-              $chunk,
-              ($is_desc ? ' DESC' : ''),
-            ),
-            @ {$order_chunks[$i]} [ 1 .. $#{$order_chunks[$i]} ]
-          ];
-        }
 
-        $inner_attrs->{order_by} = \@new_order;
-
-        # do not care about leftovers here - it will be all the functions
-        # we just created
-        ($inner_attrs->{group_by}) = $self->_group_over_selection (
-          $inner_attrs,
-        );
-      }
+      ($inner_attrs->{group_by}, $inner_attrs->{order_by}) = $self->_group_over_selection({
+        %$inner_attrs,
+        $inner_select_with_extras ? ( select => $inner_select_with_extras ) : (),
+        _aliastypes => $inner_aliastypes,
+      });
     }
 
     # we already optimized $inner_attrs->{from} above
@@ -370,9 +302,7 @@ sub _adjust_select_args_for_complex_prefetch {
   } } qw/selecting restricting grouping ordering/;
 
   # see what's left - throw away if not selecting/restricting
-  # also throw in a group_by if a non-selecting multiplier,
-  # to guard against cross-join explosions
-  my $need_outer_group_by;
+  my $may_need_outer_group_by;
   while (my $j = shift @orig_from) {
     my $alias = $j->[0]{-alias};
 
@@ -383,23 +313,19 @@ sub _adjust_select_args_for_complex_prefetch {
     }
     elsif (first { $_->{$alias} } @outer_nonselecting_chains ) {
       push @outer_from, $j;
-      $need_outer_group_by ||= $outer_aliastypes->{multiplying}{$alias} ? 1 : 0;
+      $may_need_outer_group_by ||= $outer_aliastypes->{multiplying}{$alias} ? 1 : 0;
     }
   }
 
-  if ( $need_outer_group_by and $attrs->{_grouped_by_distinct} ) {
-    my $unprocessed_order_chunks;
-    ($outer_attrs->{group_by}, $unprocessed_order_chunks) = $self->_group_over_selection ({
+  # also throw in a synthetic group_by if a non-selecting multiplier,
+  # to guard against cross-join explosions
+  # the logic is somewhat fragile, but relies on the idea that if a user supplied
+  # a group by on their own - they know what they were doing
+  if ( $may_need_outer_group_by and $attrs->{_grouped_by_distinct} ) {
+    ($outer_attrs->{group_by}, $outer_attrs->{order_by}) = $self->_group_over_selection ({
       %$outer_attrs,
       from => \@outer_from,
     });
-
-    $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
@@ -409,7 +335,6 @@ sub _adjust_select_args_for_complex_prefetch {
   # the outer select to exclude joins you didn't want in the first place
   #
   # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
-
   return $outer_attrs;
 }
 
@@ -434,6 +359,7 @@ sub _resolve_aliastypes_from_select_args {
   my $aliases_by_type;
 
   # see what aliases are there to work with
+  # and record who is a multiplier and who is premultiplied
   my $alias_list;
   for my $node (@{$attrs->{from}}) {
 
@@ -443,13 +369,17 @@ sub _resolve_aliastypes_from_select_args {
       or next;
 
     $alias_list->{$al} = $j;
-    $aliases_by_type->{multiplying}{$al} ||= { -parents => $j->{-join_path}||[] } if (
+
+    $aliases_by_type->{multiplying}{$al} ||= { -parents => $j->{-join_path}||[] }
       # not array == {from} head == can't be multiplying
-      ( ref($node) eq 'ARRAY' and ! $j->{-is_single} )
-        or
-      # a parent of ours is already a multiplier
-      ( grep { $aliases_by_type->{multiplying}{$_} } @{ $j->{-join_path}||[] } )
-    );
+      if ref($node) eq 'ARRAY' and ! $j->{-is_single};
+
+    $aliases_by_type->{premultiplied}{$al} ||= { -parents => $j->{-join_path}||[] }
+      # parts of the path that are not us but are multiplying
+      if grep { $aliases_by_type->{multiplying}{$_} }
+          grep { $_ ne $al }
+           map { values %$_ }
+            @{ $j->{-join_path}||[] }
   }
 
   # get a column to source/alias map (including unambiguous unqualified ones)
@@ -575,7 +505,8 @@ sub _resolve_aliastypes_from_select_args {
   return $aliases_by_type;
 }
 
-# This is the engine behind { distinct => 1 }
+# This is the engine behind { distinct => 1 } and the general
+# complex prefetch grouper
 sub _group_over_selection {
   my ($self, $attrs) = @_;
 
@@ -597,36 +528,116 @@ sub _group_over_selection {
     }
   }
 
-  # add any order_by parts *from the main source* 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($attrs->{order_by})) {
+  my @order_by = $self->_extract_order_criteria($attrs->{order_by})
+    or return (\@group_by, $attrs->{order_by});
+
+  # add any order_by parts that are not already present in the group_by
+  # to maintain SQL cross-compatibility and general sanity
+  #
+  # also in case the original selection is *not* unique, or in case part
+  # of the ORDER BY refers to a multiplier - we will need to replace the
+  # skipped order_by elements with their MIN/MAX equivalents as to maintain
+  # the proper overall order without polluting the group criteria (and
+  # possibly changing the outcome entirely)
+
+  my ($leftovers, $sql_maker, @new_order_by, $order_chunks, $aliastypes);
+
+  my $group_already_unique = $self->_columns_comprise_identifying_set($colinfos, \@group_by);
+
+  for my $o_idx (0 .. $#order_by) {
+
+    # if the chunk is already a min/max function - there is nothing left to touch
+    next if $order_by[$o_idx][0] =~ /^ (?: min | max ) \s* \( .+ \) $/ix;
+
     # only consider real columns (for functions the user got to do an explicit group_by)
-    if (@$_ != 1) {
-      push @leftovers, $_;
-      next;
+    my $chunk_ci;
+    if (
+      @{$order_by[$o_idx]} != 1
+        or
+      # only declare an unknown *plain* identifier as "leftover" if we are called with
+      # aliastypes to examine. If there are none - we are still in _resolve_attrs, and
+      # can just assume the user knows what they want
+      ( ! ( $chunk_ci = $colinfos->{$order_by[$o_idx][0]} ) and $attrs->{_aliastypes} )
+    ) {
+      push @$leftovers, $order_by[$o_idx][0];
     }
-    my $chunk = $_->[0];
 
-    if (
-      !$colinfos->{$chunk}
+    next unless $chunk_ci;
+
+    # no duplication of group criteria
+    next if $group_index{$chunk_ci->{-fq_colname}};
+
+    $aliastypes ||= (
+      $attrs->{_aliastypes}
         or
-      $colinfos->{$chunk}{-source_alias} ne $attrs->{alias}
+      $self->_resolve_aliastypes_from_select_args({
+        from => $attrs->{from},
+        order_by => $attrs->{order_by},
+      })
+    ) if $group_already_unique;
+
+    # check that we are not ordering by a multiplier (if a check is requested at all)
+    if (
+      $group_already_unique
+        and
+      ! $aliastypes->{multiplying}{$chunk_ci->{-source_alias}}
+        and
+      ! $aliastypes->{premultiplied}{$chunk_ci->{-source_alias}}
     ) {
-      push @leftovers, $_;
-      next;
+      push @group_by, $chunk_ci->{-fq_colname};
+      $group_index{$chunk_ci->{-fq_colname}}++
     }
+    else {
+      # We need to order by external columns without adding them to the group
+      # (eiehter a non-unique selection, or a multi-external)
+      #
+      # This doesn't really make sense in SQL, however from DBICs point
+      # of view is rather valid (e.g. order the leftmost objects by whatever
+      # criteria and get the offset/rows many). There is a way around
+      # this however in SQL - we simply tae the direction of each piece
+      # of the external order and convert them to MIN(X) for ASC or MAX(X)
+      # for DESC, and group_by the root columns. The end result should be
+      # exactly what we expect
+
+      # FIXME - this code is a joke, will need to be completely rewritten in
+      # the DQ branch. But I need to push a POC here, otherwise the
+      # pesky tests won't pass
+      # wrap any part of the order_by that "responds" to an ordering alias
+      # into a MIN/MAX
+      $sql_maker ||= $self->sql_maker;
+      $order_chunks ||= [
+        map { ref $_ eq 'ARRAY' ? $_ : [ $_ ] } $sql_maker->_order_by_chunks($attrs->{order_by})
+      ];
 
-    $chunk = $colinfos->{$chunk}{-fq_colname};
-    push @group_by, $chunk unless $group_index{$chunk}++;
+      my ($chunk, $is_desc) = $sql_maker->_split_order_chunk($order_chunks->[$o_idx][0]);
+
+      $new_order_by[$o_idx] = \[
+        sprintf( '%s( %s )%s',
+          ($is_desc ? 'MAX' : 'MIN'),
+          $chunk,
+          ($is_desc ? ' DESC' : ''),
+        ),
+        @ {$order_chunks->[$o_idx]} [ 1 .. $#{$order_chunks->[$o_idx]} ]
+      ];
+    }
   }
 
-  return wantarray
-    ? (\@group_by, (@leftovers ? \@leftovers : undef) )
-    : \@group_by
-  ;
+  $self->throw_exception ( sprintf
+    'A required group_by clause could not be constructed automatically due to a complex '
+  . 'order_by criteria (%s). Either order_by columns only (no functions) or construct a suitable '
+  . 'group_by by hand',
+    join ', ', map { "'$_'" } @$leftovers,
+  ) if $leftovers;
+
+  # recreate the untouched order parts
+  if (@new_order_by) {
+    $new_order_by[$_] ||= \ $order_chunks->[$_] for ( 0 .. $#$order_chunks );
+  }
+
+  return (
+    \@group_by,
+    (@new_order_by ? \@new_order_by : $attrs->{order_by} ),  # same ref as original == unchanged
+  );
 }
 
 sub _resolve_ident_sources {
@@ -838,15 +849,25 @@ sub _extract_order_criteria {
 sub _order_by_is_stable {
   my ($self, $ident, $order_by, $where) = @_;
 
-  my $colinfo = $self->_resolve_column_info($ident, [
+  my @cols = (
     (map { $_->[0] } $self->_extract_order_criteria($order_by)),
     $where ? @{$self->_extract_fixed_condition_columns($where)} :(),
-  ]);
+  ) or return undef;
+
+  my $colinfo = $self->_resolve_column_info($ident, \@cols);
+
+  return keys %$colinfo
+    ? $self->_columns_comprise_identifying_set( $colinfo,  \@cols )
+    : undef
+  ;
+}
 
-  return undef unless keys %$colinfo;
+sub _columns_comprise_identifying_set {
+  my ($self, $colinfo, $columns) = @_;
 
   my $cols_per_src;
-  $cols_per_src->{$_->{-source_alias}}{$_->{-colname}} = $_ for values %$colinfo;
+  $cols_per_src -> {$_->{-source_alias}} -> {$_->{-colname}} = $_
+    for grep { defined $_ } @{$colinfo}{@$columns};
 
   for (values %$cols_per_src) {
     my $src = (values %$_)[0]->{-result_source};