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