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