X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FProxyMethods.pm;h=6f204f61740df9ea5144c70734d5da967a12001c;hb=705f18f4b19e84e16282547f91e2294e9630382c;hp=ede62a7e00952f76370da77aaa1daf4e0c60a5e0;hpb=b28cc0ba2d1d443728c9cb48d97e5a2cdccf8cb4;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index ede62a7..6f204f6 100644
--- a/lib/DBIx/Class/Relationship/ProxyMethods.pm
+++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm
@@ -1,30 +1,64 @@
-package DBIx::Class::Relationship::ProxyMethods;
+package # hide from PAUSE
+    DBIx::Class::Relationship::ProxyMethods;
 
 use strict;
 use warnings;
+use Sub::Name ();
+use base qw/DBIx::Class/;
 
-use base qw/Class::Data::Inheritable/;
+our %_pod_inherit_config =
+  (
+   class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
+  );
 
-sub add_relationship {
-  my ($class, $rel, @rest) = @_;
-  my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
-  if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
-    no strict 'refs';
-    no warnings 'redefine';
-    foreach my $proxy (ref $proxy_list ? @$proxy_list : $proxy_list) {
-      *{"${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);
-       }
-    }
+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 );
   }
-  return $ret;
 }
 
 1;