X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBase.pm;h=f5d34f81d6378f5db7d8a4cd4cc2b0972f755706;hb=a4e58b18bffc45a7dd202c89209e68fbf5594098;hp=c7daf570896cc0983ab9dad08bb02a3abfb9c1ec;hpb=00ba5e6ecf1a6a550b31c913c674cd0cf8f2f879;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index c7daf57..f5d34f8 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -499,15 +499,20 @@ this instance (like in the case of C 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) + )->search_related('me', 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}, ); } };