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