X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FProxyMethods.pm;h=ee49fe8f848a8dff1df9de7eab4f0072fbead13d;hb=HEAD;hp=5f7578ae76244fafe906d873208e4cf116535523;hpb=32cff863db45d7f965a7587929a5db56dfb4ef75;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm index 5f7578a..ee49fe8 100644 --- a/lib/DBIx/Class/Relationship/ProxyMethods.pm +++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm @@ -3,10 +3,11 @@ package # hide from PAUSE use strict; use warnings; -use Sub::Name (); -use base qw/DBIx::Class/; +use base 'DBIx::Class'; +use DBIx::Class::_Util 'quote_sub'; +use namespace::clean; -our %_pod_inherit_config = +our %_pod_inherit_config = ( class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' } ); @@ -22,21 +23,24 @@ sub register_relationship { 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); - } - } + + my @qsub_args = ( {}, { + attributes => [qw( + DBIC_method_is_proxy_to_relationship + DBIC_method_is_generated_from_resultsource_metadata + )], + } ); + + quote_sub "${class}::$_", sprintf( <<'EOC', $rel, $proxy_map{$_} ), @qsub_args + my $self = shift; + my $relobj = $self->%1$s; + if (@_ && !defined $relobj) { + $relobj = $self->create_related( q{%1$s} => { %2$s => $_[0] } ); + @_ = (); + } + $relobj ? $relobj->%2$s(@_) : undef; +EOC + for keys %proxy_map } sub _build_proxy_map_from {