perlbrew exits with 0 if `perlbrew use` fails :(
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Relationship / Base.pm
1 package DBIx::Class::Relationship::Base;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7
8 use Scalar::Util qw/weaken blessed/;
9 use Try::Tiny;
10 use namespace::clean;
11
12 =head1 NAME
13
14 DBIx::Class::Relationship::Base - Inter-table relationships
15
16 =head1 SYNOPSIS
17
18   __PACKAGE__->add_relationship(
19     spiders => 'My::DB::Result::Creatures',
20     sub {
21       my $args = shift;
22       return {
23         "$args->{foreign_alias}.id"   => { -ident => "$args->{self_alias}.id" },
24         "$args->{foreign_alias}.type" => 'arachnid'
25       };
26     },
27   );
28
29 =head1 DESCRIPTION
30
31 This class provides methods to describe the relationships between the
32 tables in your database model. These are the "bare bones" relationships
33 methods, for predefined ones, look in L<DBIx::Class::Relationship>.
34
35 =head1 METHODS
36
37 =head2 add_relationship
38
39 =over 4
40
41 =item Arguments: 'relname', 'Foreign::Class', $condition, $attrs
42
43 =back
44
45   __PACKAGE__->add_relationship('relname',
46                                 'Foreign::Class',
47                                 $condition, $attrs);
48
49 Create a custom relationship between one result source and another
50 source, indicated by its class name.
51
52 =head3 condition
53
54 The condition argument describes the C<ON> clause of the C<JOIN>
55 expression used to connect the two sources when creating SQL queries.
56
57 To create simple equality joins, supply a hashref containing the
58 remote table column name as the key(s), and the local table column
59 name as the value(s), for example given:
60
61   My::Schema::Author->has_many(
62     books => 'My::Schema::Book',
63     { 'foreign.author_id' => 'self.id' }
64   );
65
66 A query like:
67
68   $author_rs->search_related('books')->next
69
70 will result in the following C<JOIN> clause:
71
72   ... FROM author me LEFT JOIN book books ON books.author_id = me.id ...
73
74 This describes a relationship between the C<Author> table and the
75 C<Book> table where the C<Book> table has a column C<author_id>
76 containing the ID value of the C<Author>.
77
78 C<foreign> and C<self> are pseudo aliases and must be entered
79 literally. They will be replaced with the actual correct table alias
80 when the SQL is produced.
81
82 Similarly:
83
84   My::Schema::Book->has_many(
85     editions => 'My::Schema::Edition',
86     {
87       'foreign.publisher_id' => 'self.publisher_id',
88       'foreign.type_id'      => 'self.type_id',
89     }
90   );
91
92   ...
93
94   $book_rs->search_related('editions')->next
95
96 will result in the C<JOIN> clause:
97
98   ... FROM book me
99       LEFT JOIN edition editions ON
100            editions.publisher_id = me.publisher_id
101        AND editions.type_id = me.type_id ...
102
103 This describes the relationship from C<Book> to C<Edition>, where the
104 C<Edition> table refers to a publisher and a type (e.g. "paperback"):
105
106 As is the default in L<SQL::Abstract>, the key-value pairs will be
107 C<AND>ed in the result. C<OR> can be achieved with an arrayref, for
108 example a condition like:
109
110   My::Schema::Item->has_many(
111     related_item_links => My::Schema::Item::Links,
112     [
113       { 'foreign.left_itemid'  => 'self.id' },
114       { 'foreign.right_itemid' => 'self.id' },
115     ],
116   );
117
118 will translate to the following C<JOIN> clause:
119
120  ... FROM item me JOIN item_relations related_item_links ON
121          related_item_links.left_itemid = me.id
122       OR related_item_links.right_itemid = me.id ...
123
124 This describes the relationship from C<Item> to C<Item::Links>, where
125 C<Item::Links> is a many-to-many linking table, linking items back to
126 themselves in a peer fashion (without a "parent-child" designation)
127
128 =head4 Custom join conditions
129
130 To specify joins which describe more than a simple equality of column
131 values, the custom join condition coderef syntax can be used. For
132 example:
133
134   My::Schema::Artist->has_many(
135     cds_80s => 'My::Schema::CD',
136     sub {
137       my $args = shift;
138
139       return {
140         "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
141         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
142       };
143     }
144   );
145
146   ...
147
148   $artist_rs->search_related('cds_80s')->next;
149
150 will result in the C<JOIN> clause:
151
152   ... FROM artist me LEFT JOIN cd cds_80s ON
153         cds_80s.artist = me.artistid
154     AND cds_80s.year < ?
155     AND cds_80s.year > ?
156
157 with the bind values:
158
159    '1990', '1979'
160
161 C<< $args->{foreign_alias} >> and C<< $args->{self_alias} >> are supplied the
162 same values that would be otherwise substituted for C<foreign> and C<self>
163 in the simple hashref syntax case.
164
165 The coderef is expected to return a valid L<SQL::Abstract> query-structure, just
166 like what one would supply as the first argument to
167 L<DBIx::Class::ResultSet/search>. The return value will be passed directly to
168 L<SQL::Abstract> and the resulting SQL will be used verbatim as the C<ON>
169 clause of the C<JOIN> statement associated with this relationship.
170
171 While every coderef-based condition must return a valid C<ON> clause, it may
172 elect to additionally return a simplified join-free condition hashref when
173 invoked as C<< $result->relationship >>, as opposed to
174 C<< $rs->related_resultset('relationship') >>. In this case C<$result> is
175 passed to the coderef as C<< $args->{self_rowobj} >>, so a user can do the
176 following:
177
178   sub {
179     my $args = shift;
180
181     return (
182       {
183         "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
184         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
185       },
186       $args->{self_rowobj} && {
187         "$args->{foreign_alias}.artist" => $args->{self_rowobj}->artistid,
188         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
189       },
190     );
191   }
192
193 Now this code:
194
195     my $artist = $schema->resultset("Artist")->find({ id => 4 });
196     $artist->cds_80s->all;
197
198 Can skip a C<JOIN> altogether and instead produce:
199
200     SELECT cds_80s.cdid, cds_80s.artist, cds_80s.title, cds_80s.year, cds_80s.genreid, cds_80s.single_track
201       FROM cd cds_80s
202       WHERE cds_80s.artist = ?
203         AND cds_80s.year < ?
204         AND cds_80s.year > ?
205
206 With the bind values:
207
208     '4', '1990', '1979'
209
210 Note that in order to be able to use
211 L<< $result->create_related|DBIx::Class::Relationship::Base/create_related >>,
212 the coderef must not only return as its second such a "simple" condition
213 hashref which does not depend on joins being available, but the hashref must
214 contain only plain values/deflatable objects, such that the result can be
215 passed directly to L<DBIx::Class::Relationship::Base/set_from_related>. For
216 instance the C<year> constraint in the above example prevents the relationship
217 from being used to to create related objects (an exception will be thrown).
218
219 In order to allow the user to go truly crazy when generating a custom C<ON>
220 clause, the C<$args> hashref passed to the subroutine contains some extra
221 metadata. Currently the supplied coderef is executed as:
222
223   $relationship_info->{cond}->({
224     self_alias        => The alias of the invoking resultset ('me' in case of a result object),
225     foreign_alias     => The alias of the to-be-joined resultset (often matches relname),
226     self_resultsource => The invocant's resultsource,
227     foreign_relname   => The relationship name (does *not* always match foreign_alias),
228     self_rowobj       => The invocant itself in case of a $result_object->$relationship call
229   });
230
231 =head3 attributes
232
233 The L<standard ResultSet attributes|DBIx::Class::ResultSet/ATTRIBUTES> may
234 be used as relationship attributes. In particular, the 'where' attribute is
235 useful for filtering relationships:
236
237      __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User',
238         { 'foreign.user_id' => 'self.user_id' },
239         { where => { valid => 1 } }
240     );
241
242 The following attributes are also valid:
243
244 =over 4
245
246 =item join_type
247
248 Explicitly specifies the type of join to use in the relationship. Any SQL
249 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
250 command immediately before C<JOIN>.
251
252 =item proxy =E<gt> $column | \@columns | \%column
253
254 The 'proxy' attribute can be used to retrieve values, and to perform
255 updates if the relationship has 'cascade_update' set. The 'might_have'
256 and 'has_one' relationships have this set by default; if you want a proxy
257 to update across a 'belongs_to' relationship, you must set the attribute
258 yourself.
259
260 =over 4
261
262 =item \@columns
263
264 An arrayref containing a list of accessors in the foreign class to create in
265 the main class. If, for example, you do the following:
266
267   MyApp::Schema::CD->might_have(liner_notes => 'MyApp::Schema::LinerNotes',
268     undef, {
269       proxy => [ qw/notes/ ],
270     });
271
272 Then, assuming MyApp::Schema::LinerNotes has an accessor named notes, you can do:
273
274   my $cd = MyApp::Schema::CD->find(1);
275   $cd->notes('Notes go here'); # set notes -- LinerNotes object is
276                                # created if it doesn't exist
277
278 For a 'belongs_to relationship, note the 'cascade_update':
279
280   MyApp::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd,
281       { proxy => ['title'], cascade_update => 1 }
282   );
283   $track->title('New Title');
284   $track->update; # updates title in CD
285
286 =item \%column
287
288 A hashref where each key is the accessor you want installed in the main class,
289 and its value is the name of the original in the fireign class.
290
291   MyApp::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
292       proxy => { cd_title => 'title' },
293   });
294
295 This will create an accessor named C<cd_title> on the C<$track> result object.
296
297 =back
298
299 NOTE: you can pass a nested struct too, for example:
300
301   MyApp::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
302     proxy => [ 'year', { cd_title => 'title' } ],
303   });
304
305 =item accessor
306
307 Specifies the type of accessor that should be created for the relationship.
308 Valid values are C<single> (for when there is only a single related object),
309 C<multi> (when there can be many), and C<filter> (for when there is a single
310 related object, but you also want the relationship accessor to double as
311 a column accessor). For C<multi> accessors, an add_to_* method is also
312 created, which calls C<create_related> for the relationship.
313
314 =item is_foreign_key_constraint
315
316 If you are using L<SQL::Translator> to create SQL for you and you find that it
317 is creating constraints where it shouldn't, or not creating them where it
318 should, set this attribute to a true or false value to override the detection
319 of when to create constraints.
320
321 =item cascade_copy
322
323 If C<cascade_copy> is true on a C<has_many> relationship for an
324 object, then when you copy the object all the related objects will
325 be copied too. To turn this behaviour off, pass C<< cascade_copy => 0 >>
326 in the C<$attr> hashref.
327
328 The behaviour defaults to C<< cascade_copy => 1 >> for C<has_many>
329 relationships.
330
331 =item cascade_delete
332
333 By default, DBIx::Class cascades deletes across C<has_many>,
334 C<has_one> and C<might_have> relationships. You can disable this
335 behaviour on a per-relationship basis by supplying
336 C<< cascade_delete => 0 >> in the relationship attributes.
337
338 The cascaded operations are performed after the requested delete,
339 so if your database has a constraint on the relationship, it will
340 have deleted/updated the related records or raised an exception
341 before DBIx::Class gets to perform the cascaded operation.
342
343 =item cascade_update
344
345 By default, DBIx::Class cascades updates across C<has_one> and
346 C<might_have> relationships. You can disable this behaviour on a
347 per-relationship basis by supplying C<< cascade_update => 0 >> in
348 the relationship attributes.
349
350 The C<belongs_to> relationship does not update across relationships
351 by default, so if you have a 'proxy' attribute on a belongs_to and want to
352 use 'update' on it, you muse set C<< cascade_update => 1 >>.
353
354 This is not a RDMS style cascade update - it purely means that when
355 an object has update called on it, all the related objects also
356 have update called. It will not change foreign keys automatically -
357 you must arrange to do this yourself.
358
359 =item on_delete / on_update
360
361 If you are using L<SQL::Translator> to create SQL for you, you can use these
362 attributes to explicitly set the desired C<ON DELETE> or C<ON UPDATE> constraint
363 type. If not supplied the SQLT parser will attempt to infer the constraint type by
364 interrogating the attributes of the B<opposite> relationship. For any 'multi'
365 relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to
366 relationship will be created with an C<ON DELETE CASCADE> constraint. For any
367 relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint
368 will be C<ON UPDATE CASCADE>. If you wish to disable this autodetection, and just
369 use the RDBMS' default constraint type, pass C<< on_delete => undef >> or
370 C<< on_delete => '' >>, and the same for C<on_update> respectively.
371
372 =item is_deferrable
373
374 Tells L<SQL::Translator> that the foreign key constraint it creates should be
375 deferrable. In other words, the user may request that the constraint be ignored
376 until the end of the transaction. Currently, only the PostgreSQL producer
377 actually supports this.
378
379 =item add_fk_index
380
381 Tells L<SQL::Translator> to add an index for this constraint. Can also be
382 specified globally in the args to L<DBIx::Class::Schema/deploy> or
383 L<DBIx::Class::Schema/create_ddl_dir>. Default is on, set to 0 to disable.
384
385 =back
386
387 =head2 register_relationship
388
389 =over 4
390
391 =item Arguments: $rel_name, $rel_info
392
393 =back
394
395 Registers a relationship on the class. This is called internally by
396 DBIx::Class::ResultSourceProxy to set up Accessors and Proxies.
397
398 =cut
399
400 sub register_relationship { }
401
402 =head2 related_resultset
403
404 =over 4
405
406 =item Arguments: $rel_name
407
408 =item Return Value: L<$related_resultset|DBIx::Class::ResultSet>
409
410 =back
411
412   $rs = $cd->related_resultset('artist');
413
414 Returns a L<DBIx::Class::ResultSet> for the relationship named
415 $rel_name.
416
417 =head2 $relationship_accessor
418
419 =over 4
420
421 =item Arguments: none
422
423 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | L<$related_resultset|DBIx::Class::ResultSet> | undef
424
425 =back
426
427   # These pairs do the same thing
428   $result = $cd->related_resultset('artist')->single;  # has_one relationship
429   $result = $cd->artist;
430   $rs = $cd->related_resultset('tracks');           # has_many relationship
431   $rs = $cd->tracks;
432
433 This is the recommended way to traverse through relationships, based
434 on the L</accessor> name given in the relationship definition.
435
436 This will return either a L<Result|DBIx::Class::Manual::ResultClass> or a
437 L<ResultSet|DBIx::Class::ResultSet>, depending on if the relationship is
438 C<single> (returns only one row) or C<multi> (returns many rows).  The
439 method may also return C<undef> if the relationship doesn't exist for
440 this instance (like in the case of C<might_have> relationships).
441
442 =cut
443
444 sub related_resultset {
445   my $self = shift;
446
447   $self->throw_exception("Can't call *_related as class methods")
448     unless ref $self;
449
450   my $rel = shift;
451
452   return $self->{related_resultsets}{$rel}
453     if defined $self->{related_resultsets}{$rel};
454
455   return $self->{related_resultsets}{$rel} = do {
456
457     my $rel_info = $self->relationship_info($rel)
458       or $self->throw_exception( "No such relationship '$rel'" );
459
460     my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
461     $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
462
463     $self->throw_exception( "Invalid query: @_" )
464       if (@_ > 1 && (@_ % 2 == 1));
465     my $query = ((@_ > 1) ? {@_} : shift);
466
467     my $rsrc = $self->result_source;
468
469     # condition resolution may fail if an incomplete master-object prefetch
470     # is encountered - that is ok during prefetch construction (not yet in_storage)
471     my ($cond, $is_crosstable) = try {
472       $rsrc->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel )
473     }
474     catch {
475       if ($self->in_storage) {
476         $self->throw_exception ($_);
477       }
478
479       $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION;  # RV
480     };
481
482     # keep in mind that the following if() block is part of a do{} - no return()s!!!
483     if ($is_crosstable) {
484       $self->throw_exception (
485         "A cross-table relationship condition returned for statically declared '$rel'"
486       ) unless ref $rel_info->{cond} eq 'CODE';
487
488       # A WHOREIFFIC hack to reinvoke the entire condition resolution
489       # with the correct alias. Another way of doing this involves a
490       # lot of state passing around, and the @_ positions are already
491       # mapped out, making this crap a less icky option.
492       #
493       # The point of this exercise is to retain the spirit of the original
494       # $obj->search_related($rel) where the resulting rset will have the
495       # root alias as 'me', instead of $rel (as opposed to invoking
496       # $rs->search_related)
497
498       local $rsrc->{_relationships}{me} = $rsrc->{_relationships}{$rel};  # make the fake 'me' rel
499       my $obj_table_alias = lc($rsrc->source_name) . '__row';
500       $obj_table_alias =~ s/\W+/_/g;
501
502       $rsrc->resultset->search(
503         $self->ident_condition($obj_table_alias),
504         { alias => $obj_table_alias },
505       )->search_related('me', $query, $attrs)
506     }
507     else {
508       # FIXME - this conditional doesn't seem correct - got to figure out
509       # at some point what it does. Also the entire UNRESOLVABLE_CONDITION
510       # business seems shady - we could simply not query *at all*
511       if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
512         my $reverse = $rsrc->reverse_relationship_info($rel);
513         foreach my $rev_rel (keys %$reverse) {
514           if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
515             weaken($attrs->{related_objects}{$rev_rel}[0] = $self);
516           } else {
517             weaken($attrs->{related_objects}{$rev_rel} = $self);
518           }
519         }
520       }
521       elsif (ref $cond eq 'ARRAY') {
522         $cond = [ map {
523           if (ref $_ eq 'HASH') {
524             my $hash;
525             foreach my $key (keys %$_) {
526               my $newkey = $key !~ /\./ ? "me.$key" : $key;
527               $hash->{$newkey} = $_->{$key};
528             }
529             $hash;
530           } else {
531             $_;
532           }
533         } @$cond ];
534       }
535       elsif (ref $cond eq 'HASH') {
536        foreach my $key (grep { ! /\./ } keys %$cond) {
537           $cond->{"me.$key"} = delete $cond->{$key};
538         }
539       }
540
541       $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
542       $rsrc->related_source($rel)->resultset->search(
543         $query, $attrs
544       );
545     }
546   };
547 }
548
549 =head2 search_related
550
551 =over 4
552
553 =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
554
555 =item Return Value: L<$resultset|DBIx::Class::ResultSet> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
556
557 =back
558
559 Run a search on a related resultset. The search will be restricted to the
560 results represented by the L<DBIx::Class::ResultSet> it was called
561 upon.
562
563 See L<DBIx::Class::ResultSet/search_related> for more information.
564
565 =cut
566
567 sub search_related {
568   return shift->related_resultset(shift)->search(@_);
569 }
570
571 =head2 search_related_rs
572
573 This method works exactly the same as search_related, except that
574 it guarantees a resultset, even in list context.
575
576 =cut
577
578 sub search_related_rs {
579   return shift->related_resultset(shift)->search_rs(@_);
580 }
581
582 =head2 count_related
583
584 =over 4
585
586 =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
587
588 =item Return Value: $count
589
590 =back
591
592 Returns the count of all the rows in the related resultset, restricted by the
593 current result or where conditions.
594
595 =cut
596
597 sub count_related {
598   shift->search_related(@_)->count;
599 }
600
601 =head2 new_related
602
603 =over 4
604
605 =item Arguments: $rel_name, \%col_data
606
607 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
608
609 =back
610
611 Create a new result object of the related foreign class.  It will magically set
612 any foreign key columns of the new object to the related primary key columns
613 of the source object for you.  The newly created result will not be saved into
614 your storage until you call L<DBIx::Class::Row/insert> on it.
615
616 =cut
617
618 sub new_related {
619   my ($self, $rel, $values) = @_;
620
621   # FIXME - this is a bad position for this (also an identical copy in
622   # set_from_related), but I have no saner way to hook, and I absolutely
623   # want this to throw at least for coderefs, instead of the "insert a NULL
624   # when it gets hard" insanity --ribasushi
625   #
626   # sanity check - currently throw when a complex coderef rel is encountered
627   # FIXME - should THROW MOAR!
628
629   if (ref $self) {  # cdbi calls this as a class method, /me vomits
630
631     my $rsrc = $self->result_source;
632     my (undef, $crosstable, $cond_targets) = $rsrc->_resolve_condition (
633       $rsrc->relationship_info($rel)->{cond}, $rel, $self, $rel
634     );
635
636     $self->throw_exception("Custom relationship '$rel' does not resolve to a join-free condition fragment")
637       if $crosstable;
638
639     if (my @unspecified_rel_condition_chunks = grep { ! exists $values->{$_} } @{$cond_targets||[]} ) {
640       $self->throw_exception(sprintf (
641         "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s",
642         $rel,
643         map { "'$_'" } @unspecified_rel_condition_chunks
644       ));
645     }
646   }
647
648   return $self->search_related($rel)->new_result($values);
649 }
650
651 =head2 create_related
652
653 =over 4
654
655 =item Arguments: $rel_name, \%col_data
656
657 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
658
659 =back
660
661   my $result = $obj->create_related($rel_name, \%col_data);
662
663 Creates a new result object, similarly to new_related, and also inserts the
664 result's data into your storage medium. See the distinction between C<create>
665 and C<new> in L<DBIx::Class::ResultSet> for details.
666
667 =cut
668
669 sub create_related {
670   my $self = shift;
671   my $rel = shift;
672   my $obj = $self->new_related($rel, @_)->insert;
673   delete $self->{related_resultsets}->{$rel};
674   return $obj;
675 }
676
677 =head2 find_related
678
679 =over 4
680
681 =item Arguments: $rel_name, \%col_data | @pk_values, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
682
683 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
684
685 =back
686
687   my $result = $obj->find_related($rel_name, \%col_data);
688
689 Attempt to find a related object using its primary key or unique constraints.
690 See L<DBIx::Class::ResultSet/find> for details.
691
692 =cut
693
694 sub find_related {
695   #my ($self, $rel, @args) = @_;
696   return shift->search_related(shift)->find(@_);
697 }
698
699 =head2 find_or_new_related
700
701 =over 4
702
703 =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
704
705 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
706
707 =back
708
709 Find a result object of a related class.  See L<DBIx::Class::ResultSet/find_or_new>
710 for details.
711
712 =cut
713
714 sub find_or_new_related {
715   my $self = shift;
716   my $obj = $self->find_related(@_);
717   return defined $obj ? $obj : $self->new_related(@_);
718 }
719
720 =head2 find_or_create_related
721
722 =over 4
723
724 =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
725
726 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
727
728 =back
729
730 Find or create a result object of a related class. See
731 L<DBIx::Class::ResultSet/find_or_create> for details.
732
733 =cut
734
735 sub find_or_create_related {
736   my $self = shift;
737   my $obj = $self->find_related(@_);
738   return (defined($obj) ? $obj : $self->create_related(@_));
739 }
740
741 =head2 update_or_create_related
742
743 =over 4
744
745 =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
746
747 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
748
749 =back
750
751 Update or create a result object of a related class. See
752 L<DBIx::Class::ResultSet/update_or_create> for details.
753
754 =cut
755
756 sub update_or_create_related {
757   #my ($self, $rel, @args) = @_;
758   shift->related_resultset(shift)->update_or_create(@_);
759 }
760
761 =head2 set_from_related
762
763 =over 4
764
765 =item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass>
766
767 =item Return Value: not defined
768
769 =back
770
771   $book->set_from_related('author', $author_obj);
772   $book->author($author_obj);                      ## same thing
773
774 Set column values on the current object, using related values from the given
775 related object. This is used to associate previously separate objects, for
776 example, to set the correct author for a book, find the Author object, then
777 call set_from_related on the book.
778
779 This is called internally when you pass existing objects as values to
780 L<DBIx::Class::ResultSet/create>, or pass an object to a belongs_to accessor.
781
782 The columns are only set in the local copy of the object, call L</update> to
783 set them in the storage.
784
785 =cut
786
787 sub set_from_related {
788   my ($self, $rel, $f_obj) = @_;
789
790   my $rsrc = $self->result_source;
791   my $rel_info = $rsrc->relationship_info($rel)
792     or $self->throw_exception( "No such relationship '$rel'" );
793
794   if (defined $f_obj) {
795     my $f_class = $rel_info->{class};
796     $self->throw_exception( "Object '$f_obj' isn't a ".$f_class )
797       unless blessed $f_obj and $f_obj->isa($f_class);
798   }
799
800
801   # FIXME - this is a bad position for this (also an identical copy in
802   # new_related), but I have no saner way to hook, and I absolutely
803   # want this to throw at least for coderefs, instead of the "insert a NULL
804   # when it gets hard" insanity --ribasushi
805   #
806   # sanity check - currently throw when a complex coderef rel is encountered
807   # FIXME - should THROW MOAR!
808   my ($cond, $crosstable, $cond_targets) = $rsrc->_resolve_condition (
809     $rel_info->{cond}, $f_obj, $rel, $rel
810   );
811   $self->throw_exception("Custom relationship '$rel' does not resolve to a join-free condition fragment")
812     if $crosstable;
813   $self->throw_exception(sprintf (
814     "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s",
815     $rel,
816     map { "'$_'" } @$cond_targets
817   )) if $cond_targets;
818
819   $self->set_columns($cond);
820
821   return 1;
822 }
823
824 =head2 update_from_related
825
826 =over 4
827
828 =item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass>
829
830 =item Return Value: not defined
831
832 =back
833
834   $book->update_from_related('author', $author_obj);
835
836 The same as L</"set_from_related">, but the changes are immediately updated
837 in storage.
838
839 =cut
840
841 sub update_from_related {
842   my $self = shift;
843   $self->set_from_related(@_);
844   $self->update;
845 }
846
847 =head2 delete_related
848
849 =over 4
850
851 =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
852
853 =item Return Value: $underlying_storage_rv
854
855 =back
856
857 Delete any related row, subject to the given conditions.  Internally, this
858 calls:
859
860   $self->search_related(@_)->delete
861
862 And returns the result of that.
863
864 =cut
865
866 sub delete_related {
867   my $self = shift;
868   my $obj = $self->search_related(@_)->delete;
869   delete $self->{related_resultsets}->{$_[0]};
870   return $obj;
871 }
872
873 =head2 add_to_$rel
874
875 B<Currently only available for C<has_many>, C<many_to_many> and 'multi' type
876 relationships.>
877
878 =head3 has_many / multi
879
880 =over 4
881
882 =item Arguments: \%col_data
883
884 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
885
886 =back
887
888 Creates/inserts a new result object.  Internally, this calls:
889
890   $self->create_related($rel, @_)
891
892 And returns the result of that.
893
894 =head3 many_to_many
895
896 =over 4
897
898 =item Arguments: (\%col_data | L<$result|DBIx::Class::Manual::ResultClass>), \%link_col_data?
899
900 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
901
902 =back
903
904   my $role = $schema->resultset('Role')->find(1);
905   $actor->add_to_roles($role);
906       # creates a My::DBIC::Schema::ActorRoles linking table result object
907
908   $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 });
909       # creates a new My::DBIC::Schema::Role result object and the linking table
910       # object with an extra column in the link
911
912 Adds a linking table object. If the first argument is a hash reference, the
913 related object is created first with the column values in the hash. If an object
914 reference is given, just the linking table object is created. In either case,
915 any additional column values for the linking table object can be specified in
916 C<\%link_col_data>.
917
918 See L<DBIx::Class::Relationship/many_to_many> for additional details.
919
920 =head2 set_$rel
921
922 B<Currently only available for C<many_to_many> relationships.>
923
924 =over 4
925
926 =item Arguments: (\@hashrefs_of_col_data | L<\@result_objs|DBIx::Class::Manual::ResultClass>), $link_vals?
927
928 =item Return Value: not defined
929
930 =back
931
932   my $actor = $schema->resultset('Actor')->find(1);
933   my @roles = $schema->resultset('Role')->search({ role =>
934      { '-in' => ['Fred', 'Barney'] } } );
935
936   $actor->set_roles(\@roles);
937      # Replaces all of $actor's previous roles with the two named
938
939   $actor->set_roles(\@roles, { salary => 15_000_000 });
940      # Sets a column in the link table for all roles
941
942
943 Replace all the related objects with the given reference to a list of
944 objects. This does a C<delete> B<on the link table resultset> to remove the
945 association between the current object and all related objects, then calls
946 C<add_to_$rel> repeatedly to link all the new objects.
947
948 Note that this means that this method will B<not> delete any objects in the
949 table on the right side of the relation, merely that it will delete the link
950 between them.
951
952 Due to a mistake in the original implementation of this method, it will also
953 accept a list of objects or hash references. This is B<deprecated> and will be
954 removed in a future version.
955
956 =head2 remove_from_$rel
957
958 B<Currently only available for C<many_to_many> relationships.>
959
960 =over 4
961
962 =item Arguments: L<$result|DBIx::Class::Manual::ResultClass>
963
964 =item Return Value: not defined
965
966 =back
967
968   my $role = $schema->resultset('Role')->find(1);
969   $actor->remove_from_roles($role);
970       # removes $role's My::DBIC::Schema::ActorRoles linking table result object
971
972 Removes the link between the current object and the related object. Note that
973 the related object itself won't be deleted unless you call ->delete() on
974 it. This method just removes the link between the two objects.
975
976 =head1 AUTHOR AND CONTRIBUTORS
977
978 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
979
980 =head1 LICENSE
981
982 You may distribute this code under the same terms as Perl itself.
983
984 =cut
985
986 1;