replaced Test::Deep::NoTest with Data::Compare to not break Test::Deep tests
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 5c87ffa..bf4b1d8 100644 (file)
@@ -8,6 +8,7 @@ use DBIx::Class::Exception;
 use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken/;
 use Try::Tiny;
+use Data::Compare;
 
 # not importing first() as it will clash with our own method
 use List::Util ();
@@ -86,7 +87,7 @@ another.
   sub get_data {
     my $self = shift;
     my $request = $self->get_request; # Get a request object somehow.
-    my $schema = $self->get_schema;   # Get the DBIC schema object somehow.
+    my $schema = $self->result_source->schema;
 
     my $cd_rs = $schema->resultset('CD')->search({
       title => $request->param('title'),
@@ -208,6 +209,12 @@ sub new {
     attrs => $attrs,
   }, $class;
 
+  # if there is a dark selector, this means we are already in a
+  # chain and the cleanup/sanification was taken care of by
+  # _search_rs already
+  $self->_normalize_selection($attrs)
+    unless $attrs->{_dark_selector};
+
   $self->result_class(
     $attrs->{result_class} || $source->result_class
   );
@@ -221,7 +228,7 @@ sub new {
 
 =item Arguments: $cond, \%attrs?
 
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) ||  @row_objs (list context)
 
 =back
 
@@ -231,6 +238,9 @@ sub new {
   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
                  # year = 2005 OR year = 2004
 
+In list context, C<< ->all() >> is called implicitly on the resultset, thus
+returning a list of row objects instead. To avoid that, use L</search_rs>.
+
 If you need to pass in additional attributes but no additional condition,
 call it as C<search(undef, \%attrs)>.
 
@@ -242,7 +252,8 @@ 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
-documentation for the first argument, see L<SQL::Abstract>.
+documentation for the first argument, see L<SQL::Abstract>
+and its extension L<DBIx::Class::SQLMaker>.
 
 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
 
@@ -339,25 +350,24 @@ sub search_rs {
   # take care of call attrs (only if anything is changing)
   if (keys %$call_attrs) {
 
-    $self->throw_exception ('_trailing_select is not a public attribute - do not use it in search()')
-      if ( exists $call_attrs->{_trailing_select} or exists $call_attrs->{'+_trailing_select'} );
+    my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
 
-    my @selector_attrs = qw/select as columns cols +select +as +columns include_columns _trailing_select +_trailing_select/;
+    # reset the current selector list if new selectors are supplied
+    if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
+      delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
+    }
 
-    # Normalize the selector list (operates on the passed-in attr structure)
+    # Normalize the new selector list (operates on the passed-in attr structure)
     # Need to do it on every chain instead of only once on _resolved_attrs, in
-    # order to separate 'as'-ed from blind 'select's
+    # order to allow detection of empty vs partial 'as'
+    $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
+      if $old_attrs->{_dark_selector};
     $self->_normalize_selection ($call_attrs);
 
     # start with blind overwriting merge, exclude selector attrs
     $new_attrs = { %{$old_attrs}, %{$call_attrs} };
     delete @{$new_attrs}{@selector_attrs};
 
-    # reset the current selector list if new selectors are supplied
-    if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
-      delete @{$old_attrs}{@selector_attrs};
-    }
-
     for (@selector_attrs) {
       $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
         if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
@@ -428,6 +438,7 @@ sub search_rs {
   return $rs;
 }
 
+my $dark_sel_dumper;
 sub _normalize_selection {
   my ($self, $attrs) = @_;
 
@@ -435,6 +446,8 @@ sub _normalize_selection {
   $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns})
     if exists $attrs->{include_columns};
 
+  # columns are always placed first, however 
+
   # Keep the X vs +X separation until _resolved_attrs time - this allows to
   # delay the decision on whether to use a default select list ($rsrc->columns)
   # allowing stuff like the remove_columns helper to work
@@ -445,9 +458,7 @@ sub _normalize_selection {
   # supplied at all) - try to infer the alias, either from the -as parameter
   # of the selector spec, or use the parameter whole if it looks like a column
   # name (ugly legacy heuristic). If all fails - leave the selector bare (which
-  # is ok as well), but transport it over a separate attribute to make sure it is
-  # the last thing in the select list, thus unable to throw off the corresponding
-  # 'as' chain
+  # is ok as well), but make sure no more additions to the 'as' chain take place
   for my $pref ('', '+') {
 
     my ($sel, $as) = map {
@@ -470,68 +481,110 @@ sub _normalize_selection {
       );
     }
     elsif( ! @$as ) {
-      # no as part supplied at all - try to deduce
+      # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
       # if any @$as has been supplied we assume the user knows what (s)he is doing
       # and blindly keep stacking up pieces
-      my (@new_sel, @new_trailing);
-      for (@$sel) {
-        if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
-          push @$as, $_->{-as};
-          push @new_sel, $_;
-        }
-        # assume any plain no-space, no-parenthesis string to be a column spec
-        # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
-        elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
-          push @$as, $_;
-          push @new_sel, $_;
-        }
-        # if all else fails - shove the selection to the trailing stack and move on
-        else {
-          push @new_trailing, $_;
+      unless ($attrs->{_dark_selector}) {
+        SELECTOR:
+        for (@$sel) {
+          if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
+            push @$as, $_->{-as};
+          }
+          # assume any plain no-space, no-parenthesis string to be a column spec
+          # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
+          elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
+            push @$as, $_;
+          }
+          # if all else fails - raise a flag that no more aliasing will be allowed
+          else {
+            $attrs->{_dark_selector} = {
+              plus_stage => $pref,
+              string => ($dark_sel_dumper ||= do {
+                  require Data::Dumper::Concise;
+                  Data::Dumper::Concise::DumperObject()->Indent(0);
+                })->Values([$_])->Dump
+              ,
+            };
+            last SELECTOR;
+          }
         }
       }
-
-      @$sel = @new_sel;
-      $attrs->{"${pref}_trailing_select"} = $self->_merge_attr($attrs->{"${pref}_trailing_select"}, \@new_trailing)
-        if @new_trailing;
     }
     elsif (@$as < @$sel) {
       $self->throw_exception(
         "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
       );
     }
-
-    # now see what the result for this pair looks like:
-    if (@$as == @$sel) {
-
-      # if balanced - treat as a columns entry
-      $attrs->{"${pref}columns"} = $self->_merge_attr(
-        $attrs->{"${pref}columns"},
-        [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ]
+    elsif ($pref and $attrs->{_dark_selector}) {
+      $self->throw_exception(
+        "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
       );
     }
-    else {
-      # unbalanced - shove in select/as, not subject to deduplication in _resolved_attrs
-      $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
-      $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
-    }
-  }
 
+
+    # merge result
+    $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
+    $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
+  }
 }
 
 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 %$_;
+
+      # 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'};
+        }
+      }
+    }
+  }
+
+  # merge hashes with weeding out of duplicates (simple cases only)
+  if (ref $left eq 'HASH' and ref $right eq 'HASH') {
+
+    # 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 Compare( $left->{$_}, $right->{$_} );
+    }
+
+    $right = undef unless keys %$right;
+  }
+
+
   if (defined $left xor defined $right) {
     return defined $left ? $left : $right;
   }
-  elsif (defined $left) {
-    return { -and => [ map
-      { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-      ($left, $right)
-    ]};
+  elsif (! defined $left) {
+    return undef;
+  }
+  else {
+    return { -and => [ $left, $right ] };
   }
-
-  return undef;
 }
 
 =head2 search_literal
@@ -540,7 +593,7 @@ sub _stack_cond {
 
 =item Arguments: $sql_fragment, @bind_values
 
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
 
 =back
 
@@ -837,7 +890,7 @@ sub _build_unique_cond {
 
 =item Arguments: $rel, $cond, \%attrs?
 
-=item Return Value: $new_resultset
+=item Return Value: $new_resultset (scalar context) || @row_objs (list context)
 
 =back
 
@@ -848,6 +901,11 @@ sub _build_unique_cond {
 Searches the specified relationship, optionally specifying a condition and
 attributes for matching records. See L</ATTRIBUTES> for more information.
 
+In list context, C<< ->all() >> is called implicitly on the resultset, thus
+returning a list of row objects instead. To avoid that, use L</search_related_rs>.
+
+See also L</search_related_rs>.
+
 =cut
 
 sub search_related {
@@ -1028,7 +1086,7 @@ sub get_column {
 
 =item Arguments: $cond, \%attrs?
 
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
 
 =back
 
@@ -1071,7 +1129,7 @@ sub search_like {
 
 =item Arguments: $first, $last
 
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
 
 =back
 
@@ -1424,7 +1482,7 @@ sub _count_rs {
   # overwrite the selector (supplied by the storage)
   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
   $tmp_attrs->{as} = 'count';
-  delete @{$tmp_attrs}{qw/columns _trailing_select/};
+  delete @{$tmp_attrs}{qw/columns/};
 
   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
 
@@ -1442,7 +1500,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 _trailing_select order_by for/};
+  delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/};
 
   # if we multi-prefetch we group_by primary keys only as this is what we would
   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
@@ -1551,8 +1609,7 @@ sub count_literal { shift->search_literal(@_)->count; }
 
 =back
 
-Returns all elements in the resultset. Called implicitly if the resultset
-is returned in list context.
+Returns all elements in the resultset.
 
 =cut
 
@@ -1643,12 +1700,8 @@ sub _rs_update_delete {
 
   my $rsrc = $self->result_source;
 
-  # if a condition exists we need to strip all table qualifiers
-  # if this is not possible we'll force a subquery below
-  my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
-
   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
-  my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/);
+  my $needs_subq = $needs_group_by_subq || $self->_has_resolved_attr(qw/rows offset/);
 
   if ($needs_group_by_subq or $needs_subq) {
 
@@ -1693,10 +1746,23 @@ sub _rs_update_delete {
     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
   }
   else {
+    # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
+    # a condition containing 'me' or other table prefixes will not work
+    # at all. What this code tries to do (badly) is to generate a condition
+    # with the qualifiers removed, by exploiting the quote mechanism of sqla
+    #
+    # this is atrocious and should be replaced by normal sqla introspection
+    # one sunny day
+    my ($sql, @bind) = do {
+      my $sqla = $rsrc->storage->sql_maker;
+      local $sqla->{_dequalify_idents} = 1;
+      $sqla->_recurse_where($self->{cond});
+    } if $self->{cond};
+
     return $rsrc->storage->$op(
       $rsrc,
       $op eq 'update' ? $values : (),
-      $cond,
+      $self->{cond} ? \[$sql, @bind] : (),
     );
   }
 }
@@ -1764,7 +1830,7 @@ sub update_all {
     unless ref $values eq 'HASH';
 
   my $guard = $self->result_source->schema->txn_scope_guard;
-  $_->update($values) for $self->all;
+  $_->update({%$values}) for $self->all;  # shallow copy - update will mangle it
   $guard->commit;
   return 1;
 }
@@ -2150,10 +2216,6 @@ sub pager {
 
   return $self->{pager} if $self->{pager};
 
-  if ($self->get_cache) {
-    $self->throw_exception ('Pagers on cached resultsets are not supported');
-  }
-
   my $attrs = $self->{attrs};
   if (!defined $attrs->{page}) {
     $self->throw_exception("Can't create pager for non-paged rs");
@@ -3232,16 +3294,13 @@ sub _resolved_attrs {
   my $source = $self->result_source;
   my $alias  = $attrs->{alias};
 
-  # one last pass of normalization
-  $self->_normalize_selection($attrs);
-
   # default selection list
   $attrs->{columns} = [ $source->columns ]
-    unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as _trailing_select/;
+    unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
 
   # merge selectors together
-  for (qw/columns select as _trailing_select/) {
-    $attrs->{$_} = $self->_merge_attr($attrs->{$_}, $attrs->{"+$_"})
+  for (qw/columns select as/) {
+    $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
       if $attrs->{$_} or $attrs->{"+$_"};
   }
 
@@ -3357,11 +3416,10 @@ sub _resolved_attrs {
     }
     else {
       # distinct affects only the main selection part, not what prefetch may
-      # add below. However trailing is not yet a part of the selection as
-      # prefetch must insert before it
+      # add below.
       $attrs->{group_by} = $source->storage->_group_over_selection (
         $attrs->{from},
-        [ @{$attrs->{select}||[]}, @{$attrs->{_trailing_select}||[]} ],
+        $attrs->{select},
         $attrs->{order_by},
       );
     }
@@ -3369,6 +3427,10 @@ sub _resolved_attrs {
 
   $attrs->{collapse} ||= {};
   if ($attrs->{prefetch}) {
+
+    $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
+      if $attrs->{_dark_selector};
+
     my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} );
 
     my $prefetch_ordering = [];
@@ -3411,9 +3473,6 @@ sub _resolved_attrs {
   }
 
 
-  push @{ $attrs->{select} }, @{$attrs->{_trailing_select}}
-    if $attrs->{_trailing_select};
-
   # 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