Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::Relationship::ManyToMany; |
8973b6f1 |
3 | |
4 | use strict; |
5 | use warnings; |
b234e9d9 |
6 | |
70c28808 |
7 | use DBIx::Class::Carp; |
8f4b5c08 |
8 | use Sub::Name qw/subname/; |
9 | use Scalar::Util qw/blessed/; |
8973b6f1 |
10 | |
8f4b5c08 |
11 | use namespace::clean; |
12 | |
13 | our %_pod_inherit_config = |
044e70c7 |
14 | ( |
15 | class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' } |
16 | ); |
17 | |
8973b6f1 |
18 | sub many_to_many { |
78af1010 |
19 | my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; |
d0ed3b55 |
20 | |
21 | $class->throw_exception( |
22 | "missing relation in many-to-many" |
23 | ) unless $rel; |
24 | |
25 | $class->throw_exception( |
26 | "missing foreign relation in many-to-many" |
27 | ) unless $f_rel; |
28 | |
8973b6f1 |
29 | { |
30 | no strict 'refs'; |
31 | no warnings 'redefine'; |
4b3ab474 |
32 | |
b3f358b5 |
33 | my $add_meth = "add_to_${meth}"; |
34 | my $remove_meth = "remove_from_${meth}"; |
35 | my $set_meth = "set_${meth}"; |
18788bf2 |
36 | my $rs_meth = "${meth}_rs"; |
303cf522 |
37 | |
35210a5d |
38 | for ($add_meth, $remove_meth, $set_meth, $rs_meth) { |
d81b2771 |
39 | if ( $class->can ($_) ) { |
b7d1831a |
40 | carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK}; |
b234e9d9 |
41 | |
35678f0b |
42 | *************************************************************************** |
b234e9d9 |
43 | The many-to-many relationship '$meth' is trying to create a utility method |
44 | called $_. |
45 | This will completely overwrite one such already existing method on class |
46 | $class. |
d81b2771 |
47 | |
b234e9d9 |
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 |
50 | accessible anymore. |
d81b2771 |
51 | |
b7d1831a |
52 | To disable this warning set to a true value the environment variable |
53 | DBIC_OVERWRITE_HELPER_METHODS_OK |
35678f0b |
54 | |
35678f0b |
55 | *************************************************************************** |
56 | EOW |
d81b2771 |
57 | } |
35210a5d |
58 | } |
59 | |
7141bdfc |
60 | $rel_attrs->{alias} ||= $f_rel; |
61 | |
ddc0a6c8 |
62 | my $rs_meth_name = join '::', $class, $rs_meth; |
8f4b5c08 |
63 | *$rs_meth_name = subname $rs_meth_name, sub { |
0f6ac8bb |
64 | my $self = shift; |
65 | my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
78060df8 |
66 | my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }); |
18788bf2 |
67 | my $rs = $self->search_related($rel)->search_related( |
3a868fb2 |
68 | $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } |
69 | ); |
d7a58a29 |
70 | return $rs; |
78af1010 |
71 | }; |
4b3ab474 |
72 | |
ddc0a6c8 |
73 | my $meth_name = join '::', $class, $meth; |
8f4b5c08 |
74 | *$meth_name = subname $meth_name, sub { |
d7a58a29 |
75 | my $self = shift; |
76 | my $rs = $self->$rs_meth( @_ ); |
77 | return (wantarray ? $rs->all : $rs); |
78 | }; |
18788bf2 |
79 | |
ddc0a6c8 |
80 | my $add_meth_name = join '::', $class, $add_meth; |
8f4b5c08 |
81 | *$add_meth_name = subname $add_meth_name, sub { |
303cf522 |
82 | my $self = shift; |
83 | @_ > 0 or $self->throw_exception( |
b3f358b5 |
84 | "${add_meth} needs an object or hashref" |
303cf522 |
85 | ); |
86 | my $source = $self->result_source; |
87 | my $schema = $source->schema; |
88 | my $rel_source_name = $source->relationship_info($rel)->{source}; |
89 | my $rel_source = $schema->resultset($rel_source_name)->result_source; |
90 | my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source}; |
78060df8 |
91 | my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{}); |
92 | |
93 | my $obj; |
94 | if (ref $_[0]) { |
95 | if (ref $_[0] eq 'HASH') { |
577ef680 |
96 | $obj = $f_rel_rs->find_or_create($_[0]); |
78060df8 |
97 | } else { |
98 | $obj = $_[0]; |
99 | } |
100 | } else { |
577ef680 |
101 | $obj = $f_rel_rs->find_or_create({@_}); |
78060df8 |
102 | } |
103 | |
3bd6e3e0 |
104 | my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
6cc5b382 |
105 | my $link = $self->search_related($rel)->new_result($link_vals); |
303cf522 |
106 | $link->set_from_related($f_rel, $obj); |
107 | $link->insert(); |
d7a58a29 |
108 | return $obj; |
4b3ab474 |
109 | }; |
110 | |
ddc0a6c8 |
111 | my $set_meth_name = join '::', $class, $set_meth; |
8f4b5c08 |
112 | *$set_meth_name = subname $set_meth_name, sub { |
b3f358b5 |
113 | my $self = shift; |
114 | @_ > 0 or $self->throw_exception( |
115 | "{$set_meth} needs a list of objects or hashrefs" |
116 | ); |
f72f9361 |
117 | my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); |
f1f9ee17 |
118 | # if there is a where clause in the attributes, ensure we only delete |
119 | # rows that are within the where restriction |
120 | if ($rel_attrs && $rel_attrs->{where}) { |
121 | $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete; |
122 | } else { |
123 | $self->search_related( $rel, {} )->delete; |
124 | } |
125 | # add in the set rel objects |
ac36a402 |
126 | $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set); |
b3f358b5 |
127 | }; |
128 | |
ddc0a6c8 |
129 | my $remove_meth_name = join '::', $class, $remove_meth; |
8f4b5c08 |
130 | *$remove_meth_name = subname $remove_meth_name, sub { |
131 | my ($self, $obj) = @_; |
132 | $self->throw_exception("${remove_meth} needs an object") |
133 | unless blessed ($obj); |
303cf522 |
134 | my $rel_source = $self->search_related($rel)->result_source; |
135 | my $cond = $rel_source->relationship_info($f_rel)->{cond}; |
6d0ee587 |
136 | my $link_cond = $rel_source->_resolve_condition( |
303cf522 |
137 | $cond, $obj, $f_rel |
138 | ); |
139 | $self->search_related($rel, $link_cond)->delete; |
4b3ab474 |
140 | }; |
141 | |
8973b6f1 |
142 | } |
143 | } |
144 | |
145 | 1; |