Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::Relationship::ManyToMany; |
8973b6f1 |
3 | |
4 | use strict; |
5 | use warnings; |
35678f0b |
6 | use warnings::register; |
ddc0a6c8 |
7 | use Sub::Name (); |
8973b6f1 |
8 | |
9 | sub many_to_many { |
78af1010 |
10 | my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; |
d0ed3b55 |
11 | |
12 | $class->throw_exception( |
13 | "missing relation in many-to-many" |
14 | ) unless $rel; |
15 | |
16 | $class->throw_exception( |
17 | "missing foreign relation in many-to-many" |
18 | ) unless $f_rel; |
19 | |
8973b6f1 |
20 | { |
21 | no strict 'refs'; |
22 | no warnings 'redefine'; |
4b3ab474 |
23 | |
b3f358b5 |
24 | my $add_meth = "add_to_${meth}"; |
25 | my $remove_meth = "remove_from_${meth}"; |
26 | my $set_meth = "set_${meth}"; |
18788bf2 |
27 | my $rs_meth = "${meth}_rs"; |
303cf522 |
28 | |
35210a5d |
29 | for ($add_meth, $remove_meth, $set_meth, $rs_meth) { |
35678f0b |
30 | warnings::warn(<<"EOW") |
31 | *************************************************************************** |
32 | The many-to-many relationship $meth is trying to create a utility method called |
33 | $_. This will overwrite the existing method on $class. You almost certainly |
34 | want to rename your method or the many-to-many relationship, as your method |
35 | will not be callable (it will use the one from the relationship instead.) |
36 | |
37 | no warnings 'DBIx::Class::Relationship::ManyToMany'; in |
38 | $class to disable. |
39 | *************************************************************************** |
40 | EOW |
41 | if warnings::enabled() && $class->can($_); |
35210a5d |
42 | } |
43 | |
7141bdfc |
44 | $rel_attrs->{alias} ||= $f_rel; |
45 | |
ddc0a6c8 |
46 | my $rs_meth_name = join '::', $class, $rs_meth; |
47 | *$rs_meth_name = Sub::Name::subname $rs_meth_name, sub { |
0f6ac8bb |
48 | my $self = shift; |
49 | my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
78060df8 |
50 | my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }); |
18788bf2 |
51 | my $rs = $self->search_related($rel)->search_related( |
3a868fb2 |
52 | $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } |
53 | ); |
18788bf2 |
54 | return $rs; |
78af1010 |
55 | }; |
4b3ab474 |
56 | |
ddc0a6c8 |
57 | my $meth_name = join '::', $class, $meth; |
58 | *$meth_name = Sub::Name::subname $meth_name, sub { |
18788bf2 |
59 | my $self = shift; |
60 | my $rs = $self->$rs_meth( @_ ); |
61 | return (wantarray ? $rs->all : $rs); |
62 | }; |
63 | |
ddc0a6c8 |
64 | my $add_meth_name = join '::', $class, $add_meth; |
65 | *$add_meth_name = Sub::Name::subname $add_meth_name, sub { |
303cf522 |
66 | my $self = shift; |
67 | @_ > 0 or $self->throw_exception( |
b3f358b5 |
68 | "${add_meth} needs an object or hashref" |
303cf522 |
69 | ); |
70 | my $source = $self->result_source; |
71 | my $schema = $source->schema; |
72 | my $rel_source_name = $source->relationship_info($rel)->{source}; |
73 | my $rel_source = $schema->resultset($rel_source_name)->result_source; |
74 | my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source}; |
78060df8 |
75 | my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{}); |
76 | |
77 | my $obj; |
78 | if (ref $_[0]) { |
79 | if (ref $_[0] eq 'HASH') { |
80 | $obj = $f_rel_rs->create($_[0]); |
81 | } else { |
82 | $obj = $_[0]; |
83 | } |
84 | } else { |
85 | $obj = $f_rel_rs->create({@_}); |
86 | } |
87 | |
3bd6e3e0 |
88 | my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
6cc5b382 |
89 | my $link = $self->search_related($rel)->new_result($link_vals); |
303cf522 |
90 | $link->set_from_related($f_rel, $obj); |
91 | $link->insert(); |
716c16a0 |
92 | return $obj; |
4b3ab474 |
93 | }; |
94 | |
ddc0a6c8 |
95 | my $set_meth_name = join '::', $class, $set_meth; |
96 | *$set_meth_name = Sub::Name::subname $set_meth_name, sub { |
b3f358b5 |
97 | my $self = shift; |
98 | @_ > 0 or $self->throw_exception( |
99 | "{$set_meth} needs a list of objects or hashrefs" |
100 | ); |
f72f9361 |
101 | my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); |
b3f358b5 |
102 | $self->search_related($rel, {})->delete; |
f72f9361 |
103 | $self->$add_meth($_) for (@to_set); |
b3f358b5 |
104 | }; |
105 | |
ddc0a6c8 |
106 | my $remove_meth_name = join '::', $class, $remove_meth; |
107 | *$remove_meth_name = Sub::Name::subname $remove_meth_name, sub { |
303cf522 |
108 | my $self = shift; |
109 | @_ > 0 && ref $_[0] ne 'HASH' |
b3f358b5 |
110 | or $self->throw_exception("${remove_meth} needs an object"); |
303cf522 |
111 | my $obj = shift; |
112 | my $rel_source = $self->search_related($rel)->result_source; |
113 | my $cond = $rel_source->relationship_info($f_rel)->{cond}; |
114 | my $link_cond = $rel_source->resolve_condition( |
115 | $cond, $obj, $f_rel |
116 | ); |
117 | $self->search_related($rel, $link_cond)->delete; |
4b3ab474 |
118 | }; |
119 | |
8973b6f1 |
120 | } |
121 | } |
122 | |
123 | 1; |