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 =head1 DESCRIPTION
  19
  20 This class provides methods to describe the relationships between the
  21 tables in your database model. These are the "bare bones" relationships
  22 methods, for predefined ones, look in L<DBIx::Class::Relationship>.
  23
  24 =head1 METHODS
  25
  26 =head2 add_relationship
  27
  28 =over 4
  29
  30 =item Arguments: 'relname', 'Foreign::Class', $cond, $attrs
  31
  32 =back
  33
  34   __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
  35
  36 =head3 condition
  37
  38 The condition needs to be an L<SQL::Abstract>-style representation of the
  39 join between the tables. When resolving the condition for use in a C<JOIN>,
  40 keys using the pseudo-table C<foreign> are resolved to mean "the Table on the
  41 other side of the relationship", and values using the pseudo-table C<self>
  42 are resolved to mean "the Table this class is representing". Other
  43 restrictions, such as by value, sub-select and other tables, may also be
  44 used. Please check your database for C<JOIN> parameter support.
  45
  46 For example, if you're creating a relationship from C<Author> to C<Book>, where
  47 the C<Book> table has a column C<author_id> containing the ID of the C<Author>
  48 row:
  49
  50   { 'foreign.author_id' => 'self.id' }
  51
  52 will result in the C<JOIN> clause
  53
  54   author me JOIN book book ON book.author_id = me.id
  55
  56 For multi-column foreign keys, you will need to specify a C<foreign>-to-C<self>
  57 mapping for each column in the key. For example, if you're creating a
  58 relationship from C<Book> to C<Edition>, where the C<Edition> table refers to a
  59 publisher and a type (e.g. "paperback"):
  60
  61   {
  62     'foreign.publisher_id' => 'self.publisher_id',
  63     'foreign.type_id'      => 'self.type_id',
  64   }
  65
  66 This will result in the C<JOIN> clause:
  67
  68   book me JOIN edition edition ON edition.publisher_id = me.publisher_id
  69     AND edition.type_id = me.type_id
  70
  71 Each key-value pair provided in a hashref will be used as C<AND>ed conditions.
  72 To add an C<OR>ed condition, use an arrayref of hashrefs. See the
  73 L<SQL::Abstract> documentation for more details.
  74
  75 =head3 attributes
  76
  77 The L<standard ResultSet attributes|DBIx::Class::ResultSet/ATTRIBUTES> may
  78 be used as relationship attributes. In particular, the 'where' attribute is
  79 useful for filtering relationships:
  80
  81      __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User',
  82         { 'foreign.user_id' => 'self.user_id' },
  83         { where => { valid => 1 } }
  84     );
  85
  86 The following attributes are also valid:
  87
  88 =over 4
  89
  90 =item join_type
  91
  92 Explicitly specifies the type of join to use in the relationship. Any SQL
  93 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
  94 command immediately before C<JOIN>.
  95
  96 =item proxy =E<gt> $column | \@columns | \%column
  97
  98 =over 4
  99
 100 =item \@columns
 101
 102 An arrayref containing a list of accessors in the foreign class to create in
 103 the main class. If, for example, you do the following:
 104
 105   MyDB::Schema::CD->might_have(liner_notes => 'MyDB::Schema::LinerNotes',
 106     undef, {
 107       proxy => [ qw/notes/ ],
 108     });
 109
 110 Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do:
 111
 112   my $cd = MyDB::Schema::CD->find(1);
 113   $cd->notes('Notes go here'); # set notes -- LinerNotes object is
 114                                # created if it doesn't exist
 115
 116 =item \%column
 117
 118 A hashref where each key is the accessor you want installed in the main class,
 119 and its value is the name of the original in the fireign class.
 120
 121   MyDB::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
 122       proxy => { cd_title => 'title' },
 123   });
 124
 125 This will create an accessor named C<cd_title> on the C<$track> row object.
 126
 127 =back
 128
 129 NOTE: you can pass a nested struct too, for example:
 130
 131   MyDB::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
 132     proxy => [ 'year', { cd_title => 'title' } ],
 133   });
 134
 135 =item accessor
 136
 137 Specifies the type of accessor that should be created for the relationship.
 138 Valid values are C<single> (for when there is only a single related object),
 139 C<multi> (when there can be many), and C<filter> (for when there is a single
 140 related object, but you also want the relationship accessor to double as
 141 a column accessor). For C<multi> accessors, an add_to_* method is also
 142 created, which calls C<create_related> for the relationship.
 143
 144 =item is_foreign_key_constraint
 145
 146 If you are using L<SQL::Translator> to create SQL for you and you find that it
 147 is creating constraints where it shouldn't, or not creating them where it
 148 should, set this attribute to a true or false value to override the detection
 149 of when to create constraints.
 150
 151 =item cascade_copy
 152
 153 If C<cascade_copy> is true on a C<has_many> relationship for an
 154 object, then when you copy the object all the related objects will
 155 be copied too. To turn this behaviour off, pass C<< cascade_copy => 0 >>
 156 in the C<$attr> hashref.
 157
 158 The behaviour defaults to C<< cascade_copy => 1 >> for C<has_many>
 159 relationships.
 160
 161 =item cascade_delete
 162
 163 By default, DBIx::Class cascades deletes across C<has_many>,
 164 C<has_one> and C<might_have> relationships. You can disable this
 165 behaviour on a per-relationship basis by supplying
 166 C<< cascade_delete => 0 >> in the relationship attributes.
 167
 168 The cascaded operations are performed after the requested delete,
 169 so if your database has a constraint on the relationship, it will
 170 have deleted/updated the related records or raised an exception
 171 before DBIx::Class gets to perform the cascaded operation.
 172
 173 =item cascade_update
 174
 175 By default, DBIx::Class cascades updates across C<has_one> and
 176 C<might_have> relationships. You can disable this behaviour on a
 177 per-relationship basis by supplying C<< cascade_update => 0 >> in
 178 the relationship attributes.
 179
 180 This is not a RDMS style cascade update - it purely means that when
 181 an object has update called on it, all the related objects also
 182 have update called. It will not change foreign keys automatically -
 183 you must arrange to do this yourself.
 184
 185 =item on_delete / on_update
 186
 187 If you are using L<SQL::Translator> to create SQL for you, you can use these
 188 attributes to explicitly set the desired C<ON DELETE> or C<ON UPDATE> constraint
 189 type. If not supplied the SQLT parser will attempt to infer the constraint type by
 190 interrogating the attributes of the B<opposite> relationship. For any 'multi'
 191 relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to
 192 relationship will be created with an C<ON DELETE CASCADE> constraint. For any
 193 relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint
 194 will be C<ON UPDATE CASCADE>. If you wish to disable this autodetection, and just
 195 use the RDBMS' default constraint type, pass C<< on_delete => undef >> or
 196 C<< on_delete => '' >>, and the same for C<on_update> respectively.
 197
 198 =item is_deferrable
 199
 200 Tells L<SQL::Translator> that the foreign key constraint it creates should be
 201 deferrable. In other words, the user may request that the constraint be ignored
 202 until the end of the transaction. Currently, only the PostgreSQL producer
 203 actually supports this.
 204
 205 =item add_fk_index
 206
 207 Tells L<SQL::Translator> to add an index for this constraint. Can also be
 208 specified globally in the args to L<DBIx::Class::Schema/deploy> or
 209 L<DBIx::Class::Schema/create_ddl_dir>. Default is on, set to 0 to disable.
 210
 211 =back
 212
 213 =head2 register_relationship
 214
 215 =over 4
 216
 217 =item Arguments: $relname, $rel_info
 218
 219 =back
 220
 221 Registers a relationship on the class. This is called internally by
 222 DBIx::Class::ResultSourceProxy to set up Accessors and Proxies.
 223
 224 =cut
 225
 226 sub register_relationship { }
 227
 228 =head2 related_resultset
 229
 230 =over 4
 231
 232 =item Arguments: $relationship_name
 233
 234 =item Return Value: $related_resultset
 235
 236 =back
 237
 238   $rs = $cd->related_resultset('artist');
 239
 240 Returns a L<DBIx::Class::ResultSet> for the relationship named
 241 $relationship_name.
 242
 243 =cut
 244
 245 sub related_resultset {
 246   my $self = shift;
 247   $self->throw_exception("Can't call *_related as class methods")
 248     unless ref $self;
 249   my $rel = shift;
 250   my $rel_info = $self->relationship_info($rel);
 251   $self->throw_exception( "No such relationship ${rel}" )
 252     unless $rel_info;
 253
 254   return $self->{related_resultsets}{$rel} ||= do {
 255     my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 256     $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
 257
 258     $self->throw_exception( "Invalid query: @_" )
 259       if (@_ > 1 && (@_ % 2 == 1));
 260     my $query = ((@_ > 1) ? {@_} : shift);
 261
 262     my $source = $self->result_source;
 263
 264     # condition resolution may fail if an incomplete master-object prefetch
 265     # is encountered - that is ok during prefetch construction (not yet in_storage)
 266
 267     # if $rel_info->{cond} is a CODE, we might need to join from the
 268     # current resultsource instead of just querying the target
 269     # resultsource, in that case, the condition might provide an
 270     # additional condition in order to avoid an unecessary join if
 271     # that is at all possible.
 272     my ($cond, $cond2) = try {
 273       $source->_resolve_condition( $rel_info->{cond}, $rel, $self )
 274     }
 275     catch {
 276       if ($self->in_storage) {
 277         $self->throw_exception ($_);
 278       }
 279
 280       $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION;  # RV
 281     };
 282
 283     if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
 284       my $reverse = $source->reverse_relationship_info($rel);
 285       foreach my $rev_rel (keys %$reverse) {
 286         if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
 287           $attrs->{related_objects}{$rev_rel} = [ $self ];
 288           weaken $attrs->{related_object}{$rev_rel}[0];
 289         } else {
 290           $attrs->{related_objects}{$rev_rel} = $self;
 291           weaken $attrs->{related_object}{$rev_rel};
 292         }
 293       }
 294     }
 295     if (ref $cond eq 'ARRAY') {
 296       $cond = [ map {
 297         if (ref $_ eq 'HASH') {
 298           my $hash;
 299           foreach my $key (keys %$_) {
 300             my $newkey = $key !~ /\./ ? "me.$key" : $key;
 301             $hash->{$newkey} = $_->{$key};
 302           }
 303           $hash;
 304         } else {
 305           $_;
 306         }
 307       } @$cond ];
 308     } elsif (ref $cond eq 'HASH') {
 309
 310       # this is where we're going to check if we have an extended
 311       # rel. In that case, we need to: 1) If there's a second
 312       # condition, we use that instead.  2) If there is only one
 313       # condition, we need to join the current resultsource and have
 314       # additional conditions.
 315       if (ref $rel_info->{cond} eq 'CODE') {
 316         # this is an extended relationship.
 317         if ($cond2) {
 318           $cond = $cond2;
 319         } else {
 320           if (exists $attrs->{join} && $attrs->{join}) {
 321             # it's a bit hard to find out what to do here.
 322             $self->throw_exception('Extended relationship '.$rel.' with additional join not supported');
 323           } else {
 324             $attrs->{join} = $rel;
 325           }
 326         }
 327       } else {
 328         foreach my $key (grep { ! /\./ } keys %$cond) {
 329           $cond->{"me.$key"} = delete $cond->{$key};
 330         }
 331       }
 332     }
 333
 334     $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
 335     $self->result_source->related_source($rel)->resultset->search(
 336       $query, $attrs
 337     );
 338   };
 339 }
 340
 341 =head2 search_related
 342
 343   @objects = $rs->search_related('relname', $cond, $attrs);
 344   $objects_rs = $rs->search_related('relname', $cond, $attrs);
 345
 346 Run a search on a related resultset. The search will be restricted to the
 347 item or items represented by the L<DBIx::Class::ResultSet> it was called
 348 upon. This method can be called on a ResultSet, a Row or a ResultSource class.
 349
 350 =cut
 351
 352 sub search_related {
 353   return shift->related_resultset(shift)->search(@_);
 354 }
 355
 356 =head2 search_related_rs
 357
 358   ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs);
 359
 360 This method works exactly the same as search_related, except that
 361 it guarantees a resultset, even in list context.
 362
 363 =cut
 364
 365 sub search_related_rs {
 366   return shift->related_resultset(shift)->search_rs(@_);
 367 }
 368
 369 =head2 count_related
 370
 371   $obj->count_related('relname', $cond, $attrs);
 372
 373 Returns the count of all the items in the related resultset, restricted by the
 374 current item or where conditions. Can be called on a
 375 L<DBIx::Class::Manual::Glossary/"ResultSet"> or a
 376 L<DBIx::Class::Manual::Glossary/"Row"> object.
 377
 378 =cut
 379
 380 sub count_related {
 381   my $self = shift;
 382   return $self->search_related(@_)->count;
 383 }
 384
 385 =head2 new_related
 386
 387   my $new_obj = $obj->new_related('relname', \%col_data);
 388
 389 Create a new item of the related foreign class. If called on a
 390 L<Row|DBIx::Class::Manual::Glossary/"Row"> object, it will magically
 391 set any foreign key columns of the new object to the related primary
 392 key columns of the source object for you.  The newly created item will
 393 not be saved into your storage until you call L<DBIx::Class::Row/insert>
 394 on it.
 395
 396 =cut
 397
 398 sub new_related {
 399   my ($self, $rel, $values, $attrs) = @_;
 400   return $self->search_related($rel)->new($values, $attrs);
 401 }
 402
 403 =head2 create_related
 404
 405   my $new_obj = $obj->create_related('relname', \%col_data);
 406
 407 Creates a new item, similarly to new_related, and also inserts the item's data
 408 into your storage medium. See the distinction between C<create> and C<new>
 409 in L<DBIx::Class::ResultSet> for details.
 410
 411 =cut
 412
 413 sub create_related {
 414   my $self = shift;
 415   my $rel = shift;
 416   my $obj = $self->search_related($rel)->create(@_);
 417   delete $self->{related_resultsets}->{$rel};
 418   return $obj;
 419 }
 420
 421 =head2 find_related
 422
 423   my $found_item = $obj->find_related('relname', @pri_vals | \%pri_vals);
 424
 425 Attempt to find a related object using its primary key or unique constraints.
 426 See L<DBIx::Class::ResultSet/find> for details.
 427
 428 =cut
 429
 430 sub find_related {
 431   my $self = shift;
 432   my $rel = shift;
 433   return $self->search_related($rel)->find(@_);
 434 }
 435
 436 =head2 find_or_new_related
 437
 438   my $new_obj = $obj->find_or_new_related('relname', \%col_data);
 439
 440 Find an item of a related class. If none exists, instantiate a new item of the
 441 related class. The object will not be saved into your storage until you call
 442 L<DBIx::Class::Row/insert> on it.
 443
 444 =cut
 445
 446 sub find_or_new_related {
 447   my $self = shift;
 448   my $obj = $self->find_related(@_);
 449   return defined $obj ? $obj : $self->new_related(@_);
 450 }
 451
 452 =head2 find_or_create_related
 453
 454   my $new_obj = $obj->find_or_create_related('relname', \%col_data);
 455
 456 Find or create an item of a related class. See
 457 L<DBIx::Class::ResultSet/find_or_create> for details.
 458
 459 =cut
 460
 461 sub find_or_create_related {
 462   my $self = shift;
 463   my $obj = $self->find_related(@_);
 464   return (defined($obj) ? $obj : $self->create_related(@_));
 465 }
 466
 467 =head2 update_or_create_related
 468
 469   my $updated_item = $obj->update_or_create_related('relname', \%col_data, \%attrs?);
 470
 471 Update or create an item of a related class. See
 472 L<DBIx::Class::ResultSet/update_or_create> for details.
 473
 474 =cut
 475
 476 sub update_or_create_related {
 477   my $self = shift;
 478   my $rel = shift;
 479   return $self->related_resultset($rel)->update_or_create(@_);
 480 }
 481
 482 =head2 set_from_related
 483
 484   $book->set_from_related('author', $author_obj);
 485   $book->author($author_obj);                      ## same thing
 486
 487 Set column values on the current object, using related values from the given
 488 related object. This is used to associate previously separate objects, for
 489 example, to set the correct author for a book, find the Author object, then
 490 call set_from_related on the book.
 491
 492 This is called internally when you pass existing objects as values to
 493 L<DBIx::Class::ResultSet/create>, or pass an object to a belongs_to accessor.
 494
 495 The columns are only set in the local copy of the object, call L</update> to
 496 set them in the storage.
 497
 498 =cut
 499
 500 sub set_from_related {
 501   my ($self, $rel, $f_obj) = @_;
 502   my $rel_info = $self->relationship_info($rel);
 503   $self->throw_exception( "No such relationship ${rel}" ) unless $rel_info;
 504   my $cond = $rel_info->{cond};
 505   $self->throw_exception(
 506     "set_from_related can only handle a hash condition; the ".
 507     "condition for $rel is of type ".
 508     (ref $cond ? ref $cond : 'plain scalar')
 509   ) unless ref $cond eq 'HASH';
 510   if (defined $f_obj) {
 511     my $f_class = $rel_info->{class};
 512     $self->throw_exception( "Object $f_obj isn't a ".$f_class )
 513       unless blessed $f_obj and $f_obj->isa($f_class);
 514   }
 515
 516   # _resolve_condition might return two hashrefs, specially in the
 517   # current case, since we know $f_object is an object.
 518   my ($condref1, $condref2) = $self->result_source->_resolve_condition
 519     ($rel_info->{cond}, $f_obj, $rel);
 520
 521   # if we get two condrefs, we need to use the second, otherwise we
 522   # use the first.
 523   $self->set_columns($condref2 ? $condref2 : $condref1);
 524
 525   return 1;
 526 }
 527
 528 =head2 update_from_related
 529
 530   $book->update_from_related('author', $author_obj);
 531
 532 The same as L</"set_from_related">, but the changes are immediately updated
 533 in storage.
 534
 535 =cut
 536
 537 sub update_from_related {
 538   my $self = shift;
 539   $self->set_from_related(@_);
 540   $self->update;
 541 }
 542
 543 =head2 delete_related
 544
 545   $obj->delete_related('relname', $cond, $attrs);
 546
 547 Delete any related item subject to the given conditions.
 548
 549 =cut
 550
 551 sub delete_related {
 552   my $self = shift;
 553   my $obj = $self->search_related(@_)->delete;
 554   delete $self->{related_resultsets}->{$_[0]};
 555   return $obj;
 556 }
 557
 558 =head2 add_to_$rel
 559
 560 B<Currently only available for C<has_many>, C<many-to-many> and 'multi' type
 561 relationships.>
 562
 563 =over 4
 564
 565 =item Arguments: ($foreign_vals | $obj), $link_vals?
 566
 567 =back
 568
 569   my $role = $schema->resultset('Role')->find(1);
 570   $actor->add_to_roles($role);
 571       # creates a My::DBIC::Schema::ActorRoles linking table row object
 572
 573   $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 });
 574       # creates a new My::DBIC::Schema::Role row object and the linking table
 575       # object with an extra column in the link
 576
 577 Adds a linking table object for C<$obj> or C<$foreign_vals>. If the first
 578 argument is a hash reference, the related object is created first with the
 579 column values in the hash. If an object reference is given, just the linking
 580 table object is created. In either case, any additional column values for the
 581 linking table object can be specified in C<$link_vals>.
 582
 583 =head2 set_$rel
 584
 585 B<Currently only available for C<many-to-many> relationships.>
 586
 587 =over 4
 588
 589 =item Arguments: (\@hashrefs | \@objs), $link_vals?
 590
 591 =back
 592
 593   my $actor = $schema->resultset('Actor')->find(1);
 594   my @roles = $schema->resultset('Role')->search({ role =>
 595      { '-in' => ['Fred', 'Barney'] } } );
 596
 597   $actor->set_roles(\@roles);
 598      # Replaces all of $actor's previous roles with the two named
 599
 600   $actor->set_roles(\@roles, { salary => 15_000_000 });
 601      # Sets a column in the link table for all roles
 602
 603
 604 Replace all the related objects with the given reference to a list of
 605 objects. This does a C<delete> B<on the link table resultset> to remove the
 606 association between the current object and all related objects, then calls
 607 C<add_to_$rel> repeatedly to link all the new objects.
 608
 609 Note that this means that this method will B<not> delete any objects in the
 610 table on the right side of the relation, merely that it will delete the link
 611 between them.
 612
 613 Due to a mistake in the original implementation of this method, it will also
 614 accept a list of objects or hash references. This is B<deprecated> and will be
 615 removed in a future version.
 616
 617 =head2 remove_from_$rel
 618
 619 B<Currently only available for C<many-to-many> relationships.>
 620
 621 =over 4
 622
 623 =item Arguments: $obj
 624
 625 =back
 626
 627   my $role = $schema->resultset('Role')->find(1);
 628   $actor->remove_from_roles($role);
 629       # removes $role's My::DBIC::Schema::ActorRoles linking table row object
 630
 631 Removes the link between the current object and the related object. Note that
 632 the related object itself won't be deleted unless you call ->delete() on
 633 it. This method just removes the link between the two objects.
 634
 635 =head1 AUTHORS
 636
 637 Matt S. Trout <mst@shadowcatsystems.co.uk>
 638
 639 =head1 LICENSE
 640
 641 You may distribute this code under the same terms as Perl itself.
 642
 643 =cut
 644
 645 1;