Commit | Line | Data |
b28cc0ba |
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; |