Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::Relationship::Accessor; |
4a07648a |
3 | |
4 | use strict; |
5 | use warnings; |
ddc0a6c8 |
6 | use Sub::Name (); |
7 | use Class::Inspector (); |
4a07648a |
8 | |
71e65b39 |
9 | sub register_relationship { |
10 | my ($class, $rel, $info) = @_; |
11 | if (my $acc_type = $info->{attrs}{accessor}) { |
223b8fe3 |
12 | $class->add_relationship_accessor($rel => $acc_type); |
4a07648a |
13 | } |
71e65b39 |
14 | $class->next::method($rel => $info); |
4a07648a |
15 | } |
16 | |
223b8fe3 |
17 | sub add_relationship_accessor { |
4a07648a |
18 | my ($class, $rel, $acc_type) = @_; |
19 | my %meth; |
20 | if ($acc_type eq 'single') { |
7a7e8718 |
21 | my $rel_info = $class->relationship_info($rel); |
4a07648a |
22 | $meth{$rel} = sub { |
23 | my $self = shift; |
24 | if (@_) { |
25 | $self->set_from_related($rel, @_); |
26 | return $self->{_relationship_data}{$rel} = $_[0]; |
27 | } elsif (exists $self->{_relationship_data}{$rel}) { |
28 | return $self->{_relationship_data}{$rel}; |
29 | } else { |
84a1c93f |
30 | my $cond = $self->result_source->resolve_condition( |
7a7e8718 |
31 | $rel_info->{cond}, $rel, $self |
84a1c93f |
32 | ); |
7a7e8718 |
33 | if ($rel_info->{attrs}->{undef_on_null_fk}){ |
e0d8aec0 |
34 | return undef unless ref($cond) eq 'HASH'; |
35 | return undef if grep { not defined $_ } values %$cond; |
7a7e8718 |
36 | } |
1a14aa3f |
37 | my $val = $self->find_related($rel, {}, {}); |
e0d8aec0 |
38 | return $val unless $val; # $val instead of undef so that null-objects can go through |
cde1c1e1 |
39 | |
b28cc0ba |
40 | return $self->{_relationship_data}{$rel} = $val; |
4a07648a |
41 | } |
42 | }; |
43 | } elsif ($acc_type eq 'filter') { |
701da8c4 |
44 | $class->throw_exception("No such column $rel to filter") |
103647d5 |
45 | unless $class->has_column($rel); |
4685e006 |
46 | my $f_class = $class->relationship_info($rel)->{class}; |
4a07648a |
47 | $class->inflate_column($rel, |
48 | { inflate => sub { |
49 | my ($val, $self) = @_; |
e60dc79f |
50 | return $self->find_or_new_related($rel, {}, {}); |
4a07648a |
51 | }, |
52 | deflate => sub { |
53 | my ($val, $self) = @_; |
701da8c4 |
54 | $self->throw_exception("$val isn't a $f_class") unless $val->isa($f_class); |
4a07648a |
55 | return ($val->_ident_values)[0]; |
56 | # WARNING: probably breaks for multi-pri sometimes. FIXME |
57 | } |
58 | } |
59 | ); |
60 | } elsif ($acc_type eq 'multi') { |
61 | $meth{$rel} = sub { shift->search_related($rel, @_) }; |
5b89a768 |
62 | $meth{"${rel}_rs"} = sub { shift->search_related_rs($rel, @_) }; |
4a07648a |
63 | $meth{"add_to_${rel}"} = sub { shift->create_related($rel, @_); }; |
64 | } else { |
701da8c4 |
65 | $class->throw_exception("No such relationship accessor type $acc_type"); |
4a07648a |
66 | } |
67 | { |
68 | no strict 'refs'; |
69 | no warnings 'redefine'; |
70 | foreach my $meth (keys %meth) { |
ddc0a6c8 |
71 | my $name = join '::', $class, $meth; |
72 | *$name = Sub::Name::subname($name, $meth{$meth}); |
4a07648a |
73 | } |
74 | } |
75 | } |
76 | |
77 | 1; |