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