1 package # hide from PAUSE
2 DBIx::Class::Relationship::ManyToMany;
7 use Carp::Clan qw/^DBIx::Class/;
11 my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
13 $class->throw_exception(
14 "missing relation in many-to-many"
17 $class->throw_exception(
18 "missing foreign relation in many-to-many"
23 no warnings 'redefine';
25 my $add_meth = "add_to_${meth}";
26 my $remove_meth = "remove_from_${meth}";
27 my $set_meth = "set_${meth}";
28 my $rs_meth = "${meth}_rs";
30 for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
31 if ( $class->can ($_) ) {
32 carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
34 ***************************************************************************
35 The many-to-many relationship '$meth' is trying to create a utility method
37 This will completely overwrite one such already existing method on class
40 You almost certainly want to rename your method or the many-to-many
41 relationship, as the functionality of the original method will not be
44 To disable this warning set to a true value the environment variable
45 DBIC_OVERWRITE_HELPER_METHODS_OK
47 ***************************************************************************
52 $rel_attrs->{alias} ||= $f_rel;
54 my $rs_meth_name = join '::', $class, $rs_meth;
55 *$rs_meth_name = Sub::Name::subname $rs_meth_name, sub {
57 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
58 my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs });
59 my $rs = $self->search_related($rel)->search_related(
60 $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
65 my $meth_name = join '::', $class, $meth;
66 *$meth_name = Sub::Name::subname $meth_name, sub {
68 my $rs = $self->$rs_meth( @_ );
69 return (wantarray ? $rs->all : $rs);
72 my $add_meth_name = join '::', $class, $add_meth;
73 *$add_meth_name = Sub::Name::subname $add_meth_name, sub {
75 @_ > 0 or $self->throw_exception(
76 "${add_meth} needs an object or hashref"
78 my $source = $self->result_source;
79 my $schema = $source->schema;
80 my $rel_source_name = $source->relationship_info($rel)->{source};
81 my $rel_source = $schema->resultset($rel_source_name)->result_source;
82 my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source};
83 my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{});
87 if (ref $_[0] eq 'HASH') {
88 $obj = $f_rel_rs->find_or_create($_[0]);
93 $obj = $f_rel_rs->find_or_create({@_});
96 my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
97 my $link = $self->search_related($rel)->new_result($link_vals);
98 $link->set_from_related($f_rel, $obj);
103 my $set_meth_name = join '::', $class, $set_meth;
104 *$set_meth_name = Sub::Name::subname $set_meth_name, sub {
106 @_ > 0 or $self->throw_exception(
107 "{$set_meth} needs a list of objects or hashrefs"
109 my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
110 $self->search_related($rel, {})->delete;
111 $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
114 my $remove_meth_name = join '::', $class, $remove_meth;
115 *$remove_meth_name = Sub::Name::subname $remove_meth_name, sub {
117 @_ > 0 && ref $_[0] ne 'HASH'
118 or $self->throw_exception("${remove_meth} needs an object");
120 my $rel_source = $self->search_related($rel)->result_source;
121 my $cond = $rel_source->relationship_info($f_rel)->{cond};
122 my $link_cond = $rel_source->_resolve_condition(
125 $self->search_related($rel, $link_cond)->delete;