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 DUMMY_ALIASPAIR
+ fail_on_internal_call
+);
+use DBIx::Class::Carp;
use namespace::clean;
=head1 NAME
my ($self, $rel) = @_;
- return $self->{related_resultsets}{$rel} = do {
+ my $rsrc = $self->result_source;
- my $rsrc = $self->result_source;
+ my $rel_info = $rsrc->relationship_info($rel)
+ or $self->throw_exception( "No such relationship '$rel'" );
- my $rel_info = $rsrc->relationship_info($rel)
- or $self->throw_exception( "No such relationship '$rel'" );
+ my $relcond_is_freeform = ref $rel_info->{cond} eq 'CODE';
- my $cond_res = $rsrc->_resolve_relationship_condition(
- rel_name => $rel,
- self_result_object => $self,
+ my $jfc = $rsrc->_resolve_relationship_condition(
- # 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',
+ rel_name => $rel,
+ self_result_object => $self,
+
+ # an extra sanity check guard
+ require_join_free_condition => ! $relcond_is_freeform,
+
+ # an API where these are optional would be too cumbersome,
+ # instead always pass in some dummy values
+ DUMMY_ALIASPAIR,
- self_alias => "!!!\xFF()!!!_SHOULD_NEVER_BE_SEEN_IN_USE_!!!()\xFF!!!",
+ # 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',
- # not strictly necessary, but shouldn't hurt either
- require_join_free_condition => !!(ref $rel_info->{cond} ne 'CODE'),
+ )->{join_free_condition};
+
+ my $rel_rset;
+
+ if( defined $jfc ) {
+
+ $rel_rset = $rsrc->related_source($rel)->resultset->search(
+ $jfc,
+ $rel_info->{attrs},
);
+ }
+ elsif( $relcond_is_freeform ) {
+
+ # A WHOREIFFIC hack to reinvoke the entire condition resolution
+ # with the correct alias. Another way of doing this involves a
+ # lot of state passing around, and the @_ positions are already
+ # mapped out, making this crap a less icky option.
+ #
+ # The point of this exercise is to retain the spirit of the original
+ # $obj->search_related($rel) where the resulting rset will have the
+ # root alias as 'me', instead of $rel (as opposed to invoking
+ # $rs->search_related)
+
+ # make the fake 'me' rel
+ local $rsrc->{_relationships}{me} = {
+ %{ $rsrc->{_relationships}{$rel} },
+ _original_name => $rel,
+ };
+
+ my $obj_table_alias = lc($rsrc->source_name) . '__row';
+ $obj_table_alias =~ s/\W+/_/g;
+
+ $rel_rset = $rsrc->resultset->search(
+ $self->ident_condition($obj_table_alias),
+ { alias => $obj_table_alias },
+ )->related_resultset('me')->search(undef, $rel_info->{attrs})
+ }
+ else {
- # keep in mind that the following if() block is part of a do{} - no return()s!!!
- 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
- # lot of state passing around, and the @_ positions are already
- # mapped out, making this crap a less icky option.
- #
- # The point of this exercise is to retain the spirit of the original
- # $obj->search_related($rel) where the resulting rset will have the
- # root alias as 'me', instead of $rel (as opposed to invoking
- # $rs->search_related)
-
- # make the fake 'me' rel
- local $rsrc->{_relationships}{me} = {
- %{ $rsrc->{_relationships}{$rel} },
- _original_name => $rel,
- };
+ my $attrs = { %{$rel_info->{attrs}} };
+ my $reverse = $rsrc->reverse_relationship_info($rel);
- my $obj_table_alias = lc($rsrc->source_name) . '__row';
- $obj_table_alias =~ s/\W+/_/g;
+ # FIXME - this loop doesn't seem correct - got to figure out
+ # at some point what exactly it does.
+ ( ( $reverse->{$_}{attrs}{accessor}||'') eq 'multi' )
+ ? weaken( $attrs->{related_objects}{$_}[0] = $self )
+ : weaken( $attrs->{related_objects}{$_} = $self )
+ for keys %$reverse;
- $rsrc->resultset->search(
- $self->ident_condition($obj_table_alias),
- { alias => $obj_table_alias },
- )->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*
- 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') {
- weaken($attrs->{related_objects}{$rev_rel}[0] = $self);
- } else {
- weaken($attrs->{related_objects}{$rev_rel} = $self);
- }
- }
- }
+ $rel_rset = $rsrc->related_source($rel)->resultset->search(
+ UNRESOLVABLE_CONDITION, # guards potential use of the $rs in the future
+ $attrs,
+ );
+ }
- $rsrc->related_source($rel)->resultset->search(
- $cond_res->{join_free_condition},
- $attrs || $rel_info->{attrs},
- );
- }
- };
+ $self->{related_resultsets}{$rel} = $rel_rset;
}
=head2 search_related
=cut
-sub search_related {
- return shift->related_resultset(shift)->search(@_);
+sub search_related :DBIC_method_is_indirect_sugar {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->related_resultset(shift)->search(@_);
}
=head2 search_related_rs
=cut
-sub search_related_rs {
- return shift->related_resultset(shift)->search_rs(@_);
+sub search_related_rs :DBIC_method_is_indirect_sugar {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->related_resultset(shift)->search_rs(@_)
}
=head2 count_related
=cut
-sub count_related {
- shift->search_related(@_)->count;
+sub count_related :DBIC_method_is_indirect_sugar {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->related_resultset(shift)->search_rs(@_)->count;
}
=head2 new_related
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,
- foreign_alias => $rel,
- self_alias => 'me',
+
+ # an API where these are optional would be too cumbersome,
+ # instead always pass in some dummy values
+ DUMMY_ALIASPAIR,
+
)->{inferred_values} );
}
=cut
-sub find_related {
+sub find_related :DBIC_method_is_indirect_sugar {
#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
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
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->create_related( $rel => @_ ));
}
=head2 update_or_create_related
=cut
-sub update_or_create_related {
+sub update_or_create_related :DBIC_method_is_indirect_sugar {
#my ($self, $rel, @args) = @_;
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
shift->related_resultset(shift)->update_or_create(@_);
}
$self->set_columns( $self->result_source->_resolve_relationship_condition (
infer_values_based_on => {},
rel_name => $rel,
- foreign_values => $f_obj,
- foreign_alias => $rel,
- self_alias => 'me',
+ foreign_values => (
+ # maintain crazy set_from_related interface
+ #
+ ( ! defined $f_obj ) ? +{}
+ : ( ! defined blessed $f_obj ) ? $f_obj
+ : do {
+
+ my $f_result_class = $self->result_source->related_source($rel)->result_class;
+
+ unless( $f_obj->isa($f_result_class) ) {
+
+ $self->throw_exception(
+ 'Object supplied to set_from_related() must inherit from '
+ . "'$DBIx::Class::ResultSource::__expected_result_class_isa'"
+ ) unless $f_obj->isa(
+ $DBIx::Class::ResultSource::__expected_result_class_isa
+ );
+
+ carp_unique(
+ 'Object supplied to set_from_related() usually should inherit from '
+ . "the related ResultClass ('$f_result_class'), perhaps you've made "
+ . 'a mistake?'
+ );
+ }
+
+ +{ $f_obj->get_columns };
+ }
+ ),
+
+ # an API where these are optional would be too cumbersome,
+ # instead always pass in some dummy values
+ DUMMY_ALIASPAIR,
+
)->{inferred_values} );
return 1;
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;
}
projects / dbsrgits/DBIx-Class.git / blobdiff