Initial full test pass - all fetches are eager for now

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index 276cefd..3efd488 100644 (file)
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -77,18 +77,8 @@ sub _adjust_select_args_for_complex_prefetch {
   my $outer_attrs = { %$attrs };
   delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
 
-  my $inner_attrs = { %$attrs };
-  delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range _collapse_order_by select as/;
-
-
-  # bring over all non-collapse-induced order_by into the inner query (if any)
-  # the outer one will have to keep them all
-  delete $inner_attrs->{order_by};
-  if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
-    $inner_attrs->{order_by} = [
-      @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
-    ];
-  }
+  my $inner_attrs = { %$attrs, _is_internal_subuery => 1 };
+  delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range select as/;
 
   # generate the inner/outer select lists
   # for inside we consider only stuff *not* brought in by the prefetch
@@ -680,4 +670,62 @@ sub _extract_order_criteria {
   }
 }
 
+sub _order_by_is_stable {
+  my ($self, $ident, $order_by, $where) = @_;
+
+  my $colinfo = $self->_resolve_column_info($ident, [
+    (map { $_->[0] } $self->_extract_order_criteria($order_by)),
+    $where ? @{$self->_extract_fixed_condition_columns($where)} :(),
+  ]);
+
+  return undef unless keys %$colinfo;
+
+  my $cols_per_src;
+  $cols_per_src->{$_->{-source_alias}}{$_->{-colname}} = $_ for values %$colinfo;
+
+  for (values %$cols_per_src) {
+    my $src = (values %$_)[0]->{-result_source};
+    return 1 if $src->_identifying_column_set($_);
+  }
+
+  return 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
+# constrained to a column which is part of a unique constraint,
+# which in turn allows us to better predict how ordering will behave
+# etc.
+#
+# this is a rudimentary, incomplete, and error-prone extractor
+# however this is OK - it is conservative, and if we can not find
+# something that is in fact there - the stack will recover gracefully
+# Also - DQ and the mst it rode in on will save us all RSN!!!
+sub _extract_fixed_condition_columns {
+  my ($self, $where, $nested) = @_;
+
+  return unless ref $where eq 'HASH';
+
+  my @cols;
+  for my $lhs (keys %$where) {
+    if ($lhs =~ /^\-and$/i) {
+      push @cols, ref $where->{$lhs} eq 'ARRAY'
+        ? ( map { $self->_extract_fixed_condition_columns($_, 1) } @{$where->{$lhs}} )
+        : $self->_extract_fixed_condition_columns($where->{$lhs}, 1)
+      ;
+    }
+    elsif ($lhs !~ /^\-/) {
+      my $val = $where->{$lhs};
+
+      push @cols, $lhs if (defined $val and (
+        ! ref $val
+          or
+        (ref $val eq 'HASH' and keys %$val == 1 and defined $val->{'='})
+      ));
+    }
+  }
+  return $nested ? @cols : \@cols;
+}
+
 1;