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 =head1 NAME
   9
  10 DBIx::Class::Relationship::Base - Inter-table relationships
  11
  12 =head1 SYNOPSIS
  13
  14 =head1 DESCRIPTION
  15
  16 This class provides methods to describe the relationships between the
  17 tables in your database model. These are the "bare bones" relationships
  18 methods, for predefined ones, look in L<DBIx::Class::Relationship>.
  19
  20 =head1 METHODS
  21
  22 =head2 add_relationship
  23
  24 =over 4
  25
  26 =item Arguments: 'relname', 'Foreign::Class', $cond, $attrs
  27
  28 =back
  29
  30   __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
  31
  32 The condition needs to be an L<SQL::Abstract>-style representation of the
  33 join between the tables. When resolving the condition for use in a C<JOIN>,
  34 keys using the pseudo-table C<foreign> are resolved to mean "the Table on the
  35 other side of the relationship", and values using the pseudo-table C<self>
  36 are resolved to mean "the Table this class is representing". Other
  37 restrictions, such as by value, sub-select and other tables, may also be
  38 used. Please check your database for C<JOIN> parameter support.
  39
  40 For example, if you're creating a relationship from C<Author> to C<Book>, where
  41 the C<Book> table has a column C<author_id> containing the ID of the C<Author>
  42 row:
  43
  44   { 'foreign.author_id' => 'self.id' }
  45
  46 will result in the C<JOIN> clause
  47
  48   author me JOIN book book ON book.author_id = me.id
  49
  50 For multi-column foreign keys, you will need to specify a C<foreign>-to-C<self>
  51 mapping for each column in the key. For example, if you're creating a
  52 relationship from C<Book> to C<Edition>, where the C<Edition> table refers to a
  53 publisher and a type (e.g. "paperback"):
  54
  55   {
  56     'foreign.publisher_id' => 'self.publisher_id',
  57     'foreign.type_id'      => 'self.type_id',
  58   }
  59
  60 This will result in the C<JOIN> clause:
  61
  62   book me JOIN edition edition ON edition.publisher_id = me.publisher_id
  63     AND edition.type_id = me.type_id
  64
  65 Each key-value pair provided in a hashref will be used as C<AND>ed conditions.
  66 To add an C<OR>ed condition, use an arrayref of hashrefs. See the
  67 L<SQL::Abstract> documentation for more details.
  68
  69 Valid attributes are as follows:
  70
  71 =over 4
  72
  73 =item join_type
  74
  75 Explicitly specifies the type of join to use in the relationship. Any SQL
  76 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
  77 command immediately before C<JOIN>.
  78
  79 =item proxy
  80
  81 An arrayref containing a list of accessors in the foreign class to create in
  82 the main class. If, for example, you do the following:
  83
  84   MyDB::Schema::CD->might_have(liner_notes => 'MyDB::Schema::LinerNotes',
  85     undef, {
  86       proxy => [ qw/notes/ ],
  87     });
  88
  89 Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do:
  90
  91   my $cd = MyDB::Schema::CD->find(1);
  92   $cd->notes('Notes go here'); # set notes -- LinerNotes object is
  93                                # created if it doesn't exist
  94
  95 =item accessor
  96
  97 Specifies the type of accessor that should be created for the relationship.
  98 Valid values are C<single> (for when there is only a single related object),
  99 C<multi> (when there can be many), and C<filter> (for when there is a single
 100 related object, but you also want the relationship accessor to double as
 101 a column accessor). For C<multi> accessors, an add_to_* method is also
 102 created, which calls C<create_related> for the relationship.
 103
 104 =back
 105
 106 =head2 register_relationship
 107
 108 =over 4
 109
 110 =item Arguments: $relname, $rel_info
 111
 112 =back
 113
 114 Registers a relationship on the class. This is called internally by
 115 DBIx::Class::ResultSourceProxy to set up Accessors and Proxies.
 116
 117 =cut
 118
 119 sub register_relationship { }
 120
 121 =head2 related_resultset
 122
 123 =over 4
 124
 125 =item Arguments: $relationship_name
 126
 127 =item Return Value: $related_resultset
 128
 129 =back
 130
 131   $rs = $cd->related_resultset('artist');
 132
 133 Returns a L<DBIx::Class::ResultSet> for the relationship named
 134 $relationship_name.
 135
 136 =cut
 137
 138 sub related_resultset {
 139   my $self = shift;
 140   $self->throw_exception("Can't call *_related as class methods")
 141     unless ref $self;
 142   my $rel = shift;
 143   my $rel_obj = $self->relationship_info($rel);
 144   $self->throw_exception( "No such relationship ${rel}" )
 145     unless $rel_obj;
 146
 147   return $self->{related_resultsets}{$rel} ||= do {
 148     my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 149     $attrs = { %{$rel_obj->{attrs} || {}}, %$attrs };
 150
 151     $self->throw_exception( "Invalid query: @_" )
 152       if (@_ > 1 && (@_ % 2 == 1));
 153     my $query = ((@_ > 1) ? {@_} : shift);
 154
 155     my $cond = $self->result_source->resolve_condition(
 156       $rel_obj->{cond}, $rel, $self
 157     );
 158     if (ref $cond eq 'ARRAY') {
 159       $cond = [ map { my $hash;
 160         foreach my $key (keys %$_) {
 161           my $newkey = $key =~ /\./ ? "me.$key" : $key;
 162           $hash->{$newkey} = $_->{$key};
 163         }; $hash } @$cond ];
 164     } else {
 165       foreach my $key (grep { ! /\./ } keys %$cond) {
 166         $cond->{"me.$key"} = delete $cond->{$key};
 167       }
 168     }
 169     $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
 170     $self->result_source->related_source($rel)->resultset->search(
 171       $query, $attrs
 172     );
 173   };
 174 }
 175
 176 =head2 search_related
 177
 178   @objects = $rs->search_related('relname', $cond, $attrs);
 179   $objects_rs = $rs->search_related('relname', $cond, $attrs);
 180
 181 Run a search on a related resultset. The search will be restricted to the
 182 item or items represented by the L<DBIx::Class::ResultSet> it was called
 183 upon. This method can be called on a ResultSet, a Row or a ResultSource class.
 184
 185 =cut
 186
 187 sub search_related {
 188   return shift->related_resultset(shift)->search(@_);
 189 }
 190
 191 =head2 search_related_rs
 192
 193   ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs);
 194
 195 This method works exactly the same as search_related, except that
 196 it garauntees a restultset, even in list context.
 197
 198 =cut
 199
 200 sub search_related_rs {
 201   return shift->related_resultset(shift)->search_rs(@_);
 202 }
 203
 204 =head2 count_related
 205
 206   $obj->count_related('relname', $cond, $attrs);
 207
 208 Returns the count of all the items in the related resultset, restricted by the
 209 current item or where conditions. Can be called on a
 210 L<DBIx::Class::Manual::Glossary/"ResultSet"> or a
 211 L<DBIx::Class::Manual::Glossary/"Row"> object.
 212
 213 =cut
 214
 215 sub count_related {
 216   my $self = shift;
 217   return $self->search_related(@_)->count;
 218 }
 219
 220 =head2 new_related
 221
 222   my $new_obj = $obj->new_related('relname', \%col_data);
 223
 224 Create a new item of the related foreign class. If called on a
 225 L<DBIx::Class::Manual::Glossary/"Row"> object, it will magically set any
 226 primary key values into foreign key columns for you. The newly created item
 227 will not be saved into your storage until you call L<DBIx::Class::Row/insert>
 228 on it.
 229
 230 =cut
 231
 232 sub new_related {
 233   my ($self, $rel, $values, $attrs) = @_;
 234   return $self->search_related($rel)->new($values, $attrs);
 235 }
 236
 237 =head2 create_related
 238
 239   my $new_obj = $obj->create_related('relname', \%col_data);
 240
 241 Creates a new item, similarly to new_related, and also inserts the item's data
 242 into your storage medium. See the distinction between C<create> and C<new>
 243 in L<DBIx::Class::ResultSet> for details.
 244
 245 =cut
 246
 247 sub create_related {
 248   my $self = shift;
 249   my $rel = shift;
 250   my $obj = $self->search_related($rel)->create(@_);
 251   delete $self->{related_resultsets}->{$rel};
 252   return $obj;
 253 }
 254
 255 =head2 find_related
 256
 257   my $found_item = $obj->find_related('relname', @pri_vals | \%pri_vals);
 258
 259 Attempt to find a related object using its primary key or unique constraints.
 260 See L<DBIx::Class::ResultSet/find> for details.
 261
 262 =cut
 263
 264 sub find_related {
 265   my $self = shift;
 266   my $rel = shift;
 267   return $self->search_related($rel)->find(@_);
 268 }
 269
 270 =head2 find_or_new_related
 271
 272   my $new_obj = $obj->find_or_new_related('relname', \%col_data);
 273
 274 Find an item of a related class. If none exists, instantiate a new item of the
 275 related class. The object will not be saved into your storage until you call
 276 L<DBIx::Class::Row/insert> on it.
 277
 278 =cut
 279
 280 sub find_or_new_related {
 281   my $self = shift;
 282   return $self->find_related(@_) || $self->new_related(@_);
 283 }
 284
 285 =head2 find_or_create_related
 286
 287   my $new_obj = $obj->find_or_create_related('relname', \%col_data);
 288
 289 Find or create an item of a related class. See
 290 L<DBIx::Class::ResultSet/find_or_create> for details.
 291
 292 =cut
 293
 294 sub find_or_create_related {
 295   my $self = shift;
 296   my $obj = $self->find_related(@_);
 297   return (defined($obj) ? $obj : $self->create_related(@_));
 298 }
 299
 300 =head2 update_or_create_related
 301
 302   my $updated_item = $obj->update_or_create_related('relname', \%col_data, \%attrs?);
 303
 304 Update or create an item of a related class. See
 305 L<DBIx::Class::ResultSet/update_or_create> for details.
 306
 307 =cut
 308
 309 sub update_or_create_related {
 310   my $self = shift;
 311   my $rel = shift;
 312   return $self->related_resultset($rel)->update_or_create(@_);
 313 }
 314
 315 =head2 set_from_related
 316
 317   $book->set_from_related('author', $author_obj);
 318
 319 Set column values on the current object, using related values from the given
 320 related object. This is used to associate previously separate objects, for
 321 example, to set the correct author for a book, find the Author object, then
 322 call set_from_related on the book.
 323
 324 The columns are only set in the local copy of the object, call L</update> to
 325 set them in the storage.
 326
 327 =cut
 328
 329 sub set_from_related {
 330   my ($self, $rel, $f_obj) = @_;
 331   my $rel_obj = $self->relationship_info($rel);
 332   $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
 333   my $cond = $rel_obj->{cond};
 334   $self->throw_exception(
 335     "set_from_related can only handle a hash condition; the ".
 336     "condition for $rel is of type ".
 337     (ref $cond ? ref $cond : 'plain scalar')
 338   ) unless ref $cond eq 'HASH';
 339   if (defined $f_obj) {
 340     my $f_class = $self->result_source->schema->class($rel_obj->{class});
 341     $self->throw_exception( "Object $f_obj isn't a ".$f_class )
 342       unless $f_obj->isa($f_class);
 343   }
 344   $self->set_columns(
 345     $self->result_source->resolve_condition(
 346        $rel_obj->{cond}, $f_obj, $rel));
 347   return 1;
 348 }
 349
 350 =head2 update_from_related
 351
 352   $book->update_from_related('author', $author_obj);
 353
 354 The same as L</"set_from_related">, but the changes are immediately updated
 355 in storage.
 356
 357 =cut
 358
 359 sub update_from_related {
 360   my $self = shift;
 361   $self->set_from_related(@_);
 362   $self->update;
 363 }
 364
 365 =head2 delete_related
 366
 367   $obj->delete_related('relname', $cond, $attrs);
 368
 369 Delete any related item subject to the given conditions.
 370
 371 =cut
 372
 373 sub delete_related {
 374   my $self = shift;
 375   my $obj = $self->search_related(@_)->delete;
 376   delete $self->{related_resultsets}->{$_[0]};
 377   return $obj;
 378 }
 379
 380 1;
 381
 382 =head1 AUTHORS
 383
 384 Matt S. Trout <mst@shadowcatsystems.co.uk>
 385
 386 =head1 LICENSE
 387
 388 You may distribute this code under the same terms as Perl itself.
 389
 390 =cut
 391