-package DBIx::Class::Relationship::ProxyMethods;
+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;
-use base qw/DBIx::Class/;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
+ );
-sub add_relationship {
- my ($class, $rel, @rest) = @_;
- my $ret = $class->next::method($rel => @rest);
- if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
- $class->proxy_to_related($rel,
- (ref $proxy_list ? @$proxy_list : $proxy_list));
+sub register_relationship {
+ my ($class, $rel, $info) = @_;
+ if (my $proxy_args = $info->{attrs}{proxy}) {
+ $class->proxy_to_related($rel, $proxy_args);
}
- return $ret;
+ $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);
- }
+ 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 );
}
}