Bring in line behavior of related_resultset() on both $rs and $result
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 97dfe78..3d1a3a1 100644 (file)
@@ -5,12 +5,12 @@ use warnings;
 use base qw/DBIx::Class/;
 use DBIx::Class::Carp;
 use DBIx::Class::ResultSetColumn;
+use DBIx::Class::ResultClass::HashRefInflator;
 use Scalar::Util qw/blessed weaken reftype/;
 use DBIx::Class::_Util qw(
   fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
 );
 use Try::Tiny;
-use Data::Compare (); # no imports!!! guard against insane architecture
 
 # not importing first() as it will clash with our own method
 use List::Util ();
@@ -59,7 +59,7 @@ just stores all the conditions needed to create the query.
 
 A basic ResultSet representing the data of an entire table is returned
 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
-L<Source|DBIx::Class::Manual::Glossary/Source> name.
+L<Source|DBIx::Class::Manual::Glossary/ResultSource> name.
 
   my $users_rs = $schema->resultset('User');
 
@@ -656,26 +656,17 @@ sub _stack_cond {
     (ref $_ eq 'HASH' and ! keys %$_)
   ) and $_ = undef for ($left, $right);
 
-  # either on of the two undef or both undef
-  if ( ( (defined $left) xor (defined $right) ) or ! defined $left ) {
+  # either one of the two undef
+  if ( (defined $left) xor (defined $right) ) {
     return defined $left ? $left : $right;
   }
-
-  my $cond = $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
-
-  for my $c (grep { ref $cond->{$_} eq 'ARRAY' and ($cond->{$_}[0]||'') eq '-and' } keys %$cond) {
-
-    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 );
-    }
-
-    $cond->{$c} = (@fin == 1) ? $fin[0] : [-and => @fin ];
+  # both undef
+  elsif ( ! defined $left ) {
+    return undef
+  }
+  else {
+    return $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
   }
-
-  $cond;
 }
 
 =head2 search_literal
@@ -1157,7 +1148,7 @@ You most likely want to use L</search> with specific operators.
 
 For more information, see L<DBIx::Class::Manual::Cookbook>.
 
-This method is deprecated and will be removed in 0.09. Use L</search()>
+This method is deprecated and will be removed in 0.09. Use L<search()|/search>
 instead. An example conversion is:
 
   ->search_like({ foo => 'bar' });
@@ -1392,11 +1383,7 @@ sub _construct_results {
   $self->{_result_inflator}{is_hri} = ( (
     ! $self->{_result_inflator}{is_core_row}
       and
-    $inflator_cref == (
-      require DBIx::Class::ResultClass::HashRefInflator
-        &&
-      DBIx::Class::ResultClass::HashRefInflator->can('inflate_result')
-    )
+    $inflator_cref == \&DBIx::Class::ResultClass::HashRefInflator::inflate_result
   ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri};
 
 
@@ -1473,6 +1460,9 @@ sub _construct_results {
         if @violating_idx;
 
       $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols);
+
+      utf8::upgrade($unrolled_non_null_cols_to_check)
+        if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
     }
 
     my $next_cref =
@@ -1552,8 +1542,8 @@ L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
 
 Note that changing the result_class will also remove any components
 that were originally loaded in the source class via
-L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
-in the original source class will not run.
+L<load_components|Class::C3::Componentised/load_components( @comps )>.
+Any overloaded methods in the original source class will not run.
 
 =cut
 
@@ -2248,6 +2238,8 @@ sub populate {
     my (@results, $guard);
 
     if (ref $data->[0] eq 'ARRAY') {
+      # column names only, nothing to do
+      return if @$data == 1;
 
       $guard = $self->result_source->schema->storage->txn_scope_guard
         if @$data > 2;
@@ -2290,6 +2282,8 @@ sub populate {
 
       # positional(!) explicit column list
       if ($i == 0) {
+        # column names only, nothing to do
+        return if @$data == 1;
 
         $colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_]
           for 0 .. $#{$data->[0]};
@@ -3226,10 +3220,16 @@ Returns a related resultset for the supplied relationship name.
 =cut
 
 sub related_resultset {
-  my ($self, $rel) = @_;
+  $_[0]->throw_exception(
+    'Extra arguments to $rs->related_resultset() were always quietly '
+  . 'discarded without consideration, you need to switch to '
+  . '...->related_resultset( $relname )->search_rs( $search, $args ) instead.'
+  ) if @_ > 2;
+
+  return $_[0]->{related_resultsets}{$_[1]}
+    if defined $_[0]->{related_resultsets}{$_[1]};
 
-  return $self->{related_resultsets}{$rel}
-    if defined $self->{related_resultsets}{$rel};
+  my ($self, $rel) = @_;
 
   return $self->{related_resultsets}{$rel} = do {
     my $rsrc = $self->result_source;
@@ -3242,22 +3242,25 @@ sub related_resultset {
 
     my $attrs = $self->_chain_relationship($rel);
 
-    my $join_count = $attrs->{seen_join}{$rel};
+    my $storage = $rsrc->schema->storage;
 
-    my $alias = $self->result_source->storage
-        ->relname_to_table_alias($rel, $join_count);
+    # Previously this atribute was deleted (instead of being set as it is now)
+    # Doing so seems to be harmless in all available test permutations
+    # See also 01d59a6a6 and mst's comment below
+    #
+    $attrs->{alias} = $storage->relname_to_table_alias(
+      $rel,
+      $attrs->{seen_join}{$rel}
+    );
 
     # since this is search_related, and we already slid the select window inwards
     # (the select/as attrs were deleted in the beginning), we need to flip all
     # left joins to inner, so we get the expected results
     # read the comment on top of the actual function to see what this does
-    $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
-
+    $attrs->{from} = $storage->_inner_join_to_node( $attrs->{from}, $attrs->{alias} );
 
     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
-    delete @{$attrs}{qw(result_class alias)};
-
-    my $rel_source = $rsrc->related_source($rel);
+    delete $attrs->{result_class};
 
     my $new = do {
 
@@ -3266,16 +3269,19 @@ sub related_resultset {
       # source you need to know what alias it's -going- to have for things
       # to work sanely (e.g. RestrictWithObject wants to be able to add
       # extra query restrictions, and these may need to be $alias.)
-
-      my $rel_attrs = $rel_source->resultset_attributes;
-      local $rel_attrs->{alias} = $alias;
-
-      $rel_source->resultset
-                 ->search_rs(
-                     undef, {
-                       %$attrs,
-                       where => $attrs->{where},
-                   });
+      #                                       -- mst ~ 2007 (01d59a6a6)
+      #
+      # FIXME - this seems to be no longer neccessary (perhaps due to the
+      # advances in relcond resolution. Testing DBIC::S::RWO and its only
+      # dependent (as of Jun 2015 ) does not yield any difference with or
+      # without this line. Nevertheless keep it as is for now, to minimize
+      # churn, there is enough potential for breakage in 0.0829xx as it is
+      #                                       -- ribasushi Jun 2015
+      #
+      my $rel_source = $rsrc->related_source($rel);
+      local $rel_source->resultset_attributes->{alias} = $attrs->{alias};
+
+      $rel_source->resultset->search_rs( undef, $attrs );
     };
 
     if (my $cache = $self->get_cache) {
@@ -3326,6 +3332,9 @@ source alias of the current result set:
     });
   }
 
+The alias of L<newly created resultsets|/search> can be altered by the
+L<alias attribute|/alias>.
+
 =cut
 
 sub current_source_alias {
@@ -3620,62 +3629,35 @@ sub _resolved_attrs {
       ];
   }
 
-  if ( defined $attrs->{order_by} ) {
-    $attrs->{order_by} = (
-      ref( $attrs->{order_by} ) eq 'ARRAY'
-      ? [ @{ $attrs->{order_by} } ]
-      : [ $attrs->{order_by} || () ]
-    );
-  }
-
-  if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
-    $attrs->{group_by} = [ $attrs->{group_by} ];
-  }
 
+  for my $attr (qw(order_by group_by)) {
 
-  # generate selections based on the prefetch helper
-  my ($prefetch, @prefetch_select, @prefetch_as);
-  $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
-    if defined $attrs->{prefetch};
+    if ( defined $attrs->{$attr} ) {
+      $attrs->{$attr} = (
+        ref( $attrs->{$attr} ) eq 'ARRAY'
+        ? [ @{ $attrs->{$attr} } ]
+        : [ $attrs->{$attr} || () ]
+      );
 
-  if ($prefetch) {
+      delete $attrs->{$attr} unless @{$attrs->{$attr}};
+    }
+  }
 
-    $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
-      if $attrs->{_dark_selector};
 
+  # set collapse default based on presence of prefetch
+  my $prefetch;
+  if (
+    defined $attrs->{prefetch}
+      and
+    $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
+  ) {
     $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)
-    # as the resolver needs to shift things off the lists to work
-    # properly (identical-prefetches on different branches)
-    my $join_map = {};
-    if (ref $attrs->{from} eq 'ARRAY') {
-
-      my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
-
-      for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
-        next unless $j->[0]{-alias};
-        next unless $j->[0]{-join_path};
-        next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
-
-        my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
-
-        my $p = $join_map;
-        $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
-        push @{$p->{-join_aliases} }, $j->[0]{-alias};
-      }
-    }
-
-    my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
-
-    # 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 unnecessary
   #
@@ -3725,6 +3707,7 @@ sub _resolved_attrs {
     }
   }
 
+
   # generate the distinct induced group_by before injecting the prefetched select/as parts
   if (delete $attrs->{distinct}) {
     if ($attrs->{group_by}) {
@@ -3744,9 +3727,38 @@ sub _resolved_attrs {
     }
   }
 
-  # inject prefetch-bound selection (if any)
-  push @{$attrs->{select}}, @prefetch_select;
-  push @{$attrs->{as}}, @prefetch_as;
+
+  # generate selections based on the prefetch helper
+  if ($prefetch) {
+
+    $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
+      if $attrs->{_dark_selector};
+
+    # this is a separate structure (we don't look in {from} directly)
+    # as the resolver needs to shift things off the lists to work
+    # properly (identical-prefetches on different branches)
+    my $joined_node_aliases_map = {};
+    if (ref $attrs->{from} eq 'ARRAY') {
+
+      my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
+
+      for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
+        next unless $j->[0]{-alias};
+        next unless $j->[0]{-join_path};
+        next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
+
+        my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
+
+        my $p = $joined_node_aliases_map;
+        $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
+        push @{$p->{-join_aliases} }, $j->[0]{-alias};
+      }
+    }
+
+    ( push @{$attrs->{select}}, $_->[0] ) and ( push @{$attrs->{as}}, $_->[1] )
+      for $source->_resolve_selection_from_prefetch( $prefetch, $joined_node_aliases_map );
+  }
+
 
   $attrs->{_simple_passthrough_construction} = !(
     $attrs->{collapse}
@@ -3754,6 +3766,7 @@ sub _resolved_attrs {
     grep { $_ =~ /\./ } @{$attrs->{as}}
   );
 
+
   # 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
@@ -3819,8 +3832,10 @@ sub _calculate_score {
 
   if (ref $b eq 'HASH') {
     my ($b_key) = keys %{$b};
+    $b_key = '' if ! defined $b_key;
     if (ref $a eq 'HASH') {
       my ($a_key) = keys %{$a};
+      $a_key = '' if ! defined $a_key;
       if ($a_key eq $b_key) {
         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
       } else {
@@ -4087,19 +4102,34 @@ is the same as
     as     => [qw(some_column dbic_slot)]
 
 If you want to individually retrieve related columns (in essence perform
-manual prefetch) you have to make sure to specify the correct inflation slot
+manual L</prefetch>) you have to make sure to specify the correct inflation slot
 chain such that it matches existing relationships:
 
     my $rs = $schema->resultset('Artist')->search({}, {
         # required to tell DBIC to collapse has_many relationships
         collapse => 1,
-        join     => { cds => 'tracks'},
+        join     => { cds => 'tracks' },
         '+columns'  => {
           'cds.cdid'         => 'cds.cdid',
           'cds.tracks.title' => 'tracks.title',
         },
     });
 
+Like elsewhere, literal SQL or literal values can be included by using a
+scalar reference or a literal bind value, and these values will be available
+in the result with C<get_column> (see also
+L<SQL::Abstract/Literal SQL and value type operators>):
+
+    # equivalent SQL: SELECT 1, 'a string', IF(my_column,?,?) ...
+    # bind values: $true_value, $false_value
+    columns => [
+        {
+            foo => \1,
+            bar => \q{'a string'},
+            baz => \[ 'IF(my_column,?,?)', $true_value, $false_value ],
+        }
+    ]
+
 =head2 +columns
 
 B<NOTE:> You B<MUST> explicitly quote C<'+columns'> when using this attribute.
@@ -4152,10 +4182,11 @@ names:
 
 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
 use L</select>, to instruct DBIx::Class how to store the result of the column.
-Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
-identifier aliasing. You can however alias a function, so you can use it in
-e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
-attribute> supplied as shown in the example above.
+
+Also note that the L</as> attribute has B<nothing to do> with the SQL-side
+C<AS> identifier aliasing. You B<can> alias a function (so you can use it e.g.
+in an C<ORDER BY> clause), however this is done via the C<-as> B<select
+function attribute> supplied as shown in the example above.
 
 =head2 +select
 
@@ -4185,8 +4216,10 @@ Indicates DBIC-side names for object inflation. That is L</as> indicates the
 slot name in which the column value will be stored within the
 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
 identifier by the C<get_column> method (or via the object accessor B<if one
-with the same name already exists>) as shown below. The L</as> attribute has
-B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
+with the same name already exists>) as shown below.
+
+The L</as> attribute has B<nothing to do> with the SQL-side identifier
+aliasing C<AS>. See L</select> for details.
 
   $rs = $schema->resultset('Employee')->search(undef, {
     select => [
@@ -4362,8 +4395,10 @@ For a more in-depth discussion, see L</PREFETCHING>.
 
 This attribute is a shorthand for specifying a L</join> spec, adding all
 columns from the joined related sources as L</+columns> and setting
-L</collapse> to a true value. For example, the following two queries are
-equivalent:
+L</collapse> to a true value. It can be thought of as a rough B<superset>
+of the L</join> attribute.
+
+For example, the following two queries are equivalent:
 
   my $rs = $schema->resultset('Artist')->search({}, {
     prefetch => { cds => ['genre', 'tracks' ] },
@@ -4540,15 +4575,20 @@ A arrayref of columns to group by. Can include columns of joined tables.
 
 =back
 
-HAVING is a select statement attribute that is applied between GROUP BY and
-ORDER BY. It is applied to the after the grouping calculations have been
-done.
+The HAVING operator specifies a B<secondary> condition applied to the set
+after the grouping calculations have been done. In other words it is a
+constraint just like L</where> (and accepting the same
+L<SQL::Abstract syntax|SQL::Abstract/WHERE CLAUSES>) applied to the data
+as it exists after GROUP BY has taken place. Specifying L</having> without
+L</group_by> is a logical mistake, and a fatal error on most RDBMS engines.
+
+E.g.
 
   having => { 'count_employee' => { '>=', 100 } }
 
 or with an in-place function in which case literal SQL is required:
 
-  having => \[ 'count(employee) >= ?', [ count => 100 ] ]
+  having => \[ 'count(employee) >= ?', 100 ]
 
 =head2 distinct
 
@@ -4572,19 +4612,14 @@ setting is ignored and an appropriate warning is issued.
 
 =head2 where
 
-=over 4
-
-Adds to the WHERE clause.
+Adds extra conditions to the resultset, combined with the preexisting C<WHERE>
+conditions, same as the B<first> argument to the L<search operator|/search>
 
   # only return rows WHERE deleted IS NULL for all searches
   __PACKAGE__->resultset_attributes({ where => { deleted => undef } });
 
-Can be overridden by passing C<< { where => undef } >> as an attribute
-to a resultset.
-
-For more complicated where clauses see L<SQL::Abstract/WHERE CLAUSES>.
-
-=back
+Note that the above example is
+L<strongly discouraged|DBIx::Class::ResultSource/resultset_attributes>.
 
 =head2 cache
 
@@ -4790,11 +4825,15 @@ supported:
   [ undef,   $val ] === [ {}, $val ]
   $val              === [ {}, $val ]
 
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
 
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
 
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
+=cut