lib/DBIx/Class/Relationship/Base.pm

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