lib/DBIx/Class/Relationship/ProxyMethods.pm

   1 package DBIx::Class::Relationship::ProxyMethods;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Data::Inheritable/;
   7
   8 sub add_relationship {
   9   my ($class, $rel, @rest) = @_;
  10   my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
  11   if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
  12     no strict 'refs';
  13     no warnings 'redefine';
  14     foreach my $proxy (ref $proxy_list ? @$proxy_list : $proxy_list) {
  15       *{"${class}::${proxy}"} =
  16         sub {
  17           my $self = shift;
  18           my $val = $self->$rel;
  19           if (@_ && !defined $val) {
  20             $val = $self->create_related($rel, { $proxy => $_[0] });
  21             @_ = ();
  22           }
  23           return ($val ? $val->$proxy(@_) : undef);
  24        }
  25     }
  26   }
  27   return $ret;
  28 }
  29
  30 1;