Radically rethink complex prefetch - make most useful cases just work (tm)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index fd9d593..a2e3a4c 100644 (file)
@@ -1277,9 +1277,17 @@ sub _construct_results {
   my $rsrc = $self->result_source;
   my $attrs = $self->_resolved_attrs;
 
-  if (!$fetch_all and ! $attrs->{order_by} and $attrs->{collapse}) {
+  if (
+    ! $fetch_all
+      and
+    ! $attrs->{order_by}
+      and
+    $attrs->{collapse}
+      and
+    my @pcols = $rsrc->primary_columns
+  ) {
     # default order for collapsing unless the user asked for something
-    $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} $rsrc->primary_columns ];
+    $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} @pcols ];
     $attrs->{_ordered_for_collapse} = 1;
     $attrs->{_order_is_artificial} = 1;
   }
@@ -1291,6 +1299,8 @@ sub _construct_results {
   # a surprising amount actually
   my $rows = delete $self->{_stashed_rows};
 
+  my $did_fetch_all = $fetch_all;
+
   if ($fetch_all) {
     # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
     $rows = [ ($rows ? @$rows : ()), $cursor->all ];
@@ -1327,7 +1337,7 @@ sub _construct_results {
     } unless defined $attrs->{_ordered_for_collapse};
 
     if (! $attrs->{_ordered_for_collapse}) {
-      $fetch_all = 1;
+      $did_fetch_all = 1;
 
       # instead of looping over ->next, use ->all in stealth mode
       # *without* calling a ->reset afterwards
@@ -1339,7 +1349,7 @@ sub _construct_results {
     }
   }
 
-  if (! $fetch_all and ! @{$rows||[]} ) {
+  if (! $did_fetch_all and ! @{$rows||[]} ) {
     # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
     if (scalar (my @r = $cursor->next) ) {
       $rows = [ \@r ];
@@ -1349,7 +1359,7 @@ sub _construct_results {
   return undef unless @{$rows||[]};
 
   my @extra_collapser_args;
-  if ($attrs->{collapse} and ! $fetch_all ) {
+  if ($attrs->{collapse} and ! $did_fetch_all ) {
 
     @extra_collapser_args = (
       # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
@@ -1440,10 +1450,15 @@ sub _construct_results {
     $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows;
   }
 
-  # CDBI compat stuff
-  if ($attrs->{record_filter}) {
-    $_ = $attrs->{record_filter}->($_) for @$rows;
-  }
+  # The @$rows check seems odd at first - why wouldn't we want to warn
+  # regardless? The issue is things like find() etc, where the user
+  # *knows* only one result will come back. In these cases the ->all
+  # is not a pessimization, but rather something we actually want
+  carp_unique(
+    'Unable to properly collapse has_many results in iterator mode due '
+  . 'to order criteria - performed an eager cursor slurp underneath. '
+  . 'Consider using ->all() instead'
+  ) if ( ! $fetch_all and @$rows > 1 );
 
   return $rows;
 }
@@ -1596,7 +1611,7 @@ sub _count_rs {
 
   my $tmp_attrs = { %$attrs };
   # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
-  delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
+  delete @{$tmp_attrs}{qw/rows offset order_by _related_results_construction record_filter for/};
 
   # overwrite the selector (supplied by the storage)
   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
@@ -1618,7 +1633,7 @@ sub _count_subq_rs {
 
   my $sub_attrs = { %$attrs };
   # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
-  delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/};
+  delete @{$sub_attrs}{qw/collapse columns as select _related_results_construction order_by for/};
 
   # if we multi-prefetch we group_by something unique, as this is what we would
   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
@@ -1821,7 +1836,7 @@ sub _rs_update_delete {
   my $attrs = { %{$self->_resolved_attrs} };
 
   my $join_classifications;
-  my $existing_group_by = delete $attrs->{group_by};
+  my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)};
 
   # do we need a subquery for any reason?
   my $needs_subq = (
@@ -1882,7 +1897,7 @@ sub _rs_update_delete {
     );
 
     # make a new $rs selecting only the PKs (that's all we really need for the subq)
-    delete $attrs->{$_} for qw/collapse select _prefetch_selector_range as/;
+    delete $attrs->{$_} for qw/select as collapse _related_results_construction/;
     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
     $attrs->{group_by} = \ '';  # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
     my $subrs = (ref $self)->new($rsrc, $attrs);
@@ -3267,7 +3282,7 @@ sub _chain_relationship {
   # ->_resolve_join as otherwise they get lost - captainL
   my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
 
-  delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
+  delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/};
 
   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
 
@@ -3477,6 +3492,7 @@ sub _resolved_attrs {
       carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
     }
     else {
+      $attrs->{_grouped_by_distinct} = 1;
       # distinct affects only the main selection part, not what prefetch may
       # add below.
       $attrs->{group_by} = $source->storage->_group_over_selection (
@@ -3522,17 +3538,11 @@ sub _resolved_attrs {
 
     my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
 
-    # we need to somehow mark which columns came from prefetch
-    if (@prefetch) {
-      my $sel_end = $#{$attrs->{select}};
-      $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ];
-    }
-
     push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
   }
 
-  if ( defined List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
+  if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
     $attrs->{_related_results_construction} = 1;
   }
   else {