line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::IntrospectableM2M; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
4009
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
5
|
1
|
|
|
1
|
|
12
|
use base 'DBIx::Class'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
204
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.001002'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
#namespace pollution. sadface. |
10
|
|
|
|
|
|
|
__PACKAGE__->mk_classdata( _m2m_metadata => {} ); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub many_to_many { |
13
|
2
|
|
|
2
|
1
|
2463
|
my $class = shift; |
14
|
2
|
|
|
|
|
4
|
my ($meth_name, $link, $far_side) = @_; |
15
|
2
|
|
|
|
|
43
|
my $store = $class->_m2m_metadata; |
16
|
|
|
|
|
|
|
warn("You are overwritting another relationship's metadata") |
17
|
2
|
50
|
|
|
|
64
|
if exists $store->{$meth_name}; |
18
|
|
|
|
|
|
|
|
19
|
2
|
50
|
|
|
|
14
|
my $attrs = { |
20
|
|
|
|
|
|
|
accessor => $meth_name, |
21
|
|
|
|
|
|
|
relation => $link, #"link" table or immediate relation |
22
|
|
|
|
|
|
|
foreign_relation => $far_side, #'far' table or foreign relation |
23
|
|
|
|
|
|
|
(@_ > 3 ? (attrs => $_[3]) : ()), #only store if exist |
24
|
|
|
|
|
|
|
rs_method => "${meth_name}_rs", #for completeness.. |
25
|
|
|
|
|
|
|
add_method => "add_to_${meth_name}", |
26
|
|
|
|
|
|
|
set_method => "set_${meth_name}", |
27
|
|
|
|
|
|
|
remove_method => "remove_from_${meth_name}", |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#inheritable data workaround |
31
|
2
|
|
|
|
|
36
|
$class->_m2m_metadata({ $meth_name => $attrs, %$store}); |
32
|
2
|
|
|
|
|
26
|
$class->next::method(@_); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
1; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
__END__; |