From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 8 Jul 2014 04:09:40 +0000 (+0200)
Subject: Teach order_by stability analyzer about search_related
X-Git-Tag: v0.082800~149
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=302d35f8b3225b4da3755dd3e3f45efede130533;p=dbsrgits%2FDBIx-Class.git

Teach order_by stability analyzer about search_related

There is more stuff we can do here as noted in the FIXME added to the very
end of _extract_colinfo_of_stable_main_source_order_by_portion. But for the
time being this will do (also see the subsequent tests for extra insanity we
could and should add)

Tests come in the next commit
---

diff --git a/Changes b/Changes
index 5284c01..3adf7c7 100644
--- a/Changes
+++ b/Changes
@@ -19,6 +19,8 @@ Revision history for DBIx::Class
         - Fix on_connect_* not always firing in some cases - a race condition
           existed between storage accessor setters and the determine_driver
           routines, triggering a connection before the set-cycle is finished
+        - Fix failure to detect stable order criteria when in iterator
+          mode of a has_many prefetch off a search_related chain
         - Prevent erroneous database hit when accessing prefetched related
           resultsets with no rows
         - Fix incorrect handling of custom relationship conditions returning
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 8208d16..6f39723 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1327,7 +1327,7 @@ sub _construct_results {
           and
         $rsrc->schema
               ->storage
-               ->_extract_colinfo_of_stable_main_source_order_by_portion($rsrc, $attrs->{order_by}, $attrs->{where})
+               ->_extract_colinfo_of_stable_main_source_order_by_portion($attrs)
       ) ? 1 : 0
     ) unless defined $attrs->{_ordered_for_collapse};
 
diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
index 1861221..b972809 100644
--- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm
+++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
@@ -538,23 +538,31 @@ sub _GenericSubQ {
   # GenSubQ is slow enough as it is, just emulating things
   # like in other cases is not wise - make the user work
   # to shoot their DBA in the foot
-  my $supplied_order = delete $rs_attrs->{order_by} or $self->throw_exception (
+  $self->throw_exception (
     'Generic Subquery Limit does not work on resultsets without an order. Provide a stable, '
   . 'main-table-based order criteria.'
-  );
+  ) unless $rs_attrs->{order_by};
 
   my $usable_order_colinfo = $main_rsrc->storage->_extract_colinfo_of_stable_main_source_order_by_portion(
-    $main_rsrc,
-    $supplied_order,
-    $rs_attrs->{where},
-  ) or $self->throw_exception(
-    'Generic Subquery Limit can not work with order criteria based on sources other than the current one'
+    $rs_attrs
+  );
+
+  $self->throw_exception(
+    'Generic Subquery Limit can not work with order criteria based on sources other than the main one'
+  ) if (
+    ! keys %{$usable_order_colinfo||{}}
+      or
+    grep
+      { $_->{-source_alias} ne $rs_attrs->{alias} }
+      (values %$usable_order_colinfo)
   );
 
 ###
 ###
 ### we need to know the directions after we figured out the above - reextract *again*
 ### this is eyebleed - trying to get it to work at first
+  my $supplied_order = delete $rs_attrs->{order_by};
+
   my @order_bits = do {
     local $self->{quote_char};
     local $self->{order_bind};
diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index 1bb9224..d78ab74 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -784,31 +784,9 @@ sub _resolve_column_info {
 sub _inner_join_to_node {
   my ($self, $from, $alias) = @_;
 
-  # subqueries and other oddness are naturally not supported
-  return $from if (
-    ref $from ne 'ARRAY'
-      ||
-    @$from <= 1
-      ||
-    ref $from->[0] ne 'HASH'
-      ||
-    ! $from->[0]{-alias}
-      ||
-    $from->[0]{-alias} eq $alias  # this last bit means $alias is the head of $from - nothing to do
-  );
-
-  # find the current $alias in the $from structure
-  my $switch_branch;
-  JOINSCAN:
-  for my $j (@{$from}[1 .. $#$from]) {
-    if ($j->[0]{-alias} eq $alias) {
-      $switch_branch = $j->[0]{-join_path};
-      last JOINSCAN;
-    }
-  }
+  my $switch_branch = $self->_find_join_path_to_node($from, $alias);
 
-  # something else went quite wrong
-  return $from unless $switch_branch;
+  return $from unless @{$switch_branch||[]};
 
   # So it looks like we will have to switch some stuff around.
   # local() is useless here as we will be leaving the scope
@@ -836,6 +814,29 @@ sub _inner_join_to_node {
   return \@new_from;
 }
 
+sub _find_join_path_to_node {
+  my ($self, $from, $target_alias) = @_;
+
+  # subqueries and other oddness are naturally not supported
+  return undef if (
+    ref $from ne 'ARRAY'
+      ||
+    ref $from->[0] ne 'HASH'
+      ||
+    ! defined $from->[0]{-alias}
+  );
+
+  # no path - the head is the alias
+  return [] if $from->[0]{-alias} eq $target_alias;
+
+  for my $i (1 .. $#$from) {
+    return $from->[$i][0]{-join_path} if ( ($from->[$i][0]{-alias}||'') eq $target_alias );
+  }
+
+  # something else went quite wrong
+  return undef;
+}
+
 sub _extract_order_criteria {
   my ($self, $order_by, $sql_maker) = @_;
 
@@ -917,70 +918,62 @@ sub _columns_comprise_identifying_set {
 # by is stable.
 # returns that portion as a colinfo hashref on success
 sub _extract_colinfo_of_stable_main_source_order_by_portion {
-  my ($self, $main_rsrc, $order_by, $where) = @_;
+  my ($self, $attrs) = @_;
 
-  die "Huh... I expect a blessed result_source..."
-    if ref($main_rsrc) eq 'ARRAY';
+  my $nodes = $self->_find_join_path_to_node($attrs->{from}, $attrs->{alias});
+
+  return unless defined $nodes;
 
   my @ord_cols = map
     { $_->[0] }
-    ( $self->_extract_order_criteria($order_by) )
+    ( $self->_extract_order_criteria($attrs->{order_by}) )
   ;
   return unless @ord_cols;
 
-  my $colinfos = $self->_resolve_column_info($main_rsrc);
+  my $valid_aliases = { map { $_ => 1 } (
+    $attrs->{from}[0]{-alias},
+    map { values %$_ } @$nodes,
+  ) };
 
-  for (0 .. $#ord_cols) {
-    if (
-      ! $colinfos->{$ord_cols[$_]}
-        or
-      $colinfos->{$ord_cols[$_]}{-result_source} != $main_rsrc
-    ) {
-      $#ord_cols =  $_ - 1;
-      last;
-    }
-  }
+  my $colinfos = $self->_resolve_column_info($attrs->{from});
 
-  # we just truncated it above
-  return unless @ord_cols;
+  my ($colinfos_to_return, $seen_main_src_cols);
 
-  my $order_portion_ci = { map {
-    $colinfos->{$_}{-colname} => $colinfos->{$_},
-    $colinfos->{$_}{-fq_colname} => $colinfos->{$_},
-  } @ord_cols };
+  for my $col (@ord_cols) {
+    # if order criteria is unresolvable - there is nothing we can do
+    my $colinfo = $colinfos->{$col} or last;
 
-  # since all we check here are the start of the order_by belonging to the
-  # top level $rsrc, a present identifying set will mean that the resultset
-  # is ordered by its leftmost table in a stable manner
-  #
-  # RV of _identifying_column_set contains unqualified names only
-  my $unqualified_idset = $main_rsrc->_identifying_column_set({
-    ( $where ? %{
-      $self->_resolve_column_info(
-        $main_rsrc, $self->_extract_fixed_condition_columns($where)||[]
-      )
-    } : () ),
-    %$order_portion_ci
-  }) or return;
-
-  my $ret_info;
-  my %unqualified_idcols_from_order = map {
-    $order_portion_ci->{$_} ? ( $_ => $order_portion_ci->{$_} ) : ()
-  } @$unqualified_idset;
-
-  # extra optimization - cut the order_by at the end of the identifying set
-  # (just in case the user was stupid and overlooked the obvious)
-  for my $i (0 .. $#ord_cols) {
-    my $col = $ord_cols[$i];
-    my $unqualified_colname = $order_portion_ci->{$col}{-colname};
-    $ret_info->{$col} = { %{$order_portion_ci->{$col}}, -idx_in_order_subset => $i };
-    delete $unqualified_idcols_from_order{$ret_info->{$col}{-colname}};
-
-    # we didn't reach the end of the identifying portion yet
-    return $ret_info unless keys %unqualified_idcols_from_order;
+    # if we reached the end of the allowed aliases - also nothing we can do
+    last unless $valid_aliases->{$colinfo->{-source_alias}};
+
+    $colinfos_to_return->{$col} = $colinfo;
+
+    $seen_main_src_cols->{$colinfo->{-colname}} = 1
+      if $colinfo->{-source_alias} eq $attrs->{alias};
   }
 
-  die 'How did we get here...';
+  # FIXME the condition may be singling out things on its own, so we
+  # conceivable could come back wi "stable-ordered by nothing"
+  # not confient enough in the parser yet, so punt for the time being
+  return unless $seen_main_src_cols;
+
+  my $main_src_fixed_cols_from_cond = [ $attrs->{where}
+    ? (
+      map
+      {
+        ( $colinfos->{$_} and $colinfos->{$_}{-source_alias} eq $attrs->{alias} )
+          ? $colinfos->{$_}{-colname}
+          : ()
+      }
+      @{$self->_extract_fixed_condition_columns($attrs->{where}) || []}
+    )
+    : ()
+  ];
+
+  return $attrs->{result_source}->_identifying_column_set([
+    keys %$seen_main_src_cols,
+    @$main_src_fixed_cols_from_cond,
+  ]) ? $colinfos_to_return : ();
 }
 
 # Attempts to flatten a passed in SQLA condition as much as possible towards