line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package # hide from PAUSE |
2
|
|
|
|
|
|
|
DBIx::Class::Relationship::ManyToMany; |
3
|
|
|
|
|
|
|
|
4
|
379
|
|
|
379
|
|
182323
|
use strict; |
|
379
|
|
|
|
|
2153
|
|
|
379
|
|
|
|
|
11409
|
|
5
|
379
|
|
|
379
|
|
2182
|
use warnings; |
|
379
|
|
|
|
|
1137
|
|
|
379
|
|
|
|
|
9730
|
|
6
|
|
|
|
|
|
|
|
7
|
379
|
|
|
379
|
|
2129
|
use DBIx::Class::Carp; |
|
379
|
|
|
|
|
1098
|
|
|
379
|
|
|
|
|
2490
|
|
8
|
379
|
|
|
379
|
|
2570
|
use Sub::Name 'subname'; |
|
379
|
|
|
|
|
1139
|
|
|
379
|
|
|
|
|
21900
|
|
9
|
379
|
|
|
379
|
|
2759
|
use Scalar::Util 'blessed'; |
|
379
|
|
|
|
|
1257
|
|
|
379
|
|
|
|
|
22935
|
|
10
|
379
|
|
|
379
|
|
2943
|
use DBIx::Class::_Util 'fail_on_internal_wantarray'; |
|
379
|
|
|
|
|
1193
|
|
|
379
|
|
|
|
|
22448
|
|
11
|
379
|
|
|
379
|
|
2841
|
use namespace::clean; |
|
379
|
|
|
|
|
1257
|
|
|
379
|
|
|
|
|
2830
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our %_pod_inherit_config = |
14
|
|
|
|
|
|
|
( |
15
|
|
|
|
|
|
|
class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' } |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub many_to_many { |
19
|
4602
|
|
|
4602
|
0
|
49523
|
my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; |
20
|
|
|
|
|
|
|
|
21
|
4602
|
50
|
|
|
|
15006
|
$class->throw_exception( |
22
|
|
|
|
|
|
|
"missing relation in many-to-many" |
23
|
|
|
|
|
|
|
) unless $rel; |
24
|
|
|
|
|
|
|
|
25
|
4602
|
50
|
|
|
|
11097
|
$class->throw_exception( |
26
|
|
|
|
|
|
|
"missing foreign relation in many-to-many" |
27
|
|
|
|
|
|
|
) unless $f_rel; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
{ |
30
|
379
|
|
|
379
|
|
130771
|
no strict 'refs'; |
|
379
|
|
|
|
|
1447
|
|
|
379
|
|
|
|
|
14762
|
|
|
4602
|
|
|
|
|
8175
|
|
31
|
379
|
|
|
379
|
|
2592
|
no warnings 'redefine'; |
|
379
|
|
|
|
|
1328
|
|
|
379
|
|
|
|
|
405396
|
|
32
|
|
|
|
|
|
|
|
33
|
4602
|
|
|
|
|
14168
|
my $add_meth = "add_to_${meth}"; |
34
|
4602
|
|
|
|
|
11643
|
my $remove_meth = "remove_from_${meth}"; |
35
|
4602
|
|
|
|
|
10859
|
my $set_meth = "set_${meth}"; |
36
|
4602
|
|
|
|
|
10840
|
my $rs_meth = "${meth}_rs"; |
37
|
|
|
|
|
|
|
|
38
|
4602
|
|
|
|
|
11800
|
for ($add_meth, $remove_meth, $set_meth, $rs_meth) { |
39
|
18408
|
100
|
|
|
|
197635
|
if ( $class->can ($_) ) { |
40
|
2
|
100
|
|
|
|
14
|
carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK}; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
*************************************************************************** |
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. |
47
|
|
|
|
|
|
|
|
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. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
To disable this warning set to a true value the environment variable |
53
|
|
|
|
|
|
|
DBIC_OVERWRITE_HELPER_METHODS_OK |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
*************************************************************************** |
56
|
|
|
|
|
|
|
EOW |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
4602
|
|
33
|
|
|
30521
|
$rel_attrs->{alias} ||= $f_rel; |
61
|
|
|
|
|
|
|
|
62
|
4602
|
|
|
|
|
13087
|
my $rs_meth_name = join '::', $class, $rs_meth; |
63
|
|
|
|
|
|
|
*$rs_meth_name = subname $rs_meth_name, sub { |
64
|
40
|
|
|
40
|
|
101
|
my $self = shift; |
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
45
|
|
|
|
65
|
40
|
100
|
66
|
|
|
226
|
my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
66
|
|
|
|
|
|
|
my $rs = $self->search_related($rel)->search_related( |
67
|
40
|
100
|
|
|
|
316
|
$f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } |
|
40
|
50
|
|
|
|
358
|
|
68
|
|
|
|
|
|
|
); |
69
|
40
|
|
|
|
|
208
|
return $rs; |
70
|
4602
|
|
|
|
|
55145
|
}; |
71
|
|
|
|
|
|
|
|
72
|
4602
|
|
|
|
|
15448
|
my $meth_name = join '::', $class, $meth; |
73
|
|
|
|
|
|
|
*$meth_name = subname $meth_name, sub { |
74
|
40
|
|
|
40
|
|
1467
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray; |
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
75
|
40
|
|
|
|
|
103
|
my $self = shift; |
76
|
40
|
|
|
|
|
478
|
my $rs = $self->$rs_meth( @_ ); |
77
|
40
|
100
|
|
|
|
403
|
return (wantarray ? $rs->all : $rs); |
78
|
4602
|
|
|
|
|
48871
|
}; |
79
|
|
|
|
|
|
|
|
80
|
4602
|
|
|
|
|
15420
|
my $add_meth_name = join '::', $class, $add_meth; |
81
|
|
|
|
|
|
|
*$add_meth_name = subname $add_meth_name, sub { |
82
|
28
|
|
|
68
|
|
1015
|
my $self = shift; |
83
|
28
|
100
|
|
|
|
106
|
@_ > 0 or $self->throw_exception( |
84
|
|
|
|
|
|
|
"${add_meth} needs an object or hashref" |
85
|
|
|
|
|
|
|
); |
86
|
27
|
|
|
|
|
126
|
my $source = $self->result_source; |
87
|
27
|
|
|
|
|
107
|
my $schema = $source->schema; |
88
|
27
|
|
|
|
|
108
|
my $rel_source_name = $source->relationship_info($rel)->{source}; |
89
|
27
|
|
|
|
|
113
|
my $rel_source = $schema->resultset($rel_source_name)->result_source; |
90
|
27
|
|
|
|
|
117
|
my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source}; |
91
|
27
|
|
50
|
|
|
98
|
my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{}); |
92
|
|
|
|
|
|
|
|
93
|
27
|
|
|
|
|
122
|
my $obj; |
94
|
27
|
50
|
|
|
|
99
|
if (ref $_[0]) { |
95
|
27
|
100
|
|
|
|
96
|
if (ref $_[0] eq 'HASH') { |
96
|
6
|
|
|
|
|
46
|
$obj = $f_rel_rs->find_or_create($_[0]); |
97
|
|
|
|
|
|
|
} else { |
98
|
21
|
|
|
|
|
42
|
$obj = $_[0]; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} else { |
101
|
0
|
|
|
|
|
0
|
$obj = $f_rel_rs->find_or_create({@_}); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
27
|
100
|
100
|
|
|
163
|
my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; |
105
|
27
|
|
|
|
|
150
|
my $link = $self->search_related($rel)->new_result($link_vals); |
106
|
27
|
|
|
|
|
126
|
$link->set_from_related($f_rel, $obj); |
107
|
27
|
|
|
|
|
155
|
$link->insert(); |
108
|
27
|
|
|
|
|
167
|
return $obj; |
109
|
4602
|
|
|
|
|
59890
|
}; |
110
|
|
|
|
|
|
|
|
111
|
4602
|
|
|
|
|
15444
|
my $set_meth_name = join '::', $class, $set_meth; |
112
|
|
|
|
|
|
|
*$set_meth_name = subname $set_meth_name, sub { |
113
|
6
|
|
|
74
|
|
28
|
my $self = shift; |
114
|
6
|
50
|
|
|
|
24
|
@_ > 0 or $self->throw_exception( |
115
|
|
|
|
|
|
|
"{$set_meth} needs a list of objects or hashrefs" |
116
|
|
|
|
|
|
|
); |
117
|
6
|
100
|
|
|
|
31
|
my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); |
|
4
|
|
|
|
|
16
|
|
118
|
|
|
|
|
|
|
# if there is a where clause in the attributes, ensure we only delete |
119
|
|
|
|
|
|
|
# rows that are within the where restriction |
120
|
6
|
100
|
66
|
|
|
46
|
if ($rel_attrs && $rel_attrs->{where}) { |
121
|
1
|
|
|
|
|
8
|
$self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete; |
122
|
|
|
|
|
|
|
} else { |
123
|
5
|
|
|
|
|
28
|
$self->search_related( $rel, {} )->delete; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
# add in the set rel objects |
126
|
6
|
100
|
|
|
|
28
|
$self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set); |
127
|
4602
|
|
|
|
|
44308
|
}; |
128
|
|
|
|
|
|
|
|
129
|
4602
|
|
|
|
|
15021
|
my $remove_meth_name = join '::', $class, $remove_meth; |
130
|
|
|
|
|
|
|
*$remove_meth_name = subname $remove_meth_name, sub { |
131
|
5
|
|
|
79
|
|
682
|
my ($self, $obj) = @_; |
132
|
5
|
100
|
|
|
|
69
|
$self->throw_exception("${remove_meth} needs an object") |
133
|
|
|
|
|
|
|
unless blessed ($obj); |
134
|
4
|
|
|
|
|
22
|
my $rel_source = $self->search_related($rel)->result_source; |
135
|
4
|
|
|
|
|
19
|
my $cond = $rel_source->relationship_info($f_rel)->{cond}; |
136
|
4
|
|
|
|
|
22
|
my ($link_cond, $crosstable) = $rel_source->_resolve_condition( |
137
|
|
|
|
|
|
|
$cond, $obj, $f_rel, $f_rel |
138
|
|
|
|
|
|
|
); |
139
|
|
|
|
|
|
|
|
140
|
4
|
50
|
|
|
|
15
|
$self->throw_exception( |
141
|
|
|
|
|
|
|
"Relationship '$rel' does not resolve to a join-free condition, " |
142
|
|
|
|
|
|
|
."unable to use with the ManyToMany helper '$f_rel'" |
143
|
|
|
|
|
|
|
) if $crosstable; |
144
|
|
|
|
|
|
|
|
145
|
4
|
|
|
|
|
22
|
$self->search_related($rel, $link_cond)->delete; |
146
|
4602
|
|
|
|
|
59374
|
}; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
1; |