62 lines
1.4 KiB
Perl
62 lines
1.4 KiB
Perl
package # hide from PAUSE
|
|
DBIx::Class::Relationship::ProxyMethods;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use base 'DBIx::Class';
|
|
use DBIx::Class::_Util 'quote_sub';
|
|
use namespace::clean;
|
|
|
|
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;
|