Clarification cascade_* attribute defaults documentation
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Relationship / ProxyMethods.pm
CommitLineData
75d07914 1package # hide from PAUSE
c0e7b4e5 2 DBIx::Class::Relationship::ProxyMethods;
b28cc0ba 3
4use strict;
5use warnings;
ddc0a6c8 6use Sub::Name ();
1edd1722 7use base qw/DBIx::Class/;
b28cc0ba 8
044e70c7 9our %_pod_inherit_config =
10 (
11 class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
12 );
13
71e65b39 14sub register_relationship {
15 my ($class, $rel, $info) = @_;
16 if (my $proxy_list = $info->{attrs}{proxy}) {
223b8fe3 17 $class->proxy_to_related($rel,
18 (ref $proxy_list ? @$proxy_list : $proxy_list));
b28cc0ba 19 }
71e65b39 20 $class->next::method($rel, $info);
b28cc0ba 21}
22
223b8fe3 23sub proxy_to_related {
24 my ($class, $rel, @proxy) = @_;
25 no strict 'refs';
26 no warnings 'redefine';
27 foreach my $proxy (@proxy) {
ddc0a6c8 28 my $name = join '::', $class, $proxy;
29 *$name = Sub::Name::subname $name,
223b8fe3 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
b28cc0ba 421;