From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 22 Sep 2016 09:46:18 +0000 (+0200)
Subject: Audit and minimize use of last major indirect method: search()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=367eaf50970dd3fd223ce5e1f0337703f2a6c70e

Audit and minimize use of last major indirect method: search()

I am not entirely sure how I missed it during 1b822bd3, but oh well. This
should be the last highly volatile part ( as far as downstream is concerned ).

As previously - zero functional changes apart from no longer calling search()
at several spots (the SanityChecker ensures none of this results in silent
breakage)

All spots that *do* require wantarray()-specific behavior remained explicit
wrappers for search(), instead of doing the wantarray() check themselves: this
is a deliberate choice to allow DBIC::Helpers::ResultSet::IgnoreWantarray or
similar libraries to continue operating by simply hooking the search() method
---

diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm
index ed8ae7d..300c485 100644
--- a/lib/DBIx/Class/Admin.pm
+++ b/lib/DBIx/Class/Admin.pm
@@ -480,7 +480,8 @@ sub update {
   $where ||= $self->where();
   $set ||= $self->set();
   my $resultset = $self->schema->resultset($rs);
-  $resultset = $resultset->search( ($where||{}) );
+  $resultset = $resultset->search_rs( $where )
+    if $where;
 
   my $count = $resultset->count();
   print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
@@ -511,7 +512,8 @@ sub delete {
   $where ||= $self->where();
   $attrs ||= $self->attrs();
   my $resultset = $self->schema->resultset($rs);
-  $resultset = $resultset->search( ($where||{}), ($attrs||()) );
+  $resultset = $resultset->search_rs( ($where||{}), ($attrs||()) )
+    if $where or $attrs;
 
   my $count = $resultset->count();
   print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
@@ -542,7 +544,8 @@ sub select {
   $where ||= $self->where();
   $attrs ||= $self->attrs();
   my $resultset = $self->schema->resultset($rs);
-  $resultset = $resultset->search( ($where||{}), ($attrs||()) );
+  $resultset = $resultset->search_rs( ($where||{}), ($attrs||()) )
+    if $where or $attrs;
 
   my @data;
   my @columns = $resultset->result_source->columns();
diff --git a/lib/DBIx/Class/CDBICompat/LazyLoading.pm b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
index b79a096..d14b4b7 100644
--- a/lib/DBIx/Class/CDBICompat/LazyLoading.pm
+++ b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
@@ -8,9 +8,8 @@ use base 'DBIx::Class';
 
 sub resultset_instance {
   my $self = shift;
-  my $rs = $self->next::method(@_);
-  $rs = $rs->search(undef, { columns => [ $self->columns('Essential') ] });
-  return $rs;
+  $self->next::method(@_)
+        ->search_rs(undef, { columns => [ $self->columns('Essential') ] });
 }
 
 
diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index 2ac0a07..cef565e 100644
--- a/lib/DBIx/Class/Ordered.pm
+++ b/lib/DBIx/Class/Ordered.pm
@@ -249,7 +249,7 @@ sub previous_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $psib = $self->previous_siblings->search(
+    my $psib = $self->previous_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column } },
     )->single;
@@ -270,7 +270,7 @@ sub first_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $fsib = $self->previous_siblings->search(
+    my $fsib = $self->previous_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-asc' => $position_column } },
     )->single;
@@ -290,7 +290,7 @@ if the current object is the last one.
 sub next_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
-    my $nsib = $self->next_siblings->search(
+    my $nsib = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-asc' => $position_column } },
     )->single;
@@ -310,7 +310,7 @@ sibling.
 sub last_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
-    my $lsib = $self->next_siblings->search(
+    my $lsib = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column } },
     )->single;
@@ -323,7 +323,7 @@ sub _last_sibling_posval {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $cursor = $self->next_siblings->search(
+    my $cursor = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
     )->cursor;
@@ -423,7 +423,7 @@ sub move_to {
       $self->store_column(
         $position_column,
         (  $rsrc->resultset
-                 ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column })
+                 ->search_rs($self->_storage_ident_condition, { rows => 1, columns => $position_column })
                   ->cursor
                    ->next
         )[0] || $self->throw_exception(
@@ -775,7 +775,7 @@ sub _shift_siblings {
         $ord = 'desc';
     }
 
-    my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
+    my $shift_rs = $self->_group_rs-> search_rs ({ $position_column => { -between => \@between } });
 
     # some databases (sqlite, pg, perhaps others) are dumb and can not do a
     # blanket increment/decrement without violating a unique constraint.
@@ -791,7 +791,7 @@ sub _shift_siblings {
     ) {
         my $clean_rs = $rsrc->resultset;
 
-        for ( $shift_rs->search (
+        for ( $shift_rs->search_rs (
           {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
         )->cursor->all ) {
           my $pos = shift @$_;
diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 5924db0..b7e74eb 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -586,7 +586,7 @@ sub related_resultset {
 
   if( defined $jfc ) {
 
-    $rel_rset = $rsrc->related_source($rel)->resultset->search(
+    $rel_rset = $rsrc->related_source($rel)->resultset->search_rs(
       $jfc,
       $rel_info->{attrs},
     );
@@ -612,10 +612,10 @@ sub related_resultset {
     my $obj_table_alias = lc($rsrc->source_name) . '__row';
     $obj_table_alias =~ s/\W+/_/g;
 
-    $rel_rset = $rsrc->resultset->search(
+    $rel_rset = $rsrc->resultset->search_rs(
       $self->ident_condition($obj_table_alias),
       { alias => $obj_table_alias },
-    )->related_resultset('me')->search(undef, $rel_info->{attrs})
+    )->related_resultset('me')->search_rs(undef, $rel_info->{attrs})
   }
   else {
 
@@ -630,7 +630,7 @@ sub related_resultset {
       : weaken( $attrs->{related_objects}{$_}    = $self )
     for keys %$reverse;
 
-    $rel_rset = $rsrc->related_source($rel)->resultset->search(
+    $rel_rset = $rsrc->related_source($rel)->resultset->search_rs(
       UNRESOLVABLE_CONDITION, # guards potential use of the $rs in the future
       $attrs,
     );
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 0a1cc53..030f292 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -390,7 +390,9 @@ L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
 
 =cut
 
-sub search {
+sub search :DBIC_method_is_indirect_sugar {
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+
   my $rs = shift->search_rs( @_ );
 
   return $rs->all
@@ -932,7 +934,7 @@ sub find {
   }
 
   # Run the query, passing the result_class since it should propagate for find
-  my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
+  my $rs = $self->search_rs( $final_cond, {result_class => $self->result_class, %$attrs} );
   if ($rs->_resolved_attrs->{collapse}) {
     my $row = $rs->next;
     carp "Query returned more than one row" if $rs->next;
@@ -1609,7 +1611,7 @@ C<< $rs->search ($cond, \%attrs)->count >>
 
 sub count {
   my $self = shift;
-  return $self->search(@_)->count if @_ and defined $_[0];
+  return $self->search_rs(@_)->count if @_ and defined $_[0];
   return scalar @{ $self->get_cache } if $self->get_cache;
 
   my $attrs = { %{ $self->_resolved_attrs } };
@@ -1657,7 +1659,7 @@ the same single value obtainable via L</count>.
 
 sub count_rs {
   my $self = shift;
-  return $self->search(@_)->count_rs if @_;
+  return $self->search_rs(@_)->count_rs if @_;
 
   # this may look like a lack of abstraction (count() does about the same)
   # but in fact an _rs *must* use a subquery for the limits, as the
@@ -1784,7 +1786,7 @@ sub _count_subq_rs {
   return $rsrc->resultset_class
                ->new ($rsrc, $sub_attrs)
                 ->as_subselect_rs
-                 ->search ({}, { columns => { count => $rsrc->schema->storage->_count_select ($rsrc, $attrs) } })
+                 ->search_rs ({}, { columns => { count => $rsrc->schema->storage->_count_select ($rsrc, $attrs) } })
                   ->get_column ('count');
 }
 
@@ -2015,7 +2017,7 @@ sub _rs_update_delete {
           }
         }
 
-        $subrs = $subrs->search({}, { group_by => $attrs->{columns} });
+        $subrs = $subrs->search_rs({}, { group_by => $attrs->{columns} });
       }
 
       $guard = $storage->txn_scope_guard;
@@ -2543,10 +2545,10 @@ sub populate {
 
         }
 
-        $colinfo->{$rel}{rs}->search({ map # only so that we inherit them values properly, no actual search
+        $colinfo->{$rel}{rs}->search_rs({ map # only so that we inherit them values properly, no actual search
           {
             $_ => { '=' =>
-              ( $main_proto_rs ||= $rsrc->resultset->search($main_proto) )
+              ( $main_proto_rs ||= $rsrc->resultset->search_rs($main_proto) )
                 ->get_column( $colinfo->{$rel}{fk_map}{$_} )
                  ->as_query
             }
@@ -3575,7 +3577,7 @@ sub _chain_relationship {
     # Nuke the prefetch (if any) before the new $rs attrs
     # are resolved (prefetch is useless - we are wrapping
     # a subquery anyway).
-    my $rs_copy = $self->search;
+    my $rs_copy = $self->search_rs;
     $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
       $rs_copy->{attrs}{join},
       delete $rs_copy->{attrs}{prefetch},
diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm
index c3c80c9..1efdc35 100644
--- a/lib/DBIx/Class/ResultSetColumn.pm
+++ b/lib/DBIx/Class/ResultSetColumn.pm
@@ -514,7 +514,7 @@ sub _resultset {
       }
     }
 
-    $self->{_parent_resultset}->search(undef, {
+    $self->{_parent_resultset}->search_rs(undef, {
       columns => { $self->{_as} => $select }
     });
   };
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 7596f4a..8b8f5fb 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -1521,15 +1521,16 @@ L<DBIx::Class::ResultSet/ATTRIBUTES>.
 =cut
 
 sub get_from_storage {
-    my $self = shift @_;
-    my $attrs = shift @_;
-    my $resultset = $self->result_source->resultset;
+    my $self = shift;
 
-    if(defined $attrs) {
-      $resultset = $resultset->search(undef, $attrs);
-    }
-
-    return $resultset->find($self->_storage_ident_condition);
+    # with or without attrs?
+    (
+      defined( $_[0] )
+        ? $self->result_source->resultset->search_rs( undef, $_[0] )
+        : $self->result_source->resultset
+    )->find(
+      $self->_storage_ident_condition
+    );
 }
 
 =head2 discard_changes
diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index f6d598b..b75288e 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -543,7 +543,7 @@ sub get_db_version
 
     my $vtable = $self->{vschema}->resultset('Table');
     my $version = dbic_internal_try {
-      $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
+      $vtable->search_rs({}, { order_by => { -desc => 'installed' }, rows => 1 } )
               ->get_column ('version')
                ->next;
     };
@@ -771,7 +771,7 @@ sub _source_exists
   my ($self, $rs) = @_;
 
   ( dbic_internal_try {
-    $rs->search( UNRESOLVABLE_CONDITION )->cursor->next;
+    $rs->search_rs( UNRESOLVABLE_CONDITION )->cursor->next;
     1;
   } )
     ? 1
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 6d9d757..7e0520b 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -1144,12 +1144,20 @@ sub fail_on_internal_call {
     @fr2 = CORE::caller(@fr2 ? 3 : 2)
       and
     # if the frame that called us is an indirect itself - nothing to see here
-    ! grep
+    (! grep
       { $_ eq 'DBIC_method_is_indirect_sugar' }
       do {
         no strict 'refs';
         attributes::get( \&{ $fr2[3] })
       }
+    )
+      and
+    (
+      $fr->[3] ne 'DBIx::Class::ResultSet::search'
+        or
+      # these are explicit wantarray-passthrough callsites for search() due to old silly API choice
+      $fr2[3] !~ /^DBIx::Class::Ordered::(?: _group_rs | (?: _ | next_ | previous_ )? siblings )/x
+    )
   ) {
 
     my $argdesc;