Minor documentation fix for find. Removed some EOL spacing
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / Accessor.pm
CommitLineData
4a07648a 1package DBIx::Class::Relationship::Accessor;
2
3use strict;
4use warnings;
5
71e65b39 6sub register_relationship {
7 my ($class, $rel, $info) = @_;
8 if (my $acc_type = $info->{attrs}{accessor}) {
223b8fe3 9 $class->add_relationship_accessor($rel => $acc_type);
4a07648a 10 }
71e65b39 11 $class->next::method($rel => $info);
4a07648a 12}
13
223b8fe3 14sub add_relationship_accessor {
4a07648a 15 my ($class, $rel, $acc_type) = @_;
16 my %meth;
17 if ($acc_type eq 'single') {
18 $meth{$rel} = sub {
19 my $self = shift;
20 if (@_) {
21 $self->set_from_related($rel, @_);
22 return $self->{_relationship_data}{$rel} = $_[0];
23 } elsif (exists $self->{_relationship_data}{$rel}) {
24 return $self->{_relationship_data}{$rel};
25 } else {
1a14aa3f 26 my $val = $self->find_related($rel, {}, {});
b28cc0ba 27 return unless $val;
28 return $self->{_relationship_data}{$rel} = $val;
4a07648a 29 }
30 };
31 } elsif ($acc_type eq 'filter') {
701da8c4 32 $class->throw_exception("No such column $rel to filter")
103647d5 33 unless $class->has_column($rel);
4685e006 34 my $f_class = $class->relationship_info($rel)->{class};
4a07648a 35 $class->inflate_column($rel,
36 { inflate => sub {
37 my ($val, $self) = @_;
38 return $self->find_or_create_related($rel, {}, {});
39 },
40 deflate => sub {
41 my ($val, $self) = @_;
fd9f5466 42 $self->throw_exception("$val isn't a $f_class")
43 unless $val->isa($self->result_source->schema->class($f_class));
4a07648a 44 return ($val->_ident_values)[0];
45 # WARNING: probably breaks for multi-pri sometimes. FIXME
46 }
47 }
48 );
49 } elsif ($acc_type eq 'multi') {
50 $meth{$rel} = sub { shift->search_related($rel, @_) };
51 $meth{"add_to_${rel}"} = sub { shift->create_related($rel, @_); };
52 } else {
701da8c4 53 $class->throw_exception("No such relationship accessor type $acc_type");
4a07648a 54 }
55 {
56 no strict 'refs';
57 no warnings 'redefine';
58 foreach my $meth (keys %meth) {
59 *{"${class}::${meth}"} = $meth{$meth};
60 }
61 }
62}
63
641;