1package # hide from PAUSE 2 DBIx::Class::Relationship::ProxyMethods; 3 4use strict; 5use warnings; 6use Sub::Name (); 7use base qw/DBIx::Class/; 8 9our %_pod_inherit_config = 10 ( 11 class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' } 12 ); 13 14sub register_relationship { 15 my ($class, $rel, $info) = @_; 16 if (my $proxy_list = $info->{attrs}{proxy}) { 17 $class->proxy_to_related($rel, 18 (ref $proxy_list ? @$proxy_list : $proxy_list)); 19 } 20 $class->next::method($rel, $info); 21} 22 23sub proxy_to_related { 24 my ($class, $rel, @proxy) = @_; 25 no strict 'refs'; 26 no warnings 'redefine'; 27 foreach my $proxy (@proxy) { 28 my $name = join '::', $class, $proxy; 29 *$name = Sub::Name::subname $name, 30 sub { 31 my $self = shift; 32 my $val = $self->$rel; 33 if (@_ && !defined $val) { 34 $val = $self->create_related($rel, { $proxy => $_[0] }); 35 @_ = (); 36 } 37 return ($val ? $val->$proxy(@_) : undef); 38 } 39 } 40} 41 421; 43