1 package # hide from PAUSE
2 DBIx::Class::Relationship::ManyToMany;
8 use Sub::Name 'subname';
9 use Scalar::Util 'blessed';
10 use DBIx::Class::_Util 'fail_on_internal_wantarray';
13 our %_pod_inherit_config =
15 class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' }
19 my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
21 $class->throw_exception(
22 "missing relation in many-to-many"
25 $class->throw_exception(
26 "missing foreign relation in many-to-many"
31 no warnings 'redefine';
33 my $add_meth = "add_to_${meth}";
34 my $remove_meth = "remove_from_${meth}";
35 my $set_meth = "set_${meth}";
36 my $rs_meth = "${meth}_rs";
38 for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
39 if ( $class->can ($_) ) {
40 carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
42 ***************************************************************************
43 The many-to-many relationship '$meth' is trying to create a utility method
45 This will completely overwrite one such already existing method on class
48 You almost certainly want to rename your method or the many-to-many
49 relationship, as the functionality of the original method will not be
52 To disable this warning set to a true value the environment variable
53 DBIC_OVERWRITE_HELPER_METHODS_OK
55 ***************************************************************************
60 $rel_attrs->{alias} ||= $f_rel;
62 my $rs_meth_name = join '::', $class, $rs_meth;
63 *$rs_meth_name = subname $rs_meth_name, sub {
65 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
66 my $rs = $self->search_related($rel)->search_related(
67 $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
72 my $meth_name = join '::', $class, $meth;
73 *$meth_name = subname $meth_name, sub {
74 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
76 my $rs = $self->$rs_meth( @_ );
77 return (wantarray ? $rs->all : $rs);
80 my $add_meth_name = join '::', $class, $add_meth;
81 *$add_meth_name = subname $add_meth_name, sub {
83 @_ or $self->throw_exception(
84 "${add_meth} needs an object or hashref"
87 my $link = $self->search_related_rs($rel)->new_result(
88 ( @_ > 1 && ref $_[-1] eq 'HASH' )
93 my $far_obj = defined blessed $_[0]
95 : $self->result_source
96 ->related_source( $rel )
97 ->related_source( $f_rel )
98 ->resultset->search_rs( {}, $rel_attrs||{} )
99 ->find_or_create( ref $_[0] eq 'HASH' ? $_[0] : {@_} )
102 $link->set_from_related($f_rel, $far_obj);
108 my $set_meth_name = join '::', $class, $set_meth;
109 *$set_meth_name = subname $set_meth_name, sub {
111 @_ > 0 or $self->throw_exception(
112 "{$set_meth} needs a list of objects or hashrefs"
114 my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
115 # if there is a where clause in the attributes, ensure we only delete
116 # rows that are within the where restriction
117 if ($rel_attrs && $rel_attrs->{where}) {
118 $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete;
120 $self->search_related( $rel, {} )->delete;
122 # add in the set rel objects
123 $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
126 my $remove_meth_name = join '::', $class, $remove_meth;
127 *$remove_meth_name = subname $remove_meth_name, sub {
128 my ($self, $obj) = @_;
129 $self->throw_exception("${remove_meth} needs an object")
130 unless blessed ($obj);
131 my $rel_source = $self->search_related($rel)->result_source;
132 my $cond = $rel_source->relationship_info($f_rel)->{cond};
133 my ($link_cond, $crosstable) = $rel_source->_resolve_condition(
134 $cond, $obj, $f_rel, $f_rel
137 $self->throw_exception(
138 "Relationship '$rel' does not resolve to a join-free condition, "
139 ."unable to use with the ManyToMany helper '$f_rel'"
142 $self->search_related($rel, $link_cond)->delete;