package
DBIx::Class::Relationship::ProxyMethods;
our
%_pod_inherit_config
=
(
class_map
=> {
'DBIx::Class::Relationship::ProxyMethods'
=>
'DBIx::Class::Relationship'
}
);
sub
register_relationship {
my
(
$class
,
$rel
,
$info
) =
@_
;
if
(
my
$proxy_args
=
$info
->{attrs}{proxy}) {
$class
->proxy_to_related(
$rel
,
$proxy_args
);
}
$class
->
next
::method(
$rel
,
$info
);
}
sub
proxy_to_related {
my
(
$class
,
$rel
,
$proxy_args
) =
@_
;
my
%proxy_map
=
$class
->_build_proxy_map_from(
$proxy_args
);
quote_sub
"${class}::$_"
,
sprintf
(
<<'EOC', $rel, $proxy_map{$_} )
my $self = shift;
my $relobj = $self->%1$s;
if (@_ && !defined $relobj) {
$relobj = $self->create_related( %1$s => { %2$s => $_[0] } );
@_ = ();
}
$relobj ? $relobj->%2$s(@_) : undef;
EOC
for
keys
%proxy_map
}
sub
_build_proxy_map_from {
my
(
$class
,
$proxy_arg
) =
@_
;
my
$ref
=
ref
$proxy_arg
;
if
(
$ref
eq
'HASH'
) {
return
%$proxy_arg
;
}
elsif
(
$ref
eq
'ARRAY'
) {
return
map
{
(
ref
$_
eq
'HASH'
)
? (
%$_
)
: (
$_
=>
$_
)
}
@$proxy_arg
;
}
elsif
(
$ref
) {
$class
->throw_exception(
"Unable to process the 'proxy' argument $proxy_arg"
);
}
else
{
return
(
$proxy_arg
=>
$proxy_arg
);
}
}
1;