package # hide from PAUSE DBIx::Class::Relationship::ProxyMethods; use strict; use warnings; use Sub::Name (); use base qw/DBIx::Class/; 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); no strict 'refs'; no warnings 'redefine'; foreach my $meth_name ( keys %proxy_map ) { my $proxy_to_col = $proxy_map{$meth_name}; my $name = join '::', $class, $meth_name; *$name = Sub::Name::subname $name => sub { my $self = shift; my $relobj = $self->$rel; if (@_ && !defined $relobj) { $relobj = $self->create_related($rel, { $proxy_to_col => $_[0] }); @_ = (); } return ($relobj ? $relobj->$proxy_to_col(@_) : undef); } } } 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;