X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FProxyMethods.pm;h=ee49fe8f848a8dff1df9de7eab4f0072fbead13d;hb=09d8fb4a05e6cd025924cc08e41484f17a116695;hp=9623539a57441be76478996b50af870e1bdeb074;hpb=97c96475ed1bdd955ba0e6c4f22087ca05c64162;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index 9623539..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,22 +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 = $proxy_map{$meth_name};
-    my $name = join '::', $class, $meth_name;
-    *$name = Sub::Name::subname $name,
-      sub {
-        my $self = shift;
-        my $val = $self->$rel;
-        if (@_ && !defined $val) {
-          $val = $self->create_related($rel, { $proxy_to => $_[0] });
-          @_ = ();
-        }
-        return ($val ? $val->$proxy_to(@_) : 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 {