- Storage/DBI.pm now uses Abstract internally

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / ProxyMethods.pm

diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index ede62a7..11a4e28 100644 (file)
--- a/lib/DBIx/Class/Relationship/ProxyMethods.pm
+++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm
@@ -9,22 +9,28 @@ 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);
-       }
-    }
+    $class->proxy_to_related($rel,
+              (ref $proxy_list ? @$proxy_list : $proxy_list));
   }
   return $ret;
 }
 
+sub proxy_to_related {
+  my ($class, $rel, @proxy) = @_;
+  no strict 'refs';
+  no warnings 'redefine';
+  foreach my $proxy (@proxy) {
+    *{"${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);
+     }
+  }
+}
+
 1;