lib/DBIx/Class/Relationship/ProxyMethods.pm

   1 package # hide from PAUSE
   2     DBIx::Class::Relationship::ProxyMethods;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base qw/DBIx::Class/;
   8
   9 sub register_relationship {
  10   my ($class, $rel, $info) = @_;
  11   if (my $proxy_list = $info->{attrs}{proxy}) {
  12     $class->proxy_to_related($rel,
  13               (ref $proxy_list ? @$proxy_list : $proxy_list));
  14   }
  15   $class->next::method($rel, $info);
  16 }
  17
  18 sub proxy_to_related {
  19   my ($class, $rel, @proxy) = @_;
  20   no strict 'refs';
  21   no warnings 'redefine';
  22   foreach my $proxy (@proxy) {
  23     *{"${class}::${proxy}"} =
  24       sub {
  25         my $self = shift;
  26         my $val = $self->$rel;
  27         if (@_ && !defined $val) {
  28           $val = $self->create_related($rel, { $proxy => $_[0] });
  29           @_ = ();
  30         }
  31         return ($val ? $val->$proxy(@_) : undef);
  32      }
  33   }
  34 }
  35
  36 1;