X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBase.pm;h=323c31ea8440e1a700de965a688db48ff8db7e76;hb=e50536940adf2ebaef907a0c29ae37fbd5ce95b1;hp=c7daf570896cc0983ab9dad08bb02a3abfb9c1ec;hpb=b47fb9c0c3fee01f3641da23d34b8428ab1e9a70;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index c7daf57..323c31e 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -7,7 +7,7 @@ use base qw/DBIx::Class/;
 
 use Scalar::Util qw/weaken blessed/;
 use Try::Tiny;
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION fail_on_internal_call );
 use namespace::clean;
 
 =head1 NAME
@@ -499,15 +499,20 @@ this instance (like in the case of C<might_have> relationships).
 =cut
 
 sub related_resultset {
-  my $self = shift;
+  $_[0]->throw_exception(
+    '$result->related_resultset() no longer accepts extra search arguments, '
+  . 'you need to switch to ...->related_resultset($relname)->search_rs(...) '
+  . 'instead (it was never documented and more importantly could never work '
+  . 'reliably due to the heavy caching involved)'
+  ) if @_ > 2;
 
-  $self->throw_exception("Can't call *_related as class methods")
-    unless ref $self;
+  $_[0]->throw_exception("Can't call *_related as class methods")
+    unless ref $_[0];
 
-  my $rel = shift;
+  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 {
 
@@ -516,17 +521,27 @@ sub related_resultset {
     my $rel_info = $rsrc->relationship_info($rel)
       or $self->throw_exception( "No such relationship '$rel'" );
 
-    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
-    $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
+    my $cond_res = $rsrc->_resolve_relationship_condition(
+      rel_name => $rel,
+      self_result_object => $self,
 
-    $self->throw_exception( "Invalid query: @_" )
-      if (@_ > 1 && (@_ % 2 == 1));
-    my $query = ((@_ > 1) ? {@_} : shift);
+      # this may look weird, but remember that we are making a resultset
+      # out of an existing object, with the new source being at the head
+      # of the FROM chain. Having a 'me' alias is nothing but expected there
+      foreign_alias => 'me',
 
-    my ($cond, $is_crosstable) = $rsrc->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel );
+      self_alias => "!!!\xFF()!!!_SHOULD_NEVER_BE_SEEN_IN_USE_!!!()\xFF!!!",
+
+      # not strictly necessary, but shouldn't hurt either
+      require_join_free_condition => !!(ref $rel_info->{cond} ne 'CODE'),
+    );
 
     # keep in mind that the following if() block is part of a do{} - no return()s!!!
-    if ($is_crosstable and ref $rel_info->{cond} eq 'CODE') {
+    if (
+      ! $cond_res->{join_free_condition}
+        and
+      ref $rel_info->{cond} eq 'CODE'
+    ) {
 
       # A WHOREIFFIC hack to reinvoke the entire condition resolution
       # with the correct alias. Another way of doing this involves a
@@ -550,13 +565,16 @@ sub related_resultset {
       $rsrc->resultset->search(
         $self->ident_condition($obj_table_alias),
         { alias => $obj_table_alias },
-      )->search_related('me', $query, $attrs)
+      )->related_resultset('me')->search(undef, $rel_info->{attrs})
     }
     else {
+
       # FIXME - this conditional doesn't seem correct - got to figure out
       # at some point what it does. Also the entire UNRESOLVABLE_CONDITION
       # business seems shady - we could simply not query *at all*
-      if ($cond eq UNRESOLVABLE_CONDITION) {
+      my $attrs;
+      if ( $cond_res->{join_free_condition} eq UNRESOLVABLE_CONDITION ) {
+        $attrs = { %{$rel_info->{attrs}} };
         my $reverse = $rsrc->reverse_relationship_info($rel);
         foreach my $rev_rel (keys %$reverse) {
           if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
@@ -566,29 +584,10 @@ sub related_resultset {
           }
         }
       }
-      elsif (ref $cond eq 'ARRAY') {
-        $cond = [ map {
-          if (ref $_ eq 'HASH') {
-            my $hash;
-            foreach my $key (keys %$_) {
-              my $newkey = $key !~ /\./ ? "me.$key" : $key;
-              $hash->{$newkey} = $_->{$key};
-            }
-            $hash;
-          } else {
-            $_;
-          }
-        } @$cond ];
-      }
-      elsif (ref $cond eq 'HASH') {
-       foreach my $key (grep { ! /\./ } keys %$cond) {
-          $cond->{"me.$key"} = delete $cond->{$key};
-        }
-      }
 
-      $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
       $rsrc->related_source($rel)->resultset->search(
-        $query, $attrs
+        $cond_res->{join_free_condition},
+        $attrs || $rel_info->{attrs},
       );
     }
   };
@@ -613,7 +612,8 @@ See L<DBIx::Class::ResultSet/search_related> for more information.
 =cut
 
 sub search_related {
-  return shift->related_resultset(shift)->search(@_);
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  shift->related_resultset(shift)->search(@_);
 }
 
 =head2 search_related_rs
@@ -624,7 +624,8 @@ it guarantees a resultset, even in list context.
 =cut
 
 sub search_related_rs {
-  return shift->related_resultset(shift)->search_rs(@_);
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  shift->related_resultset(shift)->search_rs(@_)
 }
 
 =head2 count_related
@@ -643,7 +644,8 @@ current result or where conditions.
 =cut
 
 sub count_related {
-  shift->search_related(@_)->count;
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  shift->related_resultset(shift)->search_rs(@_)->count;
 }
 
 =head2 new_related
@@ -666,7 +668,7 @@ your storage until you call L<DBIx::Class::Row/insert> on it.
 sub new_related {
   my ($self, $rel, $data) = @_;
 
-  return $self->search_related($rel)->new_result( $self->result_source->_resolve_relationship_condition (
+  $self->related_resultset($rel)->new_result( $self->result_source->_resolve_relationship_condition (
     infer_values_based_on => $data,
     rel_name => $rel,
     self_result_object => $self,
@@ -720,7 +722,8 @@ See L<DBIx::Class::ResultSet/find> for details.
 
 sub find_related {
   #my ($self, $rel, @args) = @_;
-  return shift->search_related(shift)->find(@_);
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  return shift->related_resultset(shift)->find(@_);
 }
 
 =head2 find_or_new_related
@@ -740,8 +743,9 @@ for details.
 
 sub find_or_new_related {
   my $self = shift;
-  my $obj = $self->find_related(@_);
-  return defined $obj ? $obj : $self->new_related(@_);
+  my $rel = shift;
+  my $obj = $self->related_resultset($rel)->find(@_);
+  return defined $obj ? $obj : $self->related_resultset($rel)->new_result(@_);
 }
 
 =head2 find_or_create_related
@@ -761,8 +765,9 @@ L<DBIx::Class::ResultSet/find_or_create> for details.
 
 sub find_or_create_related {
   my $self = shift;
-  my $obj = $self->find_related(@_);
-  return (defined($obj) ? $obj : $self->create_related(@_));
+  my $rel = shift;
+  my $obj = $self->related_resultset($rel)->find(@_);
+  return (defined($obj) ? $obj : $self->related_resultset($rel)->new_result(@_)->insert);
 }
 
 =head2 update_or_create_related
@@ -782,6 +787,7 @@ L<DBIx::Class::ResultSet/update_or_create> for details.
 
 sub update_or_create_related {
   #my ($self, $rel, @args) = @_;
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->related_resultset(shift)->update_or_create(@_);
 }
 
@@ -869,8 +875,9 @@ And returns the result of that.
 
 sub delete_related {
   my $self = shift;
-  my $obj = $self->search_related(@_)->delete;
-  delete $self->{related_resultsets}->{$_[0]};
+  my $rel = shift;
+  my $obj = $self->related_resultset($rel)->search_rs(@_)->delete;
+  delete $self->{related_resultsets}->{$rel};
   return $obj;
 }