package
DBIx::Class::Relationship::ProxyMethods;
sub
register_relationship {
my
(
$class
,
$rel
,
$info
) =
@_
;
if
(
my
$proxy_list
=
$info
->{attrs}{proxy}) {
$class
->proxy_to_related(
$rel
,
(
ref
$proxy_list
?
@$proxy_list
:
$proxy_list
));
}
$class
->
next
::method(
$rel
,
$info
);
}
sub
proxy_to_related {
my
(
$class
,
$rel
,
@proxy
) =
@_
;
no
strict
'refs'
;
no
warnings
'redefine'
;
foreach
my
$proxy
(
@proxy
) {
*{
"${class}::${proxy}"
} =
sub
{
my
$self
=
shift
;
my
$val
=
$self
->
$rel
;
if
(
@_
&& !
defined
$val
) {
$val
=
$self
->create_related(
$rel
, {
$proxy
=>
$_
[0] });
@_
= ();
}
return
(
$val
?
$val
->
$proxy
(
@_
) :
undef
);
}
}
}
1;