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 To specify joins which describe more than a simple equality of column
 129 values, the custom join condition coderef syntax can be used. For
 130 example:
 131
 132   My::Schema::Artist->has_many(
 133     cds_80s => 'My::Schema::CD',
 134     sub {
 135       my $args = shift;
 136
 137       return {
 138         "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
 139         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
 140       };
 141     }
 142   );
 143
 144   ...
 145
 146   $artist_rs->search_related('cds_80s')->next;
 147
 148 will result in the C<JOIN> clause:
 149
 150   ... FROM artist me LEFT JOIN cd cds_80s ON
 151         cds_80s.artist = me.artistid
 152     AND cds_80s.year < ?
 153     AND cds_80s.year > ?
 154
 155 with the bind values:
 156
 157    '1990', '1979'
 158
 159 C<< $args->{foreign_alias} >> and C<< $args->{self_alias} >> are supplied the
 160 same values that would be otherwise substituted for C<foreign> and C<self>
 161 in the simple hashref syntax case.
 162
 163 The coderef is expected to return a valid L<SQL::Abstract> query-structure, just
 164 like what one would supply as the first argument to
 165 L<DBIx::Class::ResultSet/search>. The return value will be passed directly to
 166 L<SQL::Abstract> and the resulting SQL will be used verbatim as the C<ON>
 167 clause of the C<JOIN> statement associated with this relationship.
 168
 169 While every coderef-based condition must return a valid C<ON> clause, it may
 170 elect to additionally return a simplified join-free condition hashref when
 171 invoked as C<< $row_object->relationship >>, as opposed to
 172 C<< $rs->related_resultset('relationship') >>. In this case C<$row_object> is
 173 passed to the coderef as C<< $args->{self_rowobj} >>, so a user can do the
 174 following:
 175
 176   sub {
 177     my $args = shift;
 178
 179     return (
 180       {
 181         "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
 182         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
 183       },
 184       $args->{self_rowobj} && {
 185         "$args->{foreign_alias}.artist" => $args->{self_rowobj}->artistid,
 186         "$args->{foreign_alias}.year"   => { '>', "1979", '<', "1990" },
 187       },
 188     );
 189   }
 190
 191 Now this code:
 192
 193     my $artist = $schema->resultset("Artist")->find({ id => 4 });
 194     $artist->cds_80s->all;
 195
 196 Can skip a C<JOIN> altogether and instead produce:
 197
 198     SELECT cds_80s.cdid, cds_80s.artist, cds_80s.title, cds_80s.year, cds_80s.genreid, cds_80s.single_track
 199       FROM cd cds_80s
 200       WHERE cds_80s.artist = ?
 201         AND cds_80s.year < ?
 202         AND cds_80s.year > ?
 203
 204 With the bind values:
 205
 206     '4', '1990', '1979'
 207
 208 Note that in order to be able to use
 209 L<< $row->create_related|DBIx::Class::Relationship::Base/create_related >>,
 210 the coderef must not only return as its second such a "simple" condition
 211 hashref which does not depend on joins being available, but the hashref must
 212 contain only plain values/deflatable objects, such that the result can be
 213 passed directly to L<DBIx::Class::Relationship::Base/set_from_related>. For
 214 instance the C<year> constraint in the above example prevents the relationship
 215 from being used to to create related objects (an exception will be thrown).
 216
 217 In order to allow the user to go truly crazy when generating a custom C<ON>
 218 clause, the C<$args> hashref passed to the subroutine contains some extra
 219 metadata. Currently the supplied coderef is executed as:
 220
 221   $relationship_info->{cond}->({
 222     self_alias        => The alias of the invoking resultset ('me' in case of a row object),
 223     foreign_alias     => The alias of the to-be-joined resultset (often matches relname),
 224     self_resultsource => The invocant's resultsource,
 225     foreign_relname   => The relationship name (does *not* always match foreign_alias),
 226     self_rowobj       => The invocant itself in case of $row_obj->relationship
 227   });
 228
 229 =head3 attributes
 230
 231 The L<standard ResultSet attributes|DBIx::Class::ResultSet/ATTRIBUTES> may
 232 be used as relationship attributes. In particular, the 'where' attribute is
 233 useful for filtering relationships:
 234
 235      __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User',
 236         { 'foreign.user_id' => 'self.user_id' },
 237         { where => { valid => 1 } }
 238     );
 239
 240 The following attributes are also valid:
 241
 242 =over 4
 243
 244 =item join_type
 245
 246 Explicitly specifies the type of join to use in the relationship. Any SQL
 247 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
 248 command immediately before C<JOIN>.
 249
 250 =item proxy =E<gt> $column | \@columns | \%column
 251
 252 =over 4
 253
 254 =item \@columns
 255
 256 An arrayref containing a list of accessors in the foreign class to create in
 257 the main class. If, for example, you do the following:
 258
 259   MyApp::Schema::CD->might_have(liner_notes => 'MyApp::Schema::LinerNotes',
 260     undef, {
 261       proxy => [ qw/notes/ ],
 262     });
 263
 264 Then, assuming MyApp::Schema::LinerNotes has an accessor named notes, you can do:
 265
 266   my $cd = MyApp::Schema::CD->find(1);
 267   $cd->notes('Notes go here'); # set notes -- LinerNotes object is
 268                                # created if it doesn't exist
 269
 270 =item \%column
 271
 272 A hashref where each key is the accessor you want installed in the main class,
 273 and its value is the name of the original in the fireign class.
 274
 275   MyApp::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
 276       proxy => { cd_title => 'title' },
 277   });
 278
 279 This will create an accessor named C<cd_title> on the C<$track> row object.
 280
 281 =back
 282
 283 NOTE: you can pass a nested struct too, for example:
 284
 285   MyApp::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
 286     proxy => [ 'year', { cd_title => 'title' } ],
 287   });
 288
 289 =item accessor
 290
 291 Specifies the type of accessor that should be created for the relationship.
 292 Valid values are C<single> (for when there is only a single related object),
 293 C<multi> (when there can be many), and C<filter> (for when there is a single
 294 related object, but you also want the relationship accessor to double as
 295 a column accessor). For C<multi> accessors, an add_to_* method is also
 296 created, which calls C<create_related> for the relationship.
 297
 298 =item is_foreign_key_constraint
 299
 300 If you are using L<SQL::Translator> to create SQL for you and you find that it
 301 is creating constraints where it shouldn't, or not creating them where it
 302 should, set this attribute to a true or false value to override the detection
 303 of when to create constraints.
 304
 305 =item cascade_copy
 306
 307 If C<cascade_copy> is true on a C<has_many> relationship for an
 308 object, then when you copy the object all the related objects will
 309 be copied too. To turn this behaviour off, pass C<< cascade_copy => 0 >>
 310 in the C<$attr> hashref.
 311
 312 The behaviour defaults to C<< cascade_copy => 1 >> for C<has_many>
 313 relationships.
 314
 315 =item cascade_delete
 316
 317 By default, DBIx::Class cascades deletes across C<has_many>,
 318 C<has_one> and C<might_have> relationships. You can disable this
 319 behaviour on a per-relationship basis by supplying
 320 C<< cascade_delete => 0 >> in the relationship attributes.
 321
 322 The cascaded operations are performed after the requested delete,
 323 so if your database has a constraint on the relationship, it will
 324 have deleted/updated the related records or raised an exception
 325 before DBIx::Class gets to perform the cascaded operation.
 326
 327 =item cascade_update
 328
 329 By default, DBIx::Class cascades updates across C<has_one> and
 330 C<might_have> relationships. You can disable this behaviour on a
 331 per-relationship basis by supplying C<< cascade_update => 0 >> in
 332 the relationship attributes.
 333
 334 This is not a RDMS style cascade update - it purely means that when
 335 an object has update called on it, all the related objects also
 336 have update called. It will not change foreign keys automatically -
 337 you must arrange to do this yourself.
 338
 339 =item on_delete / on_update
 340
 341 If you are using L<SQL::Translator> to create SQL for you, you can use these
 342 attributes to explicitly set the desired C<ON DELETE> or C<ON UPDATE> constraint
 343 type. If not supplied the SQLT parser will attempt to infer the constraint type by
 344 interrogating the attributes of the B<opposite> relationship. For any 'multi'
 345 relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to
 346 relationship will be created with an C<ON DELETE CASCADE> constraint. For any
 347 relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint
 348 will be C<ON UPDATE CASCADE>. If you wish to disable this autodetection, and just
 349 use the RDBMS' default constraint type, pass C<< on_delete => undef >> or
 350 C<< on_delete => '' >>, and the same for C<on_update> respectively.
 351
 352 =item is_deferrable
 353
 354 Tells L<SQL::Translator> that the foreign key constraint it creates should be
 355 deferrable. In other words, the user may request that the constraint be ignored
 356 until the end of the transaction. Currently, only the PostgreSQL producer
 357 actually supports this.
 358
 359 =item add_fk_index
 360
 361 Tells L<SQL::Translator> to add an index for this constraint. Can also be
 362 specified globally in the args to L<DBIx::Class::Schema/deploy> or
 363 L<DBIx::Class::Schema/create_ddl_dir>. Default is on, set to 0 to disable.
 364
 365 =back
 366
 367 =head2 register_relationship
 368
 369 =over 4
 370
 371 =item Arguments: $relname, $rel_info
 372
 373 =back
 374
 375 Registers a relationship on the class. This is called internally by
 376 DBIx::Class::ResultSourceProxy to set up Accessors and Proxies.
 377
 378 =cut
 379
 380 sub register_relationship { }
 381
 382 =head2 related_resultset
 383
 384 =over 4
 385
 386 =item Arguments: $relationship_name
 387
 388 =item Return Value: $related_resultset
 389
 390 =back
 391
 392   $rs = $cd->related_resultset('artist');
 393
 394 Returns a L<DBIx::Class::ResultSet> for the relationship named
 395 $relationship_name.
 396
 397 =cut
 398
 399 sub related_resultset {
 400   my $self = shift;
 401   $self->throw_exception("Can't call *_related as class methods")
 402     unless ref $self;
 403   my $rel = shift;
 404   my $rel_info = $self->relationship_info($rel);
 405   $self->throw_exception( "No such relationship ${rel}" )
 406     unless $rel_info;
 407
 408   return $self->{related_resultsets}{$rel} ||= do {
 409     my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 410     $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
 411
 412     $self->throw_exception( "Invalid query: @_" )
 413       if (@_ > 1 && (@_ % 2 == 1));
 414     my $query = ((@_ > 1) ? {@_} : shift);
 415
 416     my $source = $self->result_source;
 417
 418     # condition resolution may fail if an incomplete master-object prefetch
 419     # is encountered - that is ok during prefetch construction (not yet in_storage)
 420     my ($cond, $is_crosstable) = try {
 421       $source->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel )
 422     }
 423     catch {
 424       if ($self->in_storage) {
 425         $self->throw_exception ($_);
 426       }
 427
 428       $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION;  # RV
 429     };
 430
 431     # keep in mind that the following if() block is part of a do{} - no return()s!!!
 432     if ($is_crosstable) {
 433       $self->throw_exception (
 434         "A cross-table relationship condition returned for statically declared '$rel'")
 435           unless ref $rel_info->{cond} eq 'CODE';
 436
 437       # A WHOREIFFIC hack to reinvoke the entire condition resolution
 438       # with the correct alias. Another way of doing this involves a
 439       # lot of state passing around, and the @_ positions are already
 440       # mapped out, making this crap a less icky option.
 441       #
 442       # The point of this exercise is to retain the spirit of the original
 443       # $obj->search_related($rel) where the resulting rset will have the
 444       # root alias as 'me', instead of $rel (as opposed to invoking
 445       # $rs->search_related)
 446
 447       local $source->{_relationships}{me} = $source->{_relationships}{$rel};  # make the fake 'me' rel
 448       my $obj_table_alias = lc($source->source_name) . '__row';
 449       $obj_table_alias =~ s/\W+/_/g;
 450
 451       $source->resultset->search(
 452         $self->ident_condition($obj_table_alias),
 453         { alias => $obj_table_alias },
 454       )->search_related('me', $query, $attrs)
 455     }
 456     else {
 457       # FIXME - this conditional doesn't seem correct - got to figure out
 458       # at some point what it does. Also the entire UNRESOLVABLE_CONDITION
 459       # business seems shady - we could simply not query *at all*
 460       if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
 461         my $reverse = $source->reverse_relationship_info($rel);
 462         foreach my $rev_rel (keys %$reverse) {
 463           if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
 464             weaken($attrs->{related_objects}{$rev_rel}[0] = $self);
 465           } else {
 466             weaken($attrs->{related_objects}{$rev_rel} = $self);
 467           }
 468         }
 469       }
 470       elsif (ref $cond eq 'ARRAY') {
 471         $cond = [ map {
 472           if (ref $_ eq 'HASH') {
 473             my $hash;
 474             foreach my $key (keys %$_) {
 475               my $newkey = $key !~ /\./ ? "me.$key" : $key;
 476               $hash->{$newkey} = $_->{$key};
 477             }
 478             $hash;
 479           } else {
 480             $_;
 481           }
 482         } @$cond ];
 483       }
 484       elsif (ref $cond eq 'HASH') {
 485        foreach my $key (grep { ! /\./ } keys %$cond) {
 486           $cond->{"me.$key"} = delete $cond->{$key};
 487         }
 488       }
 489
 490       $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
 491       $self->result_source->related_source($rel)->resultset->search(
 492         $query, $attrs
 493       );
 494     }
 495   };
 496 }
 497
 498 =head2 search_related
 499
 500   @objects = $rs->search_related('relname', $cond, $attrs);
 501   $objects_rs = $rs->search_related('relname', $cond, $attrs);
 502
 503 Run a search on a related resultset. The search will be restricted to the
 504 item or items represented by the L<DBIx::Class::ResultSet> it was called
 505 upon. This method can be called on a ResultSet, a Row or a ResultSource class.
 506
 507 =cut
 508
 509 sub search_related {
 510   return shift->related_resultset(shift)->search(@_);
 511 }
 512
 513 =head2 search_related_rs
 514
 515   ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs);
 516
 517 This method works exactly the same as search_related, except that
 518 it guarantees a resultset, even in list context.
 519
 520 =cut
 521
 522 sub search_related_rs {
 523   return shift->related_resultset(shift)->search_rs(@_);
 524 }
 525
 526 =head2 count_related
 527
 528   $obj->count_related('relname', $cond, $attrs);
 529
 530 Returns the count of all the items in the related resultset, restricted by the
 531 current item or where conditions. Can be called on a
 532 L<DBIx::Class::Manual::Glossary/"ResultSet"> or a
 533 L<DBIx::Class::Manual::Glossary/"Row"> object.
 534
 535 =cut
 536
 537 sub count_related {
 538   my $self = shift;
 539   return $self->search_related(@_)->count;
 540 }
 541
 542 =head2 new_related
 543
 544   my $new_obj = $obj->new_related('relname', \%col_data);
 545
 546 Create a new item of the related foreign class. If called on a
 547 L<Row|DBIx::Class::Manual::Glossary/"Row"> object, it will magically
 548 set any foreign key columns of the new object to the related primary
 549 key columns of the source object for you.  The newly created item will
 550 not be saved into your storage until you call L<DBIx::Class::Row/insert>
 551 on it.
 552
 553 =cut
 554
 555 sub new_related {
 556   my ($self, $rel, $values, $attrs) = @_;
 557
 558   # FIXME - this is a bad position for this (also an identical copy in
 559   # set_from_related), but I have no saner way to hook, and I absolutely
 560   # want this to throw at least for coderefs, instead of the "insert a NULL
 561   # when it gets hard" insanity --ribasushi
 562   #
 563   # sanity check - currently throw when a complex coderef rel is encountered
 564   # FIXME - should THROW MOAR!
 565
 566   if (ref $self) {  # cdbi calls this as a class method, /me vomits
 567
 568     my $rsrc = $self->result_source;
 569     my (undef, $crosstable, $relcols) = $rsrc->_resolve_condition (
 570       $rsrc->relationship_info($rel)->{cond}, $rel, $self, $rel
 571     );
 572
 573     $self->throw_exception("Custom relationship '$rel' does not resolve to a join-free condition fragment")
 574       if $crosstable;
 575
 576     if (@{$relcols || []} and @$relcols = grep { ! exists $values->{$_} } @$relcols) {
 577       $self->throw_exception(sprintf (
 578         "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s",
 579         $rel,
 580         map { "'$_'" } @$relcols
 581       ));
 582     }
 583   }
 584
 585   my $row = $self->search_related($rel)->new($values, $attrs);
 586   return $row;
 587 }
 588
 589 =head2 create_related
 590
 591   my $new_obj = $obj->create_related('relname', \%col_data);
 592
 593 Creates a new item, similarly to new_related, and also inserts the item's data
 594 into your storage medium. See the distinction between C<create> and C<new>
 595 in L<DBIx::Class::ResultSet> for details.
 596
 597 =cut
 598
 599 sub create_related {
 600   my $self = shift;
 601   my $rel = shift;
 602   my $obj = $self->new_related($rel, @_)->insert;
 603   delete $self->{related_resultsets}->{$rel};
 604   return $obj;
 605 }
 606
 607 =head2 find_related
 608
 609   my $found_item = $obj->find_related('relname', @pri_vals | \%pri_vals);
 610
 611 Attempt to find a related object using its primary key or unique constraints.
 612 See L<DBIx::Class::ResultSet/find> for details.
 613
 614 =cut
 615
 616 sub find_related {
 617   my $self = shift;
 618   my $rel = shift;
 619   return $self->search_related($rel)->find(@_);
 620 }
 621
 622 =head2 find_or_new_related
 623
 624   my $new_obj = $obj->find_or_new_related('relname', \%col_data);
 625
 626 Find an item of a related class. If none exists, instantiate a new item of the
 627 related class. The object will not be saved into your storage until you call
 628 L<DBIx::Class::Row/insert> on it.
 629
 630 =cut
 631
 632 sub find_or_new_related {
 633   my $self = shift;
 634   my $obj = $self->find_related(@_);
 635   return defined $obj ? $obj : $self->new_related(@_);
 636 }
 637
 638 =head2 find_or_create_related
 639
 640   my $new_obj = $obj->find_or_create_related('relname', \%col_data);
 641
 642 Find or create an item of a related class. See
 643 L<DBIx::Class::ResultSet/find_or_create> for details.
 644
 645 =cut
 646
 647 sub find_or_create_related {
 648   my $self = shift;
 649   my $obj = $self->find_related(@_);
 650   return (defined($obj) ? $obj : $self->create_related(@_));
 651 }
 652
 653 =head2 update_or_create_related
 654
 655   my $updated_item = $obj->update_or_create_related('relname', \%col_data, \%attrs?);
 656
 657 Update or create an item of a related class. See
 658 L<DBIx::Class::ResultSet/update_or_create> for details.
 659
 660 =cut
 661
 662 sub update_or_create_related {
 663   my $self = shift;
 664   my $rel = shift;
 665   return $self->related_resultset($rel)->update_or_create(@_);
 666 }
 667
 668 =head2 set_from_related
 669
 670   $book->set_from_related('author', $author_obj);
 671   $book->author($author_obj);                      ## same thing
 672
 673 Set column values on the current object, using related values from the given
 674 related object. This is used to associate previously separate objects, for
 675 example, to set the correct author for a book, find the Author object, then
 676 call set_from_related on the book.
 677
 678 This is called internally when you pass existing objects as values to
 679 L<DBIx::Class::ResultSet/create>, or pass an object to a belongs_to accessor.
 680
 681 The columns are only set in the local copy of the object, call L</update> to
 682 set them in the storage.
 683
 684 =cut
 685
 686 sub set_from_related {
 687   my ($self, $rel, $f_obj) = @_;
 688
 689   my $rsrc = $self->result_source;
 690   my $rel_info = $rsrc->relationship_info($rel)
 691     or $self->throw_exception( "No such relationship ${rel}" );
 692
 693   if (defined $f_obj) {
 694     my $f_class = $rel_info->{class};
 695     $self->throw_exception( "Object $f_obj isn't a ".$f_class )
 696       unless blessed $f_obj and $f_obj->isa($f_class);
 697   }
 698
 699
 700   # FIXME - this is a bad position for this (also an identical copy in
 701   # new_related), but I have no saner way to hook, and I absolutely
 702   # want this to throw at least for coderefs, instead of the "insert a NULL
 703   # when it gets hard" insanity --ribasushi
 704   #
 705   # sanity check - currently throw when a complex coderef rel is encountered
 706   # FIXME - should THROW MOAR!
 707   my ($cond, $crosstable, $relcols) = $rsrc->_resolve_condition (
 708     $rel_info->{cond}, $f_obj, $rel, $rel
 709   );
 710   $self->throw_exception("Custom relationship '$rel' does not resolve to a join-free condition fragment")
 711     if $crosstable;
 712   $self->throw_exception(sprintf (
 713     "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s",
 714     $rel,
 715     map { "'$_'" } @$relcols
 716   )) if @{$relcols || []};
 717
 718   $self->set_columns($cond);
 719
 720   return 1;
 721 }
 722
 723 =head2 update_from_related
 724
 725   $book->update_from_related('author', $author_obj);
 726
 727 The same as L</"set_from_related">, but the changes are immediately updated
 728 in storage.
 729
 730 =cut
 731
 732 sub update_from_related {
 733   my $self = shift;
 734   $self->set_from_related(@_);
 735   $self->update;
 736 }
 737
 738 =head2 delete_related
 739
 740   $obj->delete_related('relname', $cond, $attrs);
 741
 742 Delete any related item subject to the given conditions.
 743
 744 =cut
 745
 746 sub delete_related {
 747   my $self = shift;
 748   my $obj = $self->search_related(@_)->delete;
 749   delete $self->{related_resultsets}->{$_[0]};
 750   return $obj;
 751 }
 752
 753 =head2 add_to_$rel
 754
 755 B<Currently only available for C<has_many>, C<many-to-many> and 'multi' type
 756 relationships.>
 757
 758 =over 4
 759
 760 =item Arguments: ($foreign_vals | $obj), $link_vals?
 761
 762 =back
 763
 764   my $role = $schema->resultset('Role')->find(1);
 765   $actor->add_to_roles($role);
 766       # creates a My::DBIC::Schema::ActorRoles linking table row object
 767
 768   $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 });
 769       # creates a new My::DBIC::Schema::Role row object and the linking table
 770       # object with an extra column in the link
 771
 772 Adds a linking table object for C<$obj> or C<$foreign_vals>. If the first
 773 argument is a hash reference, the related object is created first with the
 774 column values in the hash. If an object reference is given, just the linking
 775 table object is created. In either case, any additional column values for the
 776 linking table object can be specified in C<$link_vals>.
 777
 778 =head2 set_$rel
 779
 780 B<Currently only available for C<many-to-many> relationships.>
 781
 782 =over 4
 783
 784 =item Arguments: (\@hashrefs | \@objs), $link_vals?
 785
 786 =back
 787
 788   my $actor = $schema->resultset('Actor')->find(1);
 789   my @roles = $schema->resultset('Role')->search({ role =>
 790      { '-in' => ['Fred', 'Barney'] } } );
 791
 792   $actor->set_roles(\@roles);
 793      # Replaces all of $actor's previous roles with the two named
 794
 795   $actor->set_roles(\@roles, { salary => 15_000_000 });
 796      # Sets a column in the link table for all roles
 797
 798
 799 Replace all the related objects with the given reference to a list of
 800 objects. This does a C<delete> B<on the link table resultset> to remove the
 801 association between the current object and all related objects, then calls
 802 C<add_to_$rel> repeatedly to link all the new objects.
 803
 804 Note that this means that this method will B<not> delete any objects in the
 805 table on the right side of the relation, merely that it will delete the link
 806 between them.
 807
 808 Due to a mistake in the original implementation of this method, it will also
 809 accept a list of objects or hash references. This is B<deprecated> and will be
 810 removed in a future version.
 811
 812 =head2 remove_from_$rel
 813
 814 B<Currently only available for C<many-to-many> relationships.>
 815
 816 =over 4
 817
 818 =item Arguments: $obj
 819
 820 =back
 821
 822   my $role = $schema->resultset('Role')->find(1);
 823   $actor->remove_from_roles($role);
 824       # removes $role's My::DBIC::Schema::ActorRoles linking table row object
 825
 826 Removes the link between the current object and the related object. Note that
 827 the related object itself won't be deleted unless you call ->delete() on
 828 it. This method just removes the link between the two objects.
 829
 830 =head1 AUTHORS
 831
 832 Matt S. Trout <mst@shadowcatsystems.co.uk>
 833
 834 =head1 LICENSE
 835
 836 You may distribute this code under the same terms as Perl itself.
 837
 838 =cut
 839
 840 1;