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}) { |
223b8fe3 |
12 | $class->proxy_to_related($rel, |
13 | (ref $proxy_list ? @$proxy_list : $proxy_list)); |
b28cc0ba |
14 | } |
15 | return $ret; |
16 | } |
17 | |
223b8fe3 |
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 | |
b28cc0ba |
36 | 1; |