Rename (with a silent compat shim) couple of badly named customcond args
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index c6935c3..92665d6 100644 (file)
@@ -6,6 +6,9 @@ use base qw/DBIx::Class/;
 use DBIx::Class::Carp;
 use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken reftype/;
+use DBIx::Class::_Util qw(
+  fail_on_internal_wantarray is_plain_value is_literal_value
+);
 use Try::Tiny;
 use Data::Compare (); # no imports!!! guard against insane architecture
 
@@ -141,8 +144,8 @@ another.
 
 =head3 Resolving conditions and attributes
 
-When a resultset is chained from another resultset (ie:
-C<my $new_rs = $old_rs->search(\%extra_cond, \%attrs)>), conditions
+When a resultset is chained from another resultset (e.g.:
+C<< my $new_rs = $old_rs->search(\%extra_cond, \%attrs) >>), conditions
 and attributes with the same keys need resolving.
 
 If any of L</columns>, L</select>, L</as> are present, they reset the
@@ -246,7 +249,7 @@ sub new {
     if $source->isa('DBIx::Class::ResultSourceHandle');
 
   $attrs = { %{$attrs||{}} };
-  delete @{$attrs}{qw(_sqlmaker_select_args _related_results_construction)};
+  delete @{$attrs}{qw(_last_sqlmaker_alias_map _related_results_construction)};
 
   if ($attrs->{page}) {
     $attrs->{rows} ||= 10;
@@ -304,7 +307,7 @@ call it as C<search(undef, \%attrs)>.
 
 For a list of attributes that can be passed to C<search>, see
 L</ATTRIBUTES>. For more examples of using this function, see
-L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
+L<Searching|DBIx::Class::Manual::Cookbook/SEARCHING>. For a complete
 documentation for the first argument, see L<SQL::Abstract/"WHERE CLAUSES">
 and its extension L<DBIx::Class::SQLMaker>.
 
@@ -327,6 +330,7 @@ sub search {
   my $rs = $self->search_rs( @_ );
 
   if (wantarray) {
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray($rs);
     return $rs->all;
   }
   elsif (defined wantarray) {
@@ -583,60 +587,32 @@ sub _normalize_selection {
 sub _stack_cond {
   my ($self, $left, $right) = @_;
 
-  # collapse single element top-level conditions
-  # (single pass only, unlikely to need recursion)
-  for ($left, $right) {
-    if (ref $_ eq 'ARRAY') {
-      if (@$_ == 0) {
-        $_ = undef;
-      }
-      elsif (@$_ == 1) {
-        $_ = $_->[0];
-      }
-    }
-    elsif (ref $_ eq 'HASH') {
-      my ($first, $more) = keys %$_;
+  (
+    (ref $_ eq 'ARRAY' and !@$_)
+      or
+    (ref $_ eq 'HASH' and ! keys %$_)
+  ) and $_ = undef for ($left, $right);
 
-      # empty hash
-      if (! defined $first) {
-        $_ = undef;
-      }
-      # one element hash
-      elsif (! defined $more) {
-        if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
-          $_ = $_->{'-and'};
-        }
-        elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
-          $_ = $_->{'-or'};
-        }
-      }
-    }
+  # either on of the two undef or both undef
+  if ( ( (defined $left) xor (defined $right) ) or ! defined $left ) {
+    return defined $left ? $left : $right;
   }
 
-  # merge hashes with weeding out of duplicates (simple cases only)
-  if (ref $left eq 'HASH' and ref $right eq 'HASH') {
+  my $cond = $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
 
-    # shallow copy to destroy
-    $right = { %$right };
-    for (grep { exists $right->{$_} } keys %$left) {
-      # the use of eq_deeply here is justified - the rhs of an
-      # expression can contain a lot of twisted weird stuff
-      delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
-    }
+  for my $c (grep { ref $cond->{$_} eq 'ARRAY' and ($cond->{$_}[0]||'') eq '-and' } keys %$cond) {
 
-    $right = undef unless keys %$right;
-  }
+    my @vals = sort @{$cond->{$c}}[ 1..$#{$cond->{$c}} ];
+    my @fin = shift @vals;
 
+    for my $v (@vals) {
+      push @fin, $v unless Data::Compare::Compare( $fin[-1], $v );
+    }
 
-  if (defined $left xor defined $right) {
-    return defined $left ? $left : $right;
-  }
-  elsif (! defined $left) {
-    return undef;
-  }
-  else {
-    return { -and => [ $left, $right ] };
+    $cond->{$c} = (@fin == 1) ? $fin[0] : [-and => @fin ];
   }
+
+  $cond;
 }
 
 =head2 search_literal
@@ -646,7 +622,7 @@ should only be used in that context. C<search_literal> is a convenience
 method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you
 want to ensure columns are bound correctly, use L</search>.
 
-See L<DBIx::Class::Manual::Cookbook/Searching> and
+See L<DBIx::Class::Manual::Cookbook/SEARCHING> and
 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
 require C<search_literal>.
 
@@ -797,11 +773,15 @@ sub find {
 
       next if $keyref eq 'ARRAY'; # has_many for multi_create
 
-      my $rel_q = $rsrc->_resolve_condition(
+      my ($rel_cond, $crosstable) = $rsrc->_resolve_condition(
         $relinfo->{cond}, $val, $key, $key
       );
-      die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
-      @related{keys %$rel_q} = values %$rel_q;
+
+      $self->throw_exception("Complex condition via relationship '$key' is unsupported in find()")
+         if $crosstable or ref($rel_cond) ne 'HASH';
+
+      # supplement
+      @related{keys %$rel_cond} = values %$rel_cond;
     }
   }
 
@@ -1088,39 +1068,6 @@ sub single {
   $self->_construct_results->[0];
 }
 
-
-# _collapse_query
-#
-# Recursively collapse the query, accumulating values for each column.
-
-sub _collapse_query {
-  my ($self, $query, $collapsed) = @_;
-
-  $collapsed ||= {};
-
-  if (ref $query eq 'ARRAY') {
-    foreach my $subquery (@$query) {
-      next unless ref $subquery;  # -or
-      $collapsed = $self->_collapse_query($subquery, $collapsed);
-    }
-  }
-  elsif (ref $query eq 'HASH') {
-    if (keys %$query and (keys %$query)[0] eq '-and') {
-      foreach my $subquery (@{$query->{-and}}) {
-        $collapsed = $self->_collapse_query($subquery, $collapsed);
-      }
-    }
-    else {
-      foreach my $col (keys %$query) {
-        my $value = $query->{$col};
-        $collapsed->{$col}{$value}++;
-      }
-    }
-  }
-
-  return $collapsed;
-}
-
 =head2 get_column
 
 =over 4
@@ -1211,8 +1158,6 @@ sub slice {
   $attrs->{offset} += $min;
   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
   return $self->search(undef, $attrs);
-  #my $slice = (ref $self)->new($self->result_source, $attrs);
-  #return (wantarray ? $slice->all : $slice);
 }
 
 =head2 next
@@ -1351,14 +1296,14 @@ sub _construct_results {
   return undef unless @{$rows||[]};
 
   # sanity check - people are too clever for their own good
-  if ($attrs->{collapse} and my $aliastypes = $attrs->{_sqlmaker_select_args}[3]{_aliastypes} ) {
+  if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) {
 
     my $multiplied_selectors;
     for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) {
       if (
         $aliastypes->{multiplying}{$sel_alias}
           or
-        scalar grep { $aliastypes->{multiplying}{(values %$_)[0]} } @{ $aliastypes->{selecting}{$sel_alias}{-parents} }
+        $aliastypes->{premultiplied}{$sel_alias}
       ) {
         $multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}}
       }
@@ -1440,7 +1385,7 @@ sub _construct_results {
       :                                           'classic_nonpruning'
     ;
 
-    # $args and $attrs to _mk_row_parser are seperated to delineate what is
+    # $args and $attrs to _mk_row_parser are separated to delineate what is
     # core collapser stuff and what is dbic $rs specific
     @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $rsrc->_mk_row_parser({
       eval => 1,
@@ -1456,7 +1401,7 @@ sub _construct_results {
     # can't work without it). Add an explicit check for the *main*
     # result, hopefully this will gradually weed out such errors
     #
-    # FIXME - this is a temporary kludge that reduces perfromance
+    # FIXME - this is a temporary kludge that reduces performance
     # It is however necessary for the time being
     my ($unrolled_non_null_cols_to_check, $err);
 
@@ -1908,7 +1853,7 @@ sub _rs_update_delete {
   if (!$needs_subq and @{$attrs->{from}} > 1) {
 
     ($attrs->{from}, $join_classifications) =
-      $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $self->{cond}, $attrs);
+      $storage->_prune_unused_joins ($attrs);
 
     # any non-pruneable non-local restricting joins imply subq
     $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
@@ -1970,6 +1915,8 @@ sub _rs_update_delete {
       if (
         $existing_group_by
           or
+        # we do not need to check pre-multipliers, since if the premulti is there, its
+        # parent (who is multi) will be there too
         keys %{ $join_classifications->{multiplying} || {} }
       ) {
         # make sure if there is a supplied group_by it matches the columns compiled above
@@ -2001,7 +1948,6 @@ sub _rs_update_delete {
 
       $guard = $storage->txn_scope_guard;
 
-      $cond = [];
       for my $row ($subrs->cursor->all) {
         push @$cond, { map
           { $idcols->[$_] => $row->[$_] }
@@ -2011,11 +1957,11 @@ sub _rs_update_delete {
     }
   }
 
-  my $res = $storage->$op (
+  my $res = $cond ? $storage->$op (
     $rsrc,
     $op eq 'update' ? $values : (),
     $cond,
-  );
+  ) : '0E0';
 
   $guard->commit if $guard;
 
@@ -2189,7 +2135,7 @@ first element should be a list of column names and each subsequent
 element should be a data value in the earlier specified column order.
 For example:
 
-  $Arstist_rs->populate([
+  $schema->resultset("Artist")->populate([
     [ qw( artistid name ) ],
     [ 100, 'A Formally Unknown Singer' ],
     [ 101, 'A singer that jumped the shark two albums ago' ],
@@ -2268,7 +2214,7 @@ sub populate {
       foreach my $rel (@rels) {
         next unless ref $data->[$index]->{$rel} eq "HASH";
         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
-        my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
+        my (undef, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
         my $related = $result->result_source->_resolve_condition(
           $reverse_relinfo->{cond},
           $self,
@@ -2323,7 +2269,7 @@ sub populate {
 }
 
 
-# populate() argumnets went over several incarnations
+# populate() arguments went over several incarnations
 # What we ultimately support is AoH
 sub _normalize_populate_args {
   my ($self, $arg) = @_;
@@ -2497,28 +2443,28 @@ sub _merge_with_rscond {
     );
   }
   else {
-    # precendence must be given to passed values over values inherited from
-    # the cond, so the order here is important.
-    my $collapsed_cond = $self->_collapse_cond($self->{cond});
-    my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
+    if ($self->{cond}) {
+      my $implied = $self->_remove_alias(
+        $self->result_source->schema->storage->_collapse_cond($self->{cond}),
+        $alias,
+      );
 
-    while ( my($col, $value) = each %implied ) {
-      my $vref = ref $value;
-      if (
-        $vref eq 'HASH'
-          and
-        keys(%$value) == 1
-          and
-        (keys %$value)[0] eq '='
-      ) {
-        $new_data{$col} = $value->{'='};
-      }
-      elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
-        $new_data{$col} = $value;
+      for my $c (keys %$implied) {
+        my $v = $implied->{$c};
+        if ( ! length ref $v or is_plain_value($v) ) {
+          $new_data{$c} = $v;
+        }
+        elsif (
+          ref $v eq 'HASH' and keys %$v == 1 and exists $v->{'='} and is_literal_value($v->{'='})
+        ) {
+          $new_data{$c} = $v->{'='};
+        }
       }
     }
   }
 
+  # precedence must be given to passed values over values inherited from
+  # the cond, so the order here is important.
   %new_data = (
     %new_data,
     %{ $self->_remove_alias($data, $alias) },
@@ -2532,7 +2478,7 @@ sub _merge_with_rscond {
 # determines if the resultset defines at least one
 # of the attributes supplied
 #
-# used to determine if a subquery is neccessary
+# used to determine if a subquery is necessary
 #
 # supports some virtual attributes:
 #   -join
@@ -2580,38 +2526,6 @@ sub _has_resolved_attr {
   return 0;
 }
 
-# _collapse_cond
-#
-# Recursively collapse the condition.
-
-sub _collapse_cond {
-  my ($self, $cond, $collapsed) = @_;
-
-  $collapsed ||= {};
-
-  if (ref $cond eq 'ARRAY') {
-    foreach my $subcond (@$cond) {
-      next unless ref $subcond;  # -or
-      $collapsed = $self->_collapse_cond($subcond, $collapsed);
-    }
-  }
-  elsif (ref $cond eq 'HASH') {
-    if (keys %$cond and (keys %$cond)[0] eq '-and') {
-      foreach my $subcond (@{$cond->{-and}}) {
-        $collapsed = $self->_collapse_cond($subcond, $collapsed);
-      }
-    }
-    else {
-      foreach my $col (keys %$cond) {
-        my $value = $cond->{$col};
-        $collapsed->{$col} = $value;
-      }
-    }
-  }
-
-  return $collapsed;
-}
-
 # _remove_alias
 #
 # Remove the specified alias from the specified query hash. A copy is made so
@@ -2660,8 +2574,6 @@ sub as_query {
     $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
   );
 
-  $self->{_attrs}{_sqlmaker_select_args} = $attrs->{_sqlmaker_select_args};
-
   $aq;
 }
 
@@ -3425,6 +3337,9 @@ sub _resolved_attrs {
   my $source = $self->result_source;
   my $alias  = $attrs->{alias};
 
+  $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported")
+    if $attrs->{collapse} and $attrs->{distinct};
+
   # default selection list
   $attrs->{columns} = [ $source->columns ]
     unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
@@ -3535,22 +3450,9 @@ sub _resolved_attrs {
     $attrs->{group_by} = [ $attrs->{group_by} ];
   }
 
-  # generate the distinct induced group_by early, as prefetch will be carried via a
-  # subquery (since a group_by is present)
-  if (delete $attrs->{distinct}) {
-    if ($attrs->{group_by}) {
-      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($attrs);
-    }
-  }
 
   # generate selections based on the prefetch helper
-  my $prefetch;
+  my ($prefetch, @prefetch_select, @prefetch_as);
   $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
     if defined $attrs->{prefetch};
 
@@ -3559,6 +3461,9 @@ sub _resolved_attrs {
     $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
       if $attrs->{_dark_selector};
 
+    $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported")
+      if defined $attrs->{collapse} and ! $attrs->{collapse};
+
     $attrs->{collapse} = 1;
 
     # this is a separate structure (we don't look in {from} directly)
@@ -3584,16 +3489,13 @@ sub _resolved_attrs {
 
     my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
 
-    push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
-    push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
-  }
-
-  if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
-    $attrs->{_related_results_construction} = 1;
+    # save these for after distinct resolution
+    @prefetch_select = map { $_->[0] } @prefetch;
+    @prefetch_as = map { $_->[1] } @prefetch;
   }
 
   # run through the resulting joinstructure (starting from our current slot)
-  # and unset collapse if proven unnesessary
+  # and unset collapse if proven unnecessary
   #
   # also while we are at it find out if the current root source has
   # been premultiplied by previous related_source chaining
@@ -3641,6 +3543,34 @@ sub _resolved_attrs {
     }
   }
 
+  # generate the distinct induced group_by before injecting the prefetched select/as parts
+  if (delete $attrs->{distinct}) {
+    if ($attrs->{group_by}) {
+      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}, my $new_order) = $source->storage->_group_over_selection($attrs);
+
+      # FIXME possibly ignore a rewritten order_by (may turn out to be an issue)
+      # The thinking is: if we are collapsing the subquerying prefetch engine will
+      # rip stuff apart for us anyway, and we do not want to have a potentially
+      # function-converted external order_by
+      # ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks )
+      $attrs->{order_by} = $new_order unless $attrs->{collapse};
+    }
+  }
+
+  # inject prefetch-bound selection (if any)
+  push @{$attrs->{select}}, @prefetch_select;
+  push @{$attrs->{as}}, @prefetch_as;
+
+  # whether we can get away with the dumbest (possibly DBI-internal) collapser
+  if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
+    $attrs->{_related_results_construction} = 1;
+  }
+
   # if both page and offset are specified, produce a combined offset
   # even though it doesn't make much sense, this is what pre 081xx has
   # been doing
@@ -4219,7 +4149,7 @@ object with all of its related data.
 If an L</order_by> is already declared, and orders the resultset in a way that
 makes collapsing as described above impossible (e.g. C<< ORDER BY
 has_many_rel.column >> or C<ORDER BY RANDOM()>), DBIC will automatically
-switch to "eager" mode and slurp the entire resultset before consturcting the
+switch to "eager" mode and slurp the entire resultset before constructing the
 first object returned by L</next>.
 
 Setting this attribute on a resultset that does not join any has_many
@@ -4433,8 +4363,17 @@ or with an in-place function in which case literal SQL is required:
 
 =back
 
-Set to 1 to group by all columns. If the resultset already has a group_by
-attribute, this setting is ignored and an appropriate warning is issued.
+Set to 1 to automatically generate a L</group_by> clause based on the selection
+(including intelligent handling of L</order_by> contents). Note that the group
+criteria calculation takes place over the B<final> selection. This includes
+any L</+columns>, L</+select> or L</order_by> additions in subsequent
+L</search> calls, and standalone columns selected via
+L<DBIx::Class::ResultSetColumn> (L</get_column>). A notable exception are the
+extra selections specified via L</prefetch> - such selections are explicitly
+excluded from group criteria calculations.
+
+If the final ResultSet also explicitly defines a L</group_by> attribute, this
+setting is ignored and an appropriate warning is issued.
 
 =head2 where
 
@@ -4643,7 +4582,7 @@ or to a sensible value based on the "data_type".
 =item dbic_colname
 
 Used to fill in missing sqlt_datatype and sqlt_size attributes (if they are
-explicitly specified they are never overriden).  Also used by some weird DBDs,
+explicitly specified they are never overridden).  Also used by some weird DBDs,
 where the column name should be available at bind_param time (e.g. Oracle).
 
 =back