File Coverage

blib/lib/DBIx/Class/Relationship/Base.pm
Criterion Covered Total %
statement 121 126 96.0
branch 29 36 80.5
condition 12 18 66.6
subroutine 30 31 96.7
pod 14 14 100.0
total 206 225 91.5


line stmt bran cond sub pod time code
1             package DBIx::Class::Relationship::Base;
2              
3 312     312   133605 use strict;
  312         773  
  312         8959  
4 312     312   1615 use warnings;
  312         661  
  312         8553  
5              
6 312     312   1678 use base qw/DBIx::Class/;
  312         649  
  312         30022  
7              
8 312     312   2074 use Scalar::Util qw/weaken blessed/;
  312         684  
  312         18540  
9 312         19369 use DBIx::Class::_Util qw(
10             UNRESOLVABLE_CONDITION DUMMY_ALIASPAIR
11             dbic_internal_try dbic_internal_catch fail_on_internal_call
12 312     312   2543 );
  312         729  
13 312     312   100869 use DBIx::Class::SQLMaker::Util 'extract_equality_conditions';
  312         1060  
  312         22334  
14 312     312   2693 use DBIx::Class::Carp;
  312         881  
  312         3622  
15              
16             # FIXME - this should go away
17             # instead Carp::Skip should export usable keywords or something like that
18             my $unique_carper;
19 312     312   6618 BEGIN { $unique_carper = \&carp_unique }
20              
21 312     312   2138 use namespace::clean;
  312         809  
  312         2790  
22              
23             =head1 NAME
24              
25             DBIx::Class::Relationship::Base - Inter-table relationships
26              
27             =head1 SYNOPSIS
28              
29             __PACKAGE__->add_relationship(
30             spiders => 'My::DB::Result::Creatures',
31             sub {
32             my $args = shift;
33             return {
34             "$args->{foreign_alias}.id" => { -ident => "$args->{self_alias}.id" },
35             "$args->{foreign_alias}.type" => 'arachnid'
36             };
37             },
38             );
39              
40             =head1 DESCRIPTION
41              
42             This class provides methods to describe the relationships between the
43             tables in your database model. These are the "bare bones" relationships
44             methods, for predefined ones, look in L.
45              
46             =head1 METHODS
47              
48             =head2 add_relationship
49              
50             =over 4
51              
52             =item Arguments: $rel_name, $foreign_class, $condition, $attrs
53              
54             =back
55              
56             __PACKAGE__->add_relationship('rel_name',
57             'Foreign::Class',
58             $condition, $attrs);
59              
60             Create a custom relationship between one result source and another
61             source, indicated by its class name.
62              
63             =head3 condition
64              
65             The condition argument describes the C clause of the C
66             expression used to connect the two sources when creating SQL queries.
67              
68             =head4 Simple equality
69              
70             To create simple equality joins, supply a hashref containing the remote
71             table column name as the key(s) prefixed by C<'foreign.'>, and the
72             corresponding local table column name as the value(s) prefixed by C<'self.'>.
73             Both C and C are pseudo aliases and must be entered
74             literally. They will be replaced with the actual correct table alias
75             when the SQL is produced.
76              
77             For example given:
78              
79             My::Schema::Author->has_many(
80             books => 'My::Schema::Book',
81             { 'foreign.author_id' => 'self.id' }
82             );
83              
84             A query like:
85              
86             $author_rs->search_related('books')->next
87              
88             will result in the following C clause:
89              
90             ... FROM author me LEFT JOIN book books ON books.author_id = me.id ...
91              
92             This describes a relationship between the C table and the
93             C table where the C table has a column C
94             containing the ID value of the C.
95              
96             Similarly:
97              
98             My::Schema::Book->has_many(
99             editions => 'My::Schema::Edition',
100             {
101             'foreign.publisher_id' => 'self.publisher_id',
102             'foreign.type_id' => 'self.type_id',
103             }
104             );
105              
106             ...
107              
108             $book_rs->search_related('editions')->next
109              
110             will result in the C clause:
111              
112             ... FROM book me
113             LEFT JOIN edition editions ON
114             editions.publisher_id = me.publisher_id
115             AND editions.type_id = me.type_id ...
116              
117             This describes the relationship from C to C, where the
118             C table refers to a publisher and a type (e.g. "paperback"):
119              
120             =head4 Multiple groups of simple equality conditions
121              
122             As is the default in L, the key-value pairs will be
123             Ced in the resulting C clause. An C can be achieved with
124             an arrayref. For example a condition like:
125              
126             My::Schema::Item->has_many(
127             related_item_links => My::Schema::Item::Links,
128             [
129             { 'foreign.left_itemid' => 'self.id' },
130             { 'foreign.right_itemid' => 'self.id' },
131             ],
132             );
133              
134             will translate to the following C clause:
135              
136             ... FROM item me JOIN item_relations related_item_links ON
137             related_item_links.left_itemid = me.id
138             OR related_item_links.right_itemid = me.id ...
139              
140             This describes the relationship from C to C, where
141             C is a many-to-many linking table, linking items back to
142             themselves in a peer fashion (without a "parent-child" designation)
143              
144             =head4 Custom join conditions
145              
146             NOTE: The custom join condition specification mechanism is capable of
147             generating JOIN clauses of virtually unlimited complexity. This may limit
148             your ability to traverse some of the more involved relationship chains the
149             way you expect, *and* may bring your RDBMS to its knees. Exercise care
150             when declaring relationships as described here.
151              
152             To specify joins which describe more than a simple equality of column
153             values, the custom join condition coderef syntax can be used. For
154             example:
155              
156             My::Schema::Artist->has_many(
157             cds_80s => 'My::Schema::CD',
158             sub {
159             my $args = shift;
160              
161             return {
162             "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
163             "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" },
164             };
165             }
166             );
167              
168             ...
169              
170             $artist_rs->search_related('cds_80s')->next;
171              
172             will result in the C clause:
173              
174             ... FROM artist me LEFT JOIN cd cds_80s ON
175             cds_80s.artist = me.artistid
176             AND cds_80s.year < ?
177             AND cds_80s.year > ?
178              
179             with the bind values:
180              
181             '1990', '1979'
182              
183             C<< $args->{foreign_alias} >> and C<< $args->{self_alias} >> are supplied the
184             same values that would be otherwise substituted for C and C
185             in the simple hashref syntax case.
186              
187             The coderef is expected to return a valid L query-structure, just
188             like what one would supply as the first argument to
189             L. The return value will be passed directly to
190             L and the resulting SQL will be used verbatim as the C
191             clause of the C statement associated with this relationship.
192              
193             While every coderef-based condition must return a valid C clause, it may
194             elect to additionally return a simplified B join-free condition
195             consisting of a hashref with B
196             declared on the corresponding result source>. This boils down to two scenarios:
197              
198             =over
199              
200             =item *
201              
202             When relationship resolution is invoked after C<< $result->$rel_name >>, as
203             opposed to C<< $rs->related_resultset($rel_name) >>, the C<$result> object
204             is passed to the coderef as C<< $args->{self_result_object} >>.
205              
206             =item *
207              
208             Alternatively when the user-space invokes resolution via
209             C<< $result->set_from_related( $rel_name => $foreign_values_or_object ) >>, the
210             corresponding data is passed to the coderef as C<< $args->{foreign_values} >>,
211             B in the form of a hashref. If a foreign result object is supplied
212             (which is valid usage of L), its values will be extracted
213             into hashref form by calling L.
214              
215             =back
216              
217             Note that the above scenarios are mutually exclusive, that is you will be supplied
218             none or only one of C and C. In other words if
219             you define your condition coderef as:
220              
221             sub {
222             my $args = shift;
223              
224             return (
225             {
226             "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
227             "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" },
228             },
229             ! $args->{self_result_object} ? () : {
230             "$args->{foreign_alias}.artist" => $args->{self_result_object}->artistid,
231             "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" },
232             },
233             ! $args->{foreign_values} ? () : {
234             "$args->{self_alias}.artistid" => $args->{foreign_values}{artist},
235             }
236             );
237             }
238              
239             Then this code:
240              
241             my $artist = $schema->resultset("Artist")->find({ id => 4 });
242             $artist->cds_80s->all;
243              
244             Can skip a C altogether and instead produce:
245              
246             SELECT cds_80s.cdid, cds_80s.artist, cds_80s.title, cds_80s.year, cds_80s.genreid, cds_80s.single_track
247             FROM cd cds_80s
248             WHERE cds_80s.artist = ?
249             AND cds_80s.year < ?
250             AND cds_80s.year > ?
251              
252             With the bind values:
253              
254             '4', '1990', '1979'
255              
256             While this code:
257              
258             my $cd = $schema->resultset("CD")->search({ artist => 1 }, { rows => 1 })->single;
259             my $artist = $schema->resultset("Artist")->new({});
260             $artist->set_from_related('cds_80s');
261              
262             Will properly set the C<< $artist->artistid >> field of this new object to C<1>
263              
264             Note that in order to be able to use L (and by extension
265             L<< $result->create_related|DBIx::Class::Relationship::Base/create_related >>),
266             the returned join free condition B contain only plain values/deflatable
267             objects. For instance the C constraint in the above example prevents
268             the relationship from being used to create related objects using
269             C<< $artst->create_related( cds_80s => { title => 'blah' } ) >> (an
270             exception will be thrown).
271              
272             In order to allow the user to go truly crazy when generating a custom C
273             clause, the C<$args> hashref passed to the subroutine contains some extra
274             metadata. Currently the supplied coderef is executed as:
275              
276             $relationship_info->{cond}->({
277             self_resultsource => The resultsource instance on which rel_name is registered
278             rel_name => The relationship name (does *NOT* always match foreign_alias)
279              
280             self_alias => The alias of the invoking resultset
281             foreign_alias => The alias of the to-be-joined resultset (does *NOT* always match rel_name)
282              
283             # only one of these (or none at all) will ever be supplied to aid in the
284             # construction of a join-free condition
285              
286             self_result_object => The invocant *object* itself in case of a call like
287             $result_object->$rel_name( ... )
288              
289             foreign_values => A *hashref* of related data: may be passed in directly or
290             derived via ->get_columns() from a related object in case of
291             $result_object->set_from_related( $rel_name, $foreign_result_object )
292              
293             # deprecated inconsistent names, will be forever available for legacy code
294             self_rowobj => Old deprecated slot for self_result_object
295             foreign_relname => Old deprecated slot for rel_name
296             });
297              
298             =head3 attributes
299              
300             The L may
301             be used as relationship attributes. In particular, the 'where' attribute is
302             useful for filtering relationships:
303              
304             __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User',
305             { 'foreign.user_id' => 'self.user_id' },
306             { where => { valid => 1 } }
307             );
308              
309             The following attributes are also valid:
310              
311             =over 4
312              
313             =item join_type
314              
315             Explicitly specifies the type of join to use in the relationship. Any SQL
316             join type is valid, e.g. C or C. It will be placed in the SQL
317             command immediately before C.
318              
319             =item proxy =E $column | \@columns | \%column
320              
321             The 'proxy' attribute can be used to retrieve values, and to perform
322             updates if the relationship has 'cascade_update' set. The 'might_have'
323             and 'has_one' relationships have this set by default; if you want a proxy
324             to update across a 'belongs_to' relationship, you must set the attribute
325             yourself.
326              
327             =over 4
328              
329             =item \@columns
330              
331             An arrayref containing a list of accessors in the foreign class to create in
332             the main class. If, for example, you do the following:
333              
334             MyApp::Schema::CD->might_have(liner_notes => 'MyApp::Schema::LinerNotes',
335             undef, {
336             proxy => [ qw/notes/ ],
337             });
338              
339             Then, assuming MyApp::Schema::LinerNotes has an accessor named notes, you can do:
340              
341             my $cd = MyApp::Schema::CD->find(1);
342             $cd->notes('Notes go here'); # set notes -- LinerNotes object is
343             # created if it doesn't exist
344              
345             For a 'belongs_to relationship, note the 'cascade_update':
346              
347             MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd,
348             { proxy => ['title'], cascade_update => 1 }
349             );
350             $track->title('New Title');
351             $track->update; # updates title in CD
352              
353             =item \%column
354              
355             A hashref where each key is the accessor you want installed in the main class,
356             and its value is the name of the original in the foreign class.
357              
358             MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd', {
359             proxy => { cd_title => 'title' },
360             });
361              
362             This will create an accessor named C on the C<$track> result object.
363              
364             =back
365              
366             NOTE: you can pass a nested struct too, for example:
367              
368             MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd', {
369             proxy => [ 'year', { cd_title => 'title' } ],
370             });
371              
372             =item accessor
373              
374             Specifies the type of accessor that should be created for the relationship.
375             Valid values are C (for when there is only a single related object),
376             C (when there can be many), and C (for when there is a single
377             related object, but you also want the relationship accessor to double as
378             a column accessor). For C accessors, an add_to_* method is also
379             created, which calls C for the relationship.
380              
381             =item is_foreign_key_constraint
382              
383             If you are using L to create SQL for you and you find that it
384             is creating constraints where it shouldn't, or not creating them where it
385             should, set this attribute to a true or false value to override the detection
386             of when to create constraints.
387              
388             =item cascade_copy
389              
390             If C is true on a C relationship for an
391             object, then when you copy the object all the related objects will
392             be copied too. To turn this behaviour off, pass C<< cascade_copy => 0 >>
393             in the C<$attr> hashref.
394              
395             The behaviour defaults to C<< cascade_copy => 1 >> for C
396             relationships.
397              
398             =item cascade_delete
399              
400             By default, DBIx::Class cascades deletes across C,
401             C and C relationships. You can disable this
402             behaviour on a per-relationship basis by supplying
403             C<< cascade_delete => 0 >> in the relationship attributes.
404              
405             The cascaded operations are performed after the requested delete,
406             so if your database has a constraint on the relationship, it will
407             have deleted/updated the related records or raised an exception
408             before DBIx::Class gets to perform the cascaded operation.
409              
410             =item cascade_update
411              
412             By default, DBIx::Class cascades updates across C and
413             C relationships. You can disable this behaviour on a
414             per-relationship basis by supplying C<< cascade_update => 0 >> in
415             the relationship attributes.
416              
417             The C relationship does not update across relationships
418             by default, so if you have a 'proxy' attribute on a belongs_to and want to
419             use 'update' on it, you must set C<< cascade_update => 1 >>.
420              
421             This is not a RDMS style cascade update - it purely means that when
422             an object has update called on it, all the related objects also
423             have update called. It will not change foreign keys automatically -
424             you must arrange to do this yourself.
425              
426             =item on_delete / on_update
427              
428             If you are using L to create SQL for you, you can use these
429             attributes to explicitly set the desired C or C constraint
430             type. If not supplied the SQLT parser will attempt to infer the constraint type by
431             interrogating the attributes of the B relationship. For any 'multi'
432             relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to
433             relationship will be created with an C constraint. For any
434             relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint
435             will be C. If you wish to disable this autodetection, and just
436             use the RDBMS' default constraint type, pass C<< on_delete => undef >> or
437             C<< on_delete => '' >>, and the same for C respectively.
438              
439             =item is_deferrable
440              
441             Tells L that the foreign key constraint it creates should be
442             deferrable. In other words, the user may request that the constraint be ignored
443             until the end of the transaction. Currently, only the PostgreSQL producer
444             actually supports this.
445              
446             =item add_fk_index
447              
448             Tells L to add an index for this constraint. Can also be
449             specified globally in the args to L or
450             L. Default is on, set to 0 to disable.
451              
452             =back
453              
454             =head2 register_relationship
455              
456             =over 4
457              
458             =item Arguments: $rel_name, $rel_info
459              
460             =back
461              
462             Registers a relationship on the class. This is called internally by
463             DBIx::Class::ResultSourceProxy to set up Accessors and Proxies.
464              
465             =cut
466              
467       23703 1   sub register_relationship { }
468              
469             =head2 related_resultset
470              
471             =over 4
472              
473             =item Arguments: $rel_name
474              
475             =item Return Value: L<$related_resultset|DBIx::Class::ResultSet>
476              
477             =back
478              
479             $rs = $cd->related_resultset('artist');
480              
481             Returns a L for the relationship named
482             $rel_name.
483              
484             =head2 $relationship_accessor
485              
486             =over 4
487              
488             =item Arguments: none
489              
490             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | L<$related_resultset|DBIx::Class::ResultSet> | undef
491              
492             =back
493              
494             # These pairs do the same thing
495             $result = $cd->related_resultset('artist')->single; # has_one relationship
496             $result = $cd->artist;
497             $rs = $cd->related_resultset('tracks'); # has_many relationship
498             $rs = $cd->tracks;
499              
500             This is the recommended way to traverse through relationships, based
501             on the L name given in the relationship definition.
502              
503             This will return either a L or a
504             L, depending on if the relationship is
505             C (returns only one row) or C (returns many rows). The
506             method may also return C if the relationship doesn't exist for
507             this instance (like in the case of C relationships).
508              
509             =cut
510              
511             sub related_resultset {
512 3185 50   3185 1 127141 $_[0]->throw_exception(
513             '$result->related_resultset() no longer accepts extra search arguments, '
514             . 'you need to switch to ...->related_resultset($relname)->search_rs(...) '
515             . 'instead (it was never documented and more importantly could never work '
516             . 'reliably due to the heavy caching involved)'
517             ) if @_ > 2;
518              
519 3185 50       13464 $_[0]->throw_exception("Can't call *_related as class methods")
520             unless ref $_[0];
521              
522             return $_[0]->{related_resultsets}{$_[1]}
523 3185 100       17904 if defined $_[0]->{related_resultsets}{$_[1]};
524              
525 2363         6661 my ($self, $rel) = @_;
526              
527 2363         9995 my $rsrc = $self->result_source;
528              
529 2363 50       80016 my $rel_info = $rsrc->relationship_info($rel)
530             or $self->throw_exception( "No such relationship '$rel'" );
531              
532 2363         9238 my $relcond_is_freeform = ref $rel_info->{cond} eq 'CODE';
533              
534 2363   100     26143 my $rrc_args = {
535             rel_name => $rel,
536             self_result_object => $self,
537              
538             # an extra sanity check guard
539             require_join_free_condition => !!(
540             ! $relcond_is_freeform
541             and
542             $self->in_storage
543             ),
544              
545             # an API where these are optional would be too cumbersome,
546             # instead always pass in some dummy values
547             DUMMY_ALIASPAIR,
548              
549             # this may look weird, but remember that we are making a resultset
550             # out of an existing object, with the new source being at the head
551             # of the FROM chain. Having a 'me' alias is nothing but expected there
552             foreign_alias => 'me',
553             };
554              
555             my $jfc = (
556             # In certain extraordinary circumstances the relationship resolution may
557             # throw (e.g. when walking through elaborate custom conds)
558             # In case the object is "real" (i.e. in_storage) we just go ahead and
559             # let the exception surface. Otherwise we carp and move on.
560             #
561             # The elaborate code-duplicating ternary is there because the xsified
562             # ->in_storage() is orders of magnitude faster than the Try::Tiny-like
563             # construct below ( perl's low level tooling is truly shit :/ )
564             ( $self->in_storage or DBIx::Class::_Util::in_internal_try )
565             ? $rsrc->resolve_relationship_condition($rrc_args)->{join_free_condition}
566             : dbic_internal_try {
567             $rsrc->resolve_relationship_condition($rrc_args)->{join_free_condition}
568 631     631   2528 }
569             dbic_internal_catch {
570 0     0   0 $unique_carper->(
571             "Resolution of relationship '$rel' failed unexpectedly, "
572             . 'please relay the following error and seek assistance via '
573             . DBIx::Class::_ENV_::HELP_URL . ". Encountered error: $_"
574             );
575              
576             # FIXME - this is questionable
577             # force skipping re-resolution, and instead just return an UC rset
578 0         0 $relcond_is_freeform = 0;
579              
580             # RV
581 0         0 undef;
582             }
583 2363 100 100     21902 );
584              
585 2353         12634 my $rel_rset;
586              
587 2353 100       7046 if( defined $jfc ) {
    100          
588              
589             $rel_rset = $rsrc->related_source($rel)->resultset->search_rs(
590             $jfc,
591             $rel_info->{attrs},
592 2194         8984 );
593             }
594             elsif( $relcond_is_freeform ) {
595              
596             # A WHOREIFFIC hack to reinvoke the entire condition resolution
597             # with the correct alias. Another way of doing this involves a
598             # lot of state passing around, and the @_ positions are already
599             # mapped out, making this crap a less icky option.
600             #
601             # The point of this exercise is to retain the spirit of the original
602             # $obj->search_related($rel) where the resulting rset will have the
603             # root alias as 'me', instead of $rel (as opposed to invoking
604             # $rs->search_related)
605              
606             # make the fake 'me' rel
607             local $rsrc->{_relationships}{me} = {
608 77         121 %{ $rsrc->{_relationships}{$rel} },
  77         461  
609             _original_name => $rel,
610             };
611              
612 77         1765 my $obj_table_alias = lc($rsrc->source_name) . '__row';
613 77         206 $obj_table_alias =~ s/\W+/_/g;
614              
615             $rel_rset = $rsrc->resultset->search_rs(
616             $self->ident_condition($obj_table_alias),
617             { alias => $obj_table_alias },
618             )->related_resultset('me')->search_rs(undef, $rel_info->{attrs})
619 77         259 }
620             else {
621              
622 82         179 my $attrs = { %{$rel_info->{attrs}} };
  82         606  
623 82         502 my $reverse = $rsrc->reverse_relationship_info($rel);
624              
625             # FIXME - this loop doesn't seem correct - got to figure out
626             # at some point what exactly it does.
627             # See also the FIXME at the end of new_related()
628             ( ( $reverse->{$_}{attrs}{accessor}||'') eq 'multi' )
629             ? weaken( $attrs->{related_objects}{$_}[0] = $self )
630             : weaken( $attrs->{related_objects}{$_} = $self )
631 82 100 50     1687 for keys %$reverse;
632              
633 82         513 $rel_rset = $rsrc->related_source($rel)->resultset->search_rs(
634             UNRESOLVABLE_CONDITION, # guards potential use of the $rs in the future
635             $attrs,
636             );
637             }
638              
639 2353         31536 $self->{related_resultsets}{$rel} = $rel_rset;
640             }
641              
642             =head2 search_related
643              
644             =over 4
645              
646             =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
647              
648             =item Return Value: L<$resultset|DBIx::Class::ResultSet> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
649              
650             =back
651              
652             Run a search on a related resultset. The search will be restricted to the
653             results represented by the L it was called
654             upon.
655              
656             See L for more information.
657              
658             =cut
659              
660             sub search_related :DBIC_method_is_indirect_sugar {
661 48     48 1 18244 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
662 48         274 shift->related_resultset(shift)->search(@_);
663 312     312   325318 }
  312         845  
  312         2790  
664              
665             =head2 search_related_rs
666              
667             This method works exactly the same as search_related, except that
668             it guarantees a resultset, even in list context.
669              
670             =cut
671              
672             sub search_related_rs :DBIC_method_is_indirect_sugar {
673 2     2 1 4 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
674 2         12 shift->related_resultset(shift)->search_rs(@_)
675 312     312   83072 }
  312         849  
  312         1414  
676              
677             =head2 count_related
678              
679             =over 4
680              
681             =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
682              
683             =item Return Value: $count
684              
685             =back
686              
687             Returns the count of all the rows in the related resultset, restricted by the
688             current result or where conditions.
689              
690             =cut
691              
692             sub count_related :DBIC_method_is_indirect_sugar {
693 2     2 1 281 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
694 2         8 shift->related_resultset(shift)->search_rs(@_)->count;
695 312     312   65738 }
  312         814  
  312         1375  
696              
697             =head2 new_related
698              
699             =over 4
700              
701             =item Arguments: $rel_name, \%col_data
702              
703             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
704              
705             =back
706              
707             Create a new result object of the related foreign class. It will magically set
708             any foreign key columns of the new object to the related primary key columns
709             of the source object for you. The newly created result will not be saved into
710             your storage until you call L on it.
711              
712             =cut
713              
714             sub new_related {
715 699     699 1 3271 my ($self, $rel, $data) = @_;
716              
717 699 50       2588 $self->throw_exception(
718             "Result object instantiation requires a hashref as argument"
719             ) unless ref $data eq 'HASH';
720              
721 699         2685 my $rsrc = $self->result_source;
722 699         13394 my $rel_rsrc = $rsrc->related_source($rel);
723              
724             ###
725             ### This section deliberately does not rely on require_join_free_values,
726             ### as quite often the resulting related object is useless without the
727             ### contents of $data mixed in. Originally this code was part of
728             ### resolve_relationship_condition() but given it has a single, very
729             ### context-specific call-site it made no sense to expose it to end users.
730             ###
731              
732 698         6538 my $rel_resolution = $rsrc->resolve_relationship_condition (
733             rel_name => $rel,
734             self_result_object => $self,
735              
736             # In case we are *not* in_storage it is ok to treat failed resolution as an empty hash
737             # This happens e.g. as a result of various in-memory related graph of objects
738             require_join_free_condition => !! $self->in_storage,
739              
740             # dummy aliases with deliberately known lengths, so that we can
741             # quickly strip them below if needed
742             foreign_alias => 'F',
743             self_alias => 'S',
744             );
745              
746             my $rel_values =
747             $rel_resolution->{join_free_values}
748             ||
749 695   100     2368 { map { substr( $_, 2 ) => $rel_resolution->{join_free_condition}{$_} } keys %{ $rel_resolution->{join_free_condition} } }
750             ;
751              
752             # mix everything together
753             my $amalgamated_values = {
754             %{
755             # in case we got back join_free_values - they already have passed the extractor
756 695         1696 $rel_resolution->{join_free_values}
757 695 100       3900 ? $rel_values
758             : extract_equality_conditions(
759             $rel_values,
760             'consider_nulls'
761             )
762             },
763             %$data,
764             };
765              
766             # cleanup possible rogue { somecolumn => [ -and => 1,2 ] }
767             ($amalgamated_values->{$_}||'') eq UNRESOLVABLE_CONDITION
768             and
769             delete $amalgamated_values->{$_}
770 695   50     7114 for keys %$amalgamated_values;
      33        
771              
772 695 100       2134 if( my @nonvalues = grep { ! exists $amalgamated_values->{$_} } keys %$rel_values ) {
  694         3093  
773              
774             $self->throw_exception(
775             "Unable to complete value inferrence - relationship '$rel' "
776 1         35 . "on source '@{[ $rsrc->source_name ]}' results "
777             . 'in expression(s) instead of definitive values: '
778 1         6 . do {
779             # FIXME - used for diag only, but still icky
780             my $sqlm =
781 1     1   6 dbic_internal_try { $rsrc->schema->storage->sql_maker }
782             ||
783             (
784             require DBIx::Class::SQLMaker
785             and
786 1   33     10 DBIx::Class::SQLMaker->new
787             )
788             ;
789 1         7 local $sqlm->{quote_char};
790 1         4 local $sqlm->{_dequalify_idents} = 1;
791 1         5 ($sqlm->_recurse_where({ map { $_ => $rel_values->{$_} } @nonvalues }))[0]
  1         10  
792             }
793             );
794             }
795              
796             # And more complications - in case the relationship did not resolve
797             # we *have* to loop things through search_related ( essentially re-resolving
798             # everything we did so far, but with different type of handholding )
799             # FIXME - this is still a mess, just a *little* better than it was
800             # See also the FIXME at the end of related_resultset()
801             exists $rel_resolution->{join_free_values}
802 694 100       16763 ? $rel_rsrc->result_class->new({ -result_source => $rel_rsrc, %$amalgamated_values })
803             : $self->related_resultset($rel)->new_result( $amalgamated_values )
804             ;
805             }
806              
807             =head2 create_related
808              
809             =over 4
810              
811             =item Arguments: $rel_name, \%col_data
812              
813             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
814              
815             =back
816              
817             my $result = $obj->create_related($rel_name, \%col_data);
818              
819             Creates a new result object, similarly to new_related, and also inserts the
820             result's data into your storage medium. See the distinction between C
821             and C in L for details.
822              
823             =cut
824              
825             sub create_related {
826 660     660 1 6377 my $self = shift;
827 660         1218 my $rel = shift;
828 660         2808 my $obj = $self->new_related($rel, @_)->insert;
829 658         3321 delete $self->{related_resultsets}->{$rel};
830 658         4636 return $obj;
831             }
832              
833             =head2 find_related
834              
835             =over 4
836              
837             =item Arguments: $rel_name, \%col_data | @pk_values, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
838              
839             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
840              
841             =back
842              
843             my $result = $obj->find_related($rel_name, \%col_data);
844              
845             Attempt to find a related object using its primary key or unique constraints.
846             See L for details.
847              
848             =cut
849              
850             sub find_related :DBIC_method_is_indirect_sugar {
851             #my ($self, $rel, @args) = @_;
852 6     6 1 125 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
853 6         47 return shift->related_resultset(shift)->find(@_);
854 312     312   197888 }
  312         868  
  312         1461  
855              
856             =head2 find_or_new_related
857              
858             =over 4
859              
860             =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
861              
862             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
863              
864             =back
865              
866             Find a result object of a related class. See L
867             for details.
868              
869             =cut
870              
871             sub find_or_new_related {
872 312     312 1 794 my $self = shift;
873 312         2581 my $rel = shift;
874 312         1390 my $obj = $self->related_resultset($rel)->find(@_);
875 312 100       15163 return defined $obj ? $obj : $self->related_resultset($rel)->new_result(@_);
876             }
877              
878             =head2 find_or_create_related
879              
880             =over 4
881              
882             =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
883              
884             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
885              
886             =back
887              
888             Find or create a result object of a related class. See
889             L for details.
890              
891             =cut
892              
893             sub find_or_create_related {
894 3     3 1 26 my $self = shift;
895 3         8 my $rel = shift;
896 3         17 my $obj = $self->related_resultset($rel)->find(@_);
897 3 100       29 return (defined($obj) ? $obj : $self->create_related( $rel => @_ ));
898             }
899              
900             =head2 update_or_create_related
901              
902             =over 4
903              
904             =item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }?
905              
906             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
907              
908             =back
909              
910             Update or create a result object of a related class. See
911             L for details.
912              
913             =cut
914              
915             sub update_or_create_related :DBIC_method_is_indirect_sugar {
916             #my ($self, $rel, @args) = @_;
917 8     8 1 111 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
918 8         41 shift->related_resultset(shift)->update_or_create(@_);
919 312     312   96301 }
  312         794  
  312         1322  
920              
921             =head2 set_from_related
922              
923             =over 4
924              
925             =item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass>
926              
927             =item Return Value: not defined
928              
929             =back
930              
931             $book->set_from_related('author', $author_obj);
932             $book->author($author_obj); ## same thing
933              
934             Set column values on the current object, using related values from the given
935             related object. This is used to associate previously separate objects, for
936             example, to set the correct author for a book, find the Author object, then
937             call set_from_related on the book.
938              
939             This is called internally when you pass existing objects as values to
940             L, or pass an object to a belongs_to accessor.
941              
942             The columns are only set in the local copy of the object, call
943             L to update them in the storage.
944              
945             =cut
946              
947             sub set_from_related {
948 655     655 1 2564 my ($self, $rel, $f_obj) = @_;
949              
950             $self->set_columns( $self->result_source->resolve_relationship_condition (
951             require_join_free_values => 1,
952             rel_name => $rel,
953             foreign_values => (
954             # maintain crazy set_from_related interface
955             #
956             ( ! defined $f_obj ) ? +{}
957             : ( ! defined blessed $f_obj ) ? $f_obj
958             : do {
959              
960 651         13224 my $f_result_class = $self->result_source->related_source($rel)->result_class;
961              
962 651 50       5496 unless( $f_obj->isa($f_result_class) ) {
963              
964 0 0       0 $self->throw_exception(
965             'Object supplied to set_from_related() must inherit from '
966             . "'$DBIx::Class::ResultSource::__expected_result_class_isa'"
967             ) unless $f_obj->isa(
968             $DBIx::Class::ResultSource::__expected_result_class_isa
969             );
970              
971 0         0 carp_unique(
972             'Object supplied to set_from_related() usually should inherit from '
973             . "the related ResultClass ('$f_result_class'), perhaps you've made "
974             . 'a mistake?'
975             );
976             }
977              
978 651         2739 +{ $f_obj->get_columns };
979             }
980             ),
981              
982             # an API where these are optional would be too cumbersome,
983             # instead always pass in some dummy values
984             DUMMY_ALIASPAIR,
985              
986 655 100       2433 )->{join_free_values} );
    100          
987              
988 654         5687 return 1;
989             }
990              
991             =head2 update_from_related
992              
993             =over 4
994              
995             =item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass>
996              
997             =item Return Value: not defined
998              
999             =back
1000              
1001             $book->update_from_related('author', $author_obj);
1002              
1003             The same as L, but the changes are immediately updated
1004             in storage.
1005              
1006             =cut
1007              
1008             sub update_from_related {
1009 1     1 1 42 my $self = shift;
1010 1         5 $self->set_from_related(@_);
1011 1         8 $self->update;
1012             }
1013              
1014             =head2 delete_related
1015              
1016             =over 4
1017              
1018             =item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>
1019              
1020             =item Return Value: $underlying_storage_rv
1021              
1022             =back
1023              
1024             Delete any related row, subject to the given conditions. Internally, this
1025             calls:
1026              
1027             $self->search_related(@_)->delete
1028              
1029             And returns the result of that.
1030              
1031             =cut
1032              
1033             sub delete_related {
1034 2     2 1 45 my $self = shift;
1035 2         5 my $rel = shift;
1036 2         17 my $obj = $self->related_resultset($rel)->search_rs(@_)->delete;
1037 2         32 delete $self->{related_resultsets}->{$rel};
1038 2         7 return $obj;
1039             }
1040              
1041             =head2 add_to_$rel
1042              
1043             B, C and 'multi' type
1044             relationships.>
1045              
1046             =head3 has_many / multi
1047              
1048             =over 4
1049              
1050             =item Arguments: \%col_data
1051              
1052             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1053              
1054             =back
1055              
1056             Creates/inserts a new result object. Internally, this calls:
1057              
1058             $self->create_related($rel, @_)
1059              
1060             And returns the result of that.
1061              
1062             =head3 many_to_many
1063              
1064             =over 4
1065              
1066             =item Arguments: (\%col_data | L<$result|DBIx::Class::Manual::ResultClass>), \%link_col_data?
1067              
1068             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1069              
1070             =back
1071              
1072             my $role = $schema->resultset('Role')->find(1);
1073             $actor->add_to_roles($role);
1074             # creates a My::DBIC::Schema::ActorRoles linking table result object
1075              
1076             $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 });
1077             # creates a new My::DBIC::Schema::Role result object and the linking table
1078             # object with an extra column in the link
1079              
1080             Adds a linking table object. If the first argument is a hash reference, the
1081             related object is created first with the column values in the hash. If an object
1082             reference is given, just the linking table object is created. In either case,
1083             any additional column values for the linking table object can be specified in
1084             C<\%link_col_data>.
1085              
1086             See L for additional details.
1087              
1088             =head2 set_$rel
1089              
1090             B relationships.>
1091              
1092             =over 4
1093              
1094             =item Arguments: (\@hashrefs_of_col_data | L<\@result_objs|DBIx::Class::Manual::ResultClass>), $link_vals?
1095              
1096             =item Return Value: not defined
1097              
1098             =back
1099              
1100             my $actor = $schema->resultset('Actor')->find(1);
1101             my @roles = $schema->resultset('Role')->search({ role =>
1102             { '-in' => ['Fred', 'Barney'] } } );
1103              
1104             $actor->set_roles(\@roles);
1105             # Replaces all of $actor's previous roles with the two named
1106              
1107             $actor->set_roles(\@roles, { salary => 15_000_000 });
1108             # Sets a column in the link table for all roles
1109              
1110              
1111             Replace all the related objects with the given reference to a list of
1112             objects. This does a C B to remove the
1113             association between the current object and all related objects, then calls
1114             C repeatedly to link all the new objects.
1115              
1116             Note that this means that this method will B delete any objects in the
1117             table on the right side of the relation, merely that it will delete the link
1118             between them.
1119              
1120             Due to a mistake in the original implementation of this method, it will also
1121             accept a list of objects or hash references. This is B and will be
1122             removed in a future version.
1123              
1124             =head2 remove_from_$rel
1125              
1126             B relationships.>
1127              
1128             =over 4
1129              
1130             =item Arguments: L<$result|DBIx::Class::Manual::ResultClass>
1131              
1132             =item Return Value: not defined
1133              
1134             =back
1135              
1136             my $role = $schema->resultset('Role')->find(1);
1137             $actor->remove_from_roles($role);
1138             # removes $role's My::DBIC::Schema::ActorRoles linking table result object
1139              
1140             Removes the link between the current object and the related object. Note that
1141             the related object itself won't be deleted unless you call ->delete() on
1142             it. This method just removes the link between the two objects.
1143              
1144             =head1 FURTHER QUESTIONS?
1145              
1146             Check the list of L.
1147              
1148             =head1 COPYRIGHT AND LICENSE
1149              
1150             This module is free software L
1151             by the L. You can
1152             redistribute it and/or modify it under the same terms as the
1153             L.
1154              
1155             =cut
1156              
1157             1;