Corrected columns_info_for indent level - 2 space indent everyone please, you may...
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / Base.pm
CommitLineData
55e2d745 1package DBIx::Class::Relationship::Base;
2
3use strict;
4use warnings;
5
1edd1722 6use base qw/DBIx::Class/;
55e2d745 7
8__PACKAGE__->mk_classdata('_relationships', { } );
9
10=head1 NAME
11
8918977e 12DBIx::Class::Relationship::Base - Inter-table relationships
55e2d745 13
14=head1 SYNOPSIS
15
16=head1 DESCRIPTION
17
18This class handles relationships between the tables in your database
19model. It allows your to set up relationships, and to perform joins
20on searches.
21
22=head1 METHODS
23
8091aa91 24=head2 add_relationship
503536d5 25
26 __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
27
28The condition needs to be an SQL::Abstract-style representation of the
8091aa91 29join between the tables. For example, if you're creating a rel from Foo to Bar,
503536d5 30
31 { 'foreign.foo_id' => 'self.id' }
32
8091aa91 33will result in the JOIN clause
503536d5 34
35 foo me JOIN bar bar ON bar.foo_id = me.id
36
8091aa91 37You can specify as many foreign => self mappings as necessary.
38
39Valid attributes are as follows:
40
41=over 4
42
43=item join_type
44
45Explicitly specifies the type of join to use in the relationship. Any SQL
46join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
47command immediately before C<JOIN>.
48
49=item proxy
50
51An arrayref containing a list of accessors in the foreign class to proxy in
52the main class. If, for example, you do the following:
53
fc69fea6 54 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/ ] });
8091aa91 55
56Then, assuming Bar has an accessor named margle, you can do:
57
58 my $obj = Foo->find(1);
59 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
60
61=item accessor
62
63Specifies the type of accessor that should be created for the relationship.
64Valid values are C<single> (for when there is only a single related object),
65C<multi> (when there can be many), and C<filter> (for when there is a single
66related object, but you also want the relationship accessor to double as
67a column accessor). For C<multi> accessors, an add_to_* method is also
68created, which calls C<create_related> for the relationship.
69
70=back
71
87c4e602 72=head2 register_relationship
73
74=head3 Arguments: ($relname, $rel_info)
71e65b39 75
76Registers a relationship on the class
77
55e2d745 78=cut
79
71e65b39 80sub register_relationship { }
81
8091aa91 82=head2 search_related
503536d5 83
84 My::Table->search_related('relname', $cond, $attrs);
85
86=cut
87
55e2d745 88sub search_related {
ff7bb7a1 89 return shift->related_resultset(shift)->search(@_);
b52e9bf8 90}
91
92=head2 count_related
93
7be93b07 94 $obj->count_related('relname', $cond, $attrs);
b52e9bf8 95
96=cut
97
98sub count_related {
99 my $self = shift;
100 return $self->search_related(@_)->count;
55e2d745 101}
102
8091aa91 103=head2 create_related
503536d5 104
105 My::Table->create_related('relname', \%col_data);
106
107=cut
108
55e2d745 109sub create_related {
3842b955 110 my $self = shift;
fea3d045 111 my $rel = shift;
64acc2bc 112 my $obj = $self->search_related($rel)->create(@_);
113 delete $self->{related_resultsets}->{$rel};
114 return $obj;
55e2d745 115}
116
8091aa91 117=head2 new_related
503536d5 118
119 My::Table->new_related('relname', \%col_data);
120
121=cut
122
55e2d745 123sub new_related {
124 my ($self, $rel, $values, $attrs) = @_;
fea3d045 125 return $self->search_related($rel)->new($values, $attrs);
55e2d745 126}
127
8091aa91 128=head2 find_related
503536d5 129
130 My::Table->find_related('relname', @pri_vals | \%pri_vals);
131
132=cut
133
1a14aa3f 134sub find_related {
135 my $self = shift;
136 my $rel = shift;
716b3d29 137 return $self->search_related($rel)->find(@_);
1a14aa3f 138}
139
8091aa91 140=head2 find_or_create_related
503536d5 141
142 My::Table->find_or_create_related('relname', \%col_data);
143
144=cut
145
55e2d745 146sub find_or_create_related {
147 my $self = shift;
1a14aa3f 148 return $self->find_related(@_) || $self->create_related(@_);
55e2d745 149}
150
8091aa91 151=head2 set_from_related
503536d5 152
153 My::Table->set_from_related('relname', $rel_obj);
154
155=cut
156
55e2d745 157sub set_from_related {
158 my ($self, $rel, $f_obj) = @_;
4685e006 159 my $rel_obj = $self->relationship_info($rel);
701da8c4 160 $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
55e2d745 161 my $cond = $rel_obj->{cond};
701da8c4 162 $self->throw_exception( "set_from_related can only handle a hash condition; the "
55e2d745 163 ."condition for $rel is of type ".(ref $cond ? ref $cond : 'plain scalar'))
164 unless ref $cond eq 'HASH';
7fb16f1a 165 my $f_class = $self->result_source->schema->class($rel_obj->{class});
701da8c4 166 $self->throw_exception( "Object $f_obj isn't a ".$f_class )
55e2d745 167 unless $f_obj->isa($f_class);
fde6e28e 168 $self->set_columns(
169 $self->result_source->resolve_condition(
170 $rel_obj->{cond}, $f_obj, $rel));
55e2d745 171 return 1;
172}
173
8091aa91 174=head2 update_from_related
503536d5 175
176 My::Table->update_from_related('relname', $rel_obj);
177
178=cut
179
55e2d745 180sub update_from_related {
181 my $self = shift;
182 $self->set_from_related(@_);
183 $self->update;
184}
185
8091aa91 186=head2 delete_related
503536d5 187
188 My::Table->delete_related('relname', $cond, $attrs);
189
190=cut
191
55e2d745 192sub delete_related {
193 my $self = shift;
64acc2bc 194 my $obj = $self->search_related(@_)->delete;
195 delete $self->{related_resultsets}->{$_[0]};
196 return $obj;
55e2d745 197}
198
1991;
200
64acc2bc 201=head2 related_resultset($name)
202
203Returns a L<DBIx::Class::ResultSet> for the relationship named $name.
204
fefe2816 205 $rs = $obj->related_resultset('related_table');
64acc2bc 206
207=cut
208
209sub related_resultset {
210 my $self = shift;
211 $self->throw_exception("Can't call *_related as class methods") unless ref $self;
212 my $rel = shift;
86efc750 213 my $rel_obj = $self->relationship_info($rel);
214 $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
64acc2bc 215
86efc750 216 return $self->{related_resultsets}{$rel} ||= do {
217 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
218 $attrs = { %{$rel_obj->{attrs} || {}}, %$attrs };
64acc2bc 219
220 $self->throw_exception( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
221 my $query = ((@_ > 1) ? {@_} : shift);
222
86efc750 223 my $cond = $self->result_source->resolve_condition($rel_obj->{cond}, $rel, $self);
64acc2bc 224 if (ref $cond eq 'ARRAY') {
86efc750 225 $cond = [ map { my $hash;
226 foreach my $key (keys %$_) {
227 my $newkey = $key =~ /\./ ? "me.$key" : $key;
228 $hash->{$newkey} = $_->{$key};
229 }; $hash } @$cond ];
230 } else {
231 foreach my $key (grep { ! /\./ } keys %$cond) {
232 $cond->{"me.$key"} = delete $cond->{$key};
64acc2bc 233 }
234 }
235 $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
86efc750 236 $self->result_source->related_source($rel)->resultset->search($query, $attrs);
237 };
64acc2bc 238}
239
55e2d745 240=head1 AUTHORS
241
daec44b8 242Matt S. Trout <mst@shadowcatsystems.co.uk>
55e2d745 243
244=head1 LICENSE
245
246You may distribute this code under the same terms as Perl itself.
247
248=cut
249