From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 21 Mar 2013 11:37:43 +0000 (+0100)
Subject: Consider where condition when determining leftmost order stability
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0e81e6918e9fe18c6852818c33eae48b46de1572;p=dbsrgits%2FDBIx-Class-Historic.git

Consider where condition when determining leftmost order stability

Extract more eyebleed into DBIHacks in the process
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index d6e54e3..4792391 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1312,34 +1312,15 @@ sub _construct_results {
   }
   elsif( $attrs->{collapse} ) {
 
-    $attrs->{_ordered_for_collapse} = (!$attrs->{order_by}) ? 0 : do {
-      my $st = $rsrc->schema->storage;
-      my @ord_cols = map
-        { $_->[0] }
-        ( $st->_extract_order_criteria($attrs->{order_by}) )
-      ;
-
-      my $colinfos = $st->_resolve_column_info($attrs->{from}, \@ord_cols);
-
-      for (0 .. $#ord_cols) {
-        if (
-          ! $colinfos->{$ord_cols[$_]}
-            or
-          $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc
-        ) {
-          splice @ord_cols, $_;
-          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 tsable manner
-      (@ord_cols and $rsrc->_identifying_column_set({ map
-        { $colinfos->{$_}{-colname} => $colinfos->{$_} }
-        @ord_cols
-      })) ? 1 : 0;
-    } unless defined $attrs->{_ordered_for_collapse};
+    $attrs->{_ordered_for_collapse} = (
+      (
+        $attrs->{order_by}
+          and
+        $rsrc->schema
+              ->storage
+               ->_main_source_order_by_portion_is_stable($rsrc, $attrs->{order_by}, $attrs->{where})
+      ) ? 1 : 0
+    ) unless defined $attrs->{_ordered_for_collapse};
 
     if (! $attrs->{_ordered_for_collapse}) {
       $did_fetch_all = 1;
diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index f136f52..10101f8 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -798,6 +798,58 @@ sub _order_by_is_stable {
   return undef;
 }
 
+# this is almost identical to the above, except it accepts only
+# a single rsrc, and will succeed only if the first portion of the order
+# by is stable.
+# returns that portion as a colinfo hashref on success
+sub _main_source_order_by_portion_is_stable {
+  my ($self, $main_rsrc, $order_by, $where) = @_;
+
+  die "Huh... I expect a blessed result_source..."
+    if ref($main_rsrc) eq 'ARRAY';
+
+  my @ord_cols = map
+    { $_->[0] }
+    ( $self->_extract_order_criteria($order_by) )
+  ;
+  return unless @ord_cols;
+
+  my $colinfos = $self->_resolve_column_info($main_rsrc, \@ord_cols);
+  for (0 .. $#ord_cols) {
+    if (
+      ! $colinfos->{$ord_cols[$_]}
+        or
+      $colinfos->{$ord_cols[$_]}{-result_source} != $main_rsrc
+    ) {
+      $#ord_cols =  $_ - 1;
+      last;
+    }
+  }
+
+  # we just truncated it above
+  return unless @ord_cols;
+
+  # 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
+  #
+  # single source - safely use both qualified and unqualified name
+  my $order_portion_ci = { map {
+    $colinfos->{$_}{-colname} => $colinfos->{$_},
+    $colinfos->{$_}{-fq_colname} => $colinfos->{$_},
+  } @ord_cols };
+
+  $where = $where ? $self->_resolve_column_info(
+    $main_rsrc, $self->_extract_fixed_condition_columns($where)
+  ) : {};
+
+  return (
+    $main_rsrc->_identifying_column_set({ %$where, %$order_portion_ci })
+      ? $order_portion_ci
+      : undef
+  );
+}
+
 # returns an arrayref of column names which *definitely* have som
 # sort of non-nullable equality requested in the given condition
 # specification. This is used to figure out if a resultset is
diff --git a/t/prefetch/lazy_cursor.t b/t/prefetch/lazy_cursor.t
index 220e3c6..090d464 100644
--- a/t/prefetch/lazy_cursor.t
+++ b/t/prefetch/lazy_cursor.t
@@ -75,4 +75,15 @@ ok ($unordered_rs->next, "got row $_")  for (2 .. $initial_artists_cnt + 3);
 is ($unordered_rs->next, undef, 'End of RS reached');
 is ($unordered_rs->next, undef, 'End of RS not lost');
 
+{
+  my $non_uniquely_ordered_constrained = $schema->resultset('CD')->search(
+    { artist => 1 },
+    { order_by => 'me.title', prefetch => 'tracks' },
+  );
+
+  isa_ok ($non_uniquely_ordered_constrained->next, 'DBICTest::CD' );
+
+  ok( defined $non_uniquely_ordered_constrained->cursor->next, 'Cursor not exhausted' );
+}
+
 done_testing;