X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBase.pm;h=906307fecb564939aea0f718729eac8f8adfcc27;hb=78b3d153ad874085ee183cfa6ad827089adde583;hp=45909856f66e869935f306b95d1a151d1eff6b2f;hpb=bfab575afa37545ee175b824cea554c9c37ab6f5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 4590985..906307f 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -5,306 +5,857 @@ use warnings; use base qw/DBIx::Class/; -__PACKAGE__->mk_classdata('_relationships', { } ); +use Scalar::Util qw/weaken blessed/; +use Try::Tiny; +use namespace::clean; -=head1 NAME +=head1 NAME DBIx::Class::Relationship::Base - Inter-table relationships =head1 SYNOPSIS + __PACKAGE__->add_relationship( + spiders => 'My::DB::Result::Creatures', + sub { + my $args = shift; + return { + "$args->{foreign_alias}.id" => { -ident => "$args->{self_alias}.id" }, + "$args->{foreign_alias}.type" => 'arachnid' + }; + }, + ); + =head1 DESCRIPTION -This class handles relationships between the tables in your database -model. It allows your to set up relationships, and to perform joins -on searches. +This class provides methods to describe the relationships between the +tables in your database model. These are the "bare bones" relationships +methods, for predefined ones, look in L. =head1 METHODS +=head2 add_relationship + =over 4 -=item add_relationship +=item Arguments: $rel_name, $foreign_class, $condition, $attrs - __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs); +=back -The condition needs to be an SQL::Abstract-style representation of the -join between the tables - for example if you're creating a rel from Foo to Bar + __PACKAGE__->add_relationship('rel_name', + 'Foreign::Class', + $condition, $attrs); - { 'foreign.foo_id' => 'self.id' } +Create a custom relationship between one result source and another +source, indicated by its class name. -will result in a JOIN clause like +=head3 condition - foo me JOIN bar bar ON bar.foo_id = me.id +The condition argument describes the C clause of the C +expression used to connect the two sources when creating SQL queries. -=cut +=head4 Simple equality -sub add_relationship { - my ($class, $rel, $f_class, $cond, $attrs) = @_; - die "Can't create relationship without join condition" unless $cond; - $attrs ||= {}; - eval "require $f_class;"; - if ($@) { - $class->throw($@) unless $@ =~ /Can't locate/; - } - my %rels = %{ $class->_relationships }; - $rels{$rel} = { class => $f_class, - cond => $cond, - attrs => $attrs }; - $class->_relationships(\%rels); - - return unless eval { $f_class->can('columns'); }; # Foreign class not loaded - eval { $class->_resolve_join($rel, 'me') }; - - if ($@) { # If the resolve failed, back out and re-throw the error - delete $rels{$rel}; # - $class->_relationships(\%rels); - $class->throw("Error creating relationship $rel: $@"); - } - 1; -} +To create simple equality joins, supply a hashref containing the remote +table column name as the key(s) prefixed by C<'foreign.'>, and the +corresponding local table column name as the value(s) prefixed by C<'self.'>. +Both C and C are pseudo aliases and must be entered +literally. They will be replaced with the actual correct table alias +when the SQL is produced. -sub _resolve_join { - my ($class, $join, $alias) = @_; - if (ref $join eq 'ARRAY') { - return map { $class->_resolve_join($_, $alias) } @$join; - } elsif (ref $join eq 'HASH') { - return map { $class->_resolve_join($_, $alias), - $class->_relationships->{$_}{class}->_resolve_join($join->{$_}, $_) } - keys %$join; - } elsif (ref $join) { - $class->throw("No idea how to resolve join reftype ".ref $join); - } else { - my $rel_obj = $class->_relationships->{$join}; - $class->throw("No such relationship ${join}") unless $rel_obj; - my $j_class = $rel_obj->{class}; - my %join = (_action => 'join', - _aliases => { 'self' => $alias, 'foreign' => $join }, - _classes => { $alias => $class, $join => $j_class }); - my $j_cond = $j_class->resolve_condition($rel_obj->{cond}, \%join); - return [ { $join => $j_class->_table_name, - -join_type => $rel_obj->{attrs}{join_type} || '' }, $j_cond ]; - } -} +For example given: -sub resolve_condition { - my ($self, $cond, $attrs) = @_; - if (ref $cond eq 'HASH') { - my %ret; - foreach my $key (keys %$cond) { - my $val = $cond->{$key}; - if (ref $val) { - $self->throw("Can't handle this yet :("); - } else { - $ret{$self->_cond_key($attrs => $key)} - = $self->_cond_value($attrs => $key => $val); - } - } - return \%ret; - } else { - $self->throw("Can't handle this yet :("); - } -} + My::Schema::Author->has_many( + books => 'My::Schema::Book', + { 'foreign.author_id' => 'self.id' } + ); + +A query like: + + $author_rs->search_related('books')->next -sub _cond_key { - my ($self, $attrs, $key) = @_; - my $action = $attrs->{_action} || ''; - if ($action eq 'convert') { - unless ($key =~ s/^foreign\.//) { - $self->throw("Unable to convert relationship to WHERE clause: invalid key ${key}"); +will result in the following C clause: + + ... FROM author me LEFT JOIN book books ON books.author_id = me.id ... + +This describes a relationship between the C table and the +C table where the C table has a column C +containing the ID value of the C. + +Similarly: + + My::Schema::Book->has_many( + editions => 'My::Schema::Edition', + { + 'foreign.publisher_id' => 'self.publisher_id', + 'foreign.type_id' => 'self.type_id', } - return $key; - } elsif ($action eq 'join') { - return $key unless $key =~ /\./; - my ($type, $field) = split(/\./, $key); - if (my $alias = $attrs->{_aliases}{$type}) { - my $class = $attrs->{_classes}{$alias}; - $self->throw("Unknown column $field on $class as $alias") - unless $class->has_column($field); - return join('.', $alias, $field); - } else { - $self->throw( "Unable to resolve type ${type}: only have aliases for ". - join(', ', keys %{$attrs->{_aliases} || {}}) ); + ); + + ... + + $book_rs->search_related('editions')->next + +will result in the C clause: + + ... FROM book me + LEFT JOIN edition editions ON + editions.publisher_id = me.publisher_id + AND editions.type_id = me.type_id ... + +This describes the relationship from C to C, where the +C table refers to a publisher and a type (e.g. "paperback"): + +=head4 Multiple groups of simple equality conditions + +As is the default in L, the key-value pairs will be +Ced in the resulting C clause. An C can be achieved with +an arrayref. For example a condition like: + + My::Schema::Item->has_many( + related_item_links => My::Schema::Item::Links, + [ + { 'foreign.left_itemid' => 'self.id' }, + { 'foreign.right_itemid' => 'self.id' }, + ], + ); + +will translate to the following C clause: + + ... FROM item me JOIN item_relations related_item_links ON + related_item_links.left_itemid = me.id + OR related_item_links.right_itemid = me.id ... + +This describes the relationship from C to C, where +C is a many-to-many linking table, linking items back to +themselves in a peer fashion (without a "parent-child" designation) + +=head4 Custom join conditions + + NOTE: The custom join condition specification mechanism is capable of + generating JOIN clauses of virtually unlimited complexity. This may limit + your ability to traverse some of the more involved relationship chains the + way you expect, *and* may bring your RDBMS to its knees. Exercise care + when declaring relationships as described here. + +To specify joins which describe more than a simple equality of column +values, the custom join condition coderef syntax can be used. For +example: + + My::Schema::Artist->has_many( + cds_80s => 'My::Schema::CD', + sub { + my $args = shift; + + return { + "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" }, + "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" }, + }; } + ); + + ... + + $artist_rs->search_related('cds_80s')->next; + +will result in the C clause: + + ... FROM artist me LEFT JOIN cd cds_80s ON + cds_80s.artist = me.artistid + AND cds_80s.year < ? + AND cds_80s.year > ? + +with the bind values: + + '1990', '1979' + +C<< $args->{foreign_alias} >> and C<< $args->{self_alias} >> are supplied the +same values that would be otherwise substituted for C and C +in the simple hashref syntax case. + +The coderef is expected to return a valid L query-structure, just +like what one would supply as the first argument to +L. The return value will be passed directly to +L and the resulting SQL will be used verbatim as the C +clause of the C statement associated with this relationship. + +While every coderef-based condition must return a valid C clause, it may +elect to additionally return a simplified join-free condition hashref when +invoked as C<< $result->relationship >>, as opposed to +C<< $rs->related_resultset('relationship') >>. In this case C<$result> is +passed to the coderef as C<< $args->{self_resultobj} >>, so a user can do the +following: + + sub { + my $args = shift; + + return ( + { + "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" }, + "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" }, + }, + $args->{self_resultobj} && { + "$args->{foreign_alias}.artist" => $args->{self_resultobj}->artistid, + "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" }, + }, + ); } - return $self->next::method($attrs, $key); -} -sub _cond_value { - my ($self, $attrs, $key, $value) = @_; - my $action = $attrs->{_action} || ''; - if ($action eq 'convert') { - unless ($value =~ s/^self\.//) { - $self->throw( "Unable to convert relationship to WHERE clause: invalid value ${value}" ); +Now this code: + + my $artist = $schema->resultset("Artist")->find({ id => 4 }); + $artist->cds_80s->all; + +Can skip a C altogether and instead produce: + + SELECT cds_80s.cdid, cds_80s.artist, cds_80s.title, cds_80s.year, cds_80s.genreid, cds_80s.single_track + FROM cd cds_80s + WHERE cds_80s.artist = ? + AND cds_80s.year < ? + AND cds_80s.year > ? + +With the bind values: + + '4', '1990', '1979' + +Note that in order to be able to use +L<< $result->create_related|DBIx::Class::Relationship::Base/create_related >>, +the coderef must not only return as its second such a "simple" condition +hashref which does not depend on joins being available, but the hashref must +contain only plain values/deflatable objects, such that the result can be +passed directly to L. For +instance the C constraint in the above example prevents the relationship +from being used to create related objects (an exception will be thrown). + +In order to allow the user to go truly crazy when generating a custom C +clause, the C<$args> hashref passed to the subroutine contains some extra +metadata. Currently the supplied coderef is executed as: + + $relationship_info->{cond}->({ + self_resultsource => The resultsource instance on which rel_name is registered + rel_name => The relationship name (does *NOT* always match foreign_alias) + + self_alias => The alias of the invoking resultset + foreign_alias => The alias of the to-be-joined resultset (does *NOT* always match rel_name) + + # only one of these (or none at all) will ever be supplied to aid in the + # construction of a join-free condition + self_resultobj => The invocant object itself in case of a $resultobj->$rel_name() call + foreign_resultobj => The related object in case of $resultobj->set_from_related($rel_name, $foreign_resultobj) + + # deprecated inconsistent names, will be forever available for legacy code + self_rowobj => Old deprecated slot for self_resultobj + foreign_relname => Old deprecated slot for rel_name + }); + +=head3 attributes + +The L may +be used as relationship attributes. In particular, the 'where' attribute is +useful for filtering relationships: + + __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User', + { 'foreign.user_id' => 'self.user_id' }, + { where => { valid => 1 } } + ); + +The following attributes are also valid: + +=over 4 + +=item join_type + +Explicitly specifies the type of join to use in the relationship. Any SQL +join type is valid, e.g. C or C. It will be placed in the SQL +command immediately before C. + +=item proxy =E $column | \@columns | \%column + +The 'proxy' attribute can be used to retrieve values, and to perform +updates if the relationship has 'cascade_update' set. The 'might_have' +and 'has_one' relationships have this set by default; if you want a proxy +to update across a 'belongs_to' relationship, you must set the attribute +yourself. + +=over 4 + +=item \@columns + +An arrayref containing a list of accessors in the foreign class to create in +the main class. If, for example, you do the following: + + MyApp::Schema::CD->might_have(liner_notes => 'MyApp::Schema::LinerNotes', + undef, { + proxy => [ qw/notes/ ], + }); + +Then, assuming MyApp::Schema::LinerNotes has an accessor named notes, you can do: + + my $cd = MyApp::Schema::CD->find(1); + $cd->notes('Notes go here'); # set notes -- LinerNotes object is + # created if it doesn't exist + +For a 'belongs_to relationship, note the 'cascade_update': + + MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd, + { proxy => ['title'], cascade_update => 1 } + ); + $track->title('New Title'); + $track->update; # updates title in CD + +=item \%column + +A hashref where each key is the accessor you want installed in the main class, +and its value is the name of the original in the foreign class. + + MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd', { + proxy => { cd_title => 'title' }, + }); + +This will create an accessor named C on the C<$track> result object. + +=back + +NOTE: you can pass a nested struct too, for example: + + MyApp::Schema::Track->belongs_to( cd => 'MyApp::Schema::CD', 'cd', { + proxy => [ 'year', { cd_title => 'title' } ], + }); + +=item accessor + +Specifies the type of accessor that should be created for the relationship. +Valid values are C (for when there is only a single related object), +C (when there can be many), and C (for when there is a single +related object, but you also want the relationship accessor to double as +a column accessor). For C accessors, an add_to_* method is also +created, which calls C for the relationship. + +=item is_foreign_key_constraint + +If you are using L to create SQL for you and you find that it +is creating constraints where it shouldn't, or not creating them where it +should, set this attribute to a true or false value to override the detection +of when to create constraints. + +=item cascade_copy + +If C is true on a C relationship for an +object, then when you copy the object all the related objects will +be copied too. To turn this behaviour off, pass C<< cascade_copy => 0 >> +in the C<$attr> hashref. + +The behaviour defaults to C<< cascade_copy => 1 >> for C +relationships. + +=item cascade_delete + +By default, DBIx::Class cascades deletes across C, +C and C relationships. You can disable this +behaviour on a per-relationship basis by supplying +C<< cascade_delete => 0 >> in the relationship attributes. + +The cascaded operations are performed after the requested delete, +so if your database has a constraint on the relationship, it will +have deleted/updated the related records or raised an exception +before DBIx::Class gets to perform the cascaded operation. + +=item cascade_update + +By default, DBIx::Class cascades updates across C and +C relationships. You can disable this behaviour on a +per-relationship basis by supplying C<< cascade_update => 0 >> in +the relationship attributes. + +The C relationship does not update across relationships +by default, so if you have a 'proxy' attribute on a belongs_to and want to +use 'update' on it, you muse set C<< cascade_update => 1 >>. + +This is not a RDMS style cascade update - it purely means that when +an object has update called on it, all the related objects also +have update called. It will not change foreign keys automatically - +you must arrange to do this yourself. + +=item on_delete / on_update + +If you are using L to create SQL for you, you can use these +attributes to explicitly set the desired C or C constraint +type. If not supplied the SQLT parser will attempt to infer the constraint type by +interrogating the attributes of the B relationship. For any 'multi' +relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to +relationship will be created with an C constraint. For any +relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint +will be C. If you wish to disable this autodetection, and just +use the RDBMS' default constraint type, pass C<< on_delete => undef >> or +C<< on_delete => '' >>, and the same for C respectively. + +=item is_deferrable + +Tells L that the foreign key constraint it creates should be +deferrable. In other words, the user may request that the constraint be ignored +until the end of the transaction. Currently, only the PostgreSQL producer +actually supports this. + +=item add_fk_index + +Tells L to add an index for this constraint. Can also be +specified globally in the args to L or +L. Default is on, set to 0 to disable. + +=back + +=head2 register_relationship + +=over 4 + +=item Arguments: $rel_name, $rel_info + +=back + +Registers a relationship on the class. This is called internally by +DBIx::Class::ResultSourceProxy to set up Accessors and Proxies. + +=cut + +sub register_relationship { } + +=head2 related_resultset + +=over 4 + +=item Arguments: $rel_name + +=item Return Value: L<$related_resultset|DBIx::Class::ResultSet> + +=back + + $rs = $cd->related_resultset('artist'); + +Returns a L for the relationship named +$rel_name. + +=head2 $relationship_accessor + +=over 4 + +=item Arguments: none + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | L<$related_resultset|DBIx::Class::ResultSet> | undef + +=back + + # These pairs do the same thing + $result = $cd->related_resultset('artist')->single; # has_one relationship + $result = $cd->artist; + $rs = $cd->related_resultset('tracks'); # has_many relationship + $rs = $cd->tracks; + +This is the recommended way to traverse through relationships, based +on the L name given in the relationship definition. + +This will return either a L or a +L, depending on if the relationship is +C (returns only one row) or C (returns many rows). The +method may also return C if the relationship doesn't exist for +this instance (like in the case of C relationships). + +=cut + +sub related_resultset { + my $self = shift; + + $self->throw_exception("Can't call *_related as class methods") + unless ref $self; + + my $rel = shift; + + return $self->{related_resultsets}{$rel} + if defined $self->{related_resultsets}{$rel}; + + return $self->{related_resultsets}{$rel} = do { + + my $rel_info = $self->relationship_info($rel) + or $self->throw_exception( "No such relationship '$rel'" ); + + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + $attrs = { %{$rel_info->{attrs} || {}}, %$attrs }; + + $self->throw_exception( "Invalid query: @_" ) + if (@_ > 1 && (@_ % 2 == 1)); + my $query = ((@_ > 1) ? {@_} : shift); + + my $rsrc = $self->result_source; + + # condition resolution may fail if an incomplete master-object prefetch + # is encountered - that is ok during prefetch construction (not yet in_storage) + my ($cond, $is_crosstable) = try { + $rsrc->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel ) } - unless ($self->has_column($value)) { - $self->throw( "Unable to convert relationship to WHERE clause: no such accessor ${value}" ); + catch { + $self->throw_exception ($_) if $self->in_storage; + $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION; # RV, no return() + }; + + # keep in mind that the following if() block is part of a do{} - no return()s!!! + if ($is_crosstable and ref $rel_info->{cond} eq 'CODE') { + + # A WHOREIFFIC hack to reinvoke the entire condition resolution + # with the correct alias. Another way of doing this involves a + # lot of state passing around, and the @_ positions are already + # mapped out, making this crap a less icky option. + # + # The point of this exercise is to retain the spirit of the original + # $obj->search_related($rel) where the resulting rset will have the + # root alias as 'me', instead of $rel (as opposed to invoking + # $rs->search_related) + + local $rsrc->{_relationships}{me} = $rsrc->{_relationships}{$rel}; # make the fake 'me' rel + my $obj_table_alias = lc($rsrc->source_name) . '__row'; + $obj_table_alias =~ s/\W+/_/g; + + $rsrc->resultset->search( + $self->ident_condition($obj_table_alias), + { alias => $obj_table_alias }, + )->search_related('me', $query, $attrs) } - return $self->get_column($value); - } elsif ($action eq 'join') { - return $key unless $key =~ /\./; - my ($type, $field) = split(/\./, $value); - if (my $alias = $attrs->{_aliases}{$type}) { - my $class = $attrs->{_classes}{$alias}; - $self->throw("Unknown column $field on $class as $alias") - unless $class->has_column($field); - return join('.', $alias, $field); - } else { - $self->throw( "Unable to resolve type ${type}: only have aliases for ". - join(', ', keys %{$attrs->{_aliases} || {}}) ); + else { + # FIXME - this conditional doesn't seem correct - got to figure out + # at some point what it does. Also the entire UNRESOLVABLE_CONDITION + # business seems shady - we could simply not query *at all* + if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { + my $reverse = $rsrc->reverse_relationship_info($rel); + foreach my $rev_rel (keys %$reverse) { + if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') { + weaken($attrs->{related_objects}{$rev_rel}[0] = $self); + } else { + weaken($attrs->{related_objects}{$rev_rel} = $self); + } + } + } + elsif (ref $cond eq 'ARRAY') { + $cond = [ map { + if (ref $_ eq 'HASH') { + my $hash; + foreach my $key (keys %$_) { + my $newkey = $key !~ /\./ ? "me.$key" : $key; + $hash->{$newkey} = $_->{$key}; + } + $hash; + } else { + $_; + } + } @$cond ]; + } + elsif (ref $cond eq 'HASH') { + foreach my $key (grep { ! /\./ } keys %$cond) { + $cond->{"me.$key"} = delete $cond->{$key}; + } + } + + $query = ($query ? { '-and' => [ $cond, $query ] } : $cond); + $rsrc->related_source($rel)->resultset->search( + $query, $attrs + ); } - } - - return $self->next::method($attrs, $key, $value) + }; } -=item search_related +=head2 search_related + +=over 4 + +=item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES> + +=item Return Value: L<$resultset|DBIx::Class::ResultSet> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context) + +=back + +Run a search on a related resultset. The search will be restricted to the +results represented by the L it was called +upon. - My::Table->search_related('relname', $cond, $attrs); +See L for more information. =cut sub search_related { - my $self = shift; - return $self->_query_related('search', @_); + return shift->related_resultset(shift)->search(@_); +} + +=head2 search_related_rs + +This method works exactly the same as search_related, except that +it guarantees a resultset, even in list context. + +=cut + +sub search_related_rs { + return shift->related_resultset(shift)->search_rs(@_); } -=item count_related +=head2 count_related + +=over 4 + +=item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES> - My::Table->count_related('relname', $cond, $attrs); +=item Return Value: $count + +=back + +Returns the count of all the rows in the related resultset, restricted by the +current result or where conditions. =cut sub count_related { - my $self = shift; - return $self->_query_related('count', @_); + shift->search_related(@_)->count; } -sub _query_related { - my $self = shift; - my $meth = shift; - my $rel = shift; - my $attrs = { }; - if (@_ > 1 && ref $_[$#_] eq 'HASH') { - $attrs = { %{ pop(@_) } }; +=head2 new_related + +=over 4 + +=item Arguments: $rel_name, \%col_data + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> + +=back + +Create a new result object of the related foreign class. It will magically set +any foreign key columns of the new object to the related primary key columns +of the source object for you. The newly created result will not be saved into +your storage until you call L on it. + +=cut + +sub new_related { + my ($self, $rel, $values) = @_; + + # FIXME - this is a bad position for this (also an identical copy in + # set_from_related), but I have no saner way to hook, and I absolutely + # want this to throw at least for coderefs, instead of the "insert a NULL + # when it gets hard" insanity --ribasushi + # + # sanity check - currently throw when a complex coderef rel is encountered + # FIXME - should THROW MOAR! + + if (ref $self) { # cdbi calls this as a class method, /me vomits + + my $rsrc = $self->result_source; + my $rel_info = $rsrc->relationship_info($rel) + or $self->throw_exception( "No such relationship '$rel'" ); + my (undef, $crosstable, $nonequality_foreign_columns) = $rsrc->_resolve_condition ( + $rel_info->{cond}, $rel, $self, $rel + ); + + $self->throw_exception("Relationship '$rel' does not resolve to a join-free condition fragment") + if $crosstable; + + if ( + $nonequality_foreign_columns + and + my @unspecified_rel_condition_chunks = grep { ! exists $values->{$_} } @$nonequality_foreign_columns + ) { + $self->throw_exception(sprintf ( + "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s", + $rel, + map { "'$_'" } @unspecified_rel_condition_chunks + )); + } } - my $rel_obj = $self->_relationships->{$rel}; - $self->throw( "No such relationship ${rel}" ) unless $rel_obj; - $attrs = { %{$rel_obj->{attrs} || {}}, %{$attrs || {}} }; - - $self->throw( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1)); - my $query = ((@_ > 1) ? {@_} : shift); - - $attrs->{_action} = 'convert'; # shouldn't we resolve the cond to something - # to merge into the AST really? - my ($cond) = $self->resolve_condition($rel_obj->{cond}, $attrs); - $query = ($query ? { '-and' => [ $cond, $query ] } : $cond); - #use Data::Dumper; warn Dumper($query); - #warn $rel_obj->{class}." $meth $cond ".join(', ', @{$attrs->{bind}||[]}); - delete $attrs->{_action}; - return $self->resolve_class($rel_obj->{class} - )->$meth($query, $attrs); + + return $self->search_related($rel)->new_result($values); } -=item create_related +=head2 create_related + +=over 4 + +=item Arguments: $rel_name, \%col_data + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> + +=back - My::Table->create_related('relname', \%col_data); + my $result = $obj->create_related($rel_name, \%col_data); + +Creates a new result object, similarly to new_related, and also inserts the +result's data into your storage medium. See the distinction between C +and C in L for details. =cut sub create_related { - my $class = shift; - return $class->new_related(@_)->insert; + my $self = shift; + my $rel = shift; + my $obj = $self->new_related($rel, @_)->insert; + delete $self->{related_resultsets}->{$rel}; + return $obj; } -=item new_related +=head2 find_related + +=over 4 + +=item Arguments: $rel_name, \%col_data | @pk_values, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }? + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef + +=back + + my $result = $obj->find_related($rel_name, \%col_data); - My::Table->new_related('relname', \%col_data); +Attempt to find a related object using its primary key or unique constraints. +See L for details. =cut -sub new_related { - my ($self, $rel, $values, $attrs) = @_; - $self->throw( "Can't call new_related as class method" ) - unless ref $self; - $self->throw( "new_related needs a hash" ) - unless (ref $values eq 'HASH'); - my $rel_obj = $self->_relationships->{$rel}; - $self->throw( "No such relationship ${rel}" ) unless $rel_obj; - $self->throw( "Can't abstract implicit create for ${rel}, condition not a hash" ) - unless ref $rel_obj->{cond} eq 'HASH'; - $attrs = { %{$rel_obj->{attrs}}, %{$attrs || {}}, _action => 'convert' }; - - my %fields = %{$self->resolve_condition($rel_obj->{cond},$attrs)}; - $fields{$_} = $values->{$_} for keys %$values; - - return $self->resolve_class($rel_obj->{class})->new(\%fields); +sub find_related { + #my ($self, $rel, @args) = @_; + return shift->search_related(shift)->find(@_); } -=item find_related +=head2 find_or_new_related + +=over 4 + +=item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }? + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> - My::Table->find_related('relname', @pri_vals | \%pri_vals); +=back + +Find a result object of a related class. See L +for details. =cut -sub find_related { +sub find_or_new_related { my $self = shift; - my $rel = shift; - my $rel_obj = $self->_relationships->{$rel}; - $self->throw( "No such relationship ${rel}" ) unless $rel_obj; - my ($cond) = $self->resolve_condition($rel_obj->{cond}, { _action => 'convert' }); - $self->throw( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1)); - my $attrs = { }; - if (@_ > 1 && ref $_[$#_] eq 'HASH') { - $attrs = { %{ pop(@_) } }; - } - my $query = ((@_ > 1) ? {@_} : shift); - $query = ($query ? { '-and' => [ $cond, $query ] } : $cond); - return $self->resolve_class($rel_obj->{class})->find($query); + my $obj = $self->find_related(@_); + return defined $obj ? $obj : $self->new_related(@_); } -=item find_or_create_related +=head2 find_or_create_related + +=over 4 + +=item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }? - My::Table->find_or_create_related('relname', \%col_data); +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> + +=back + +Find or create a result object of a related class. See +L for details. =cut sub find_or_create_related { my $self = shift; - return $self->find_related(@_) || $self->create_related(@_); + my $obj = $self->find_related(@_); + return (defined($obj) ? $obj : $self->create_related(@_)); +} + +=head2 update_or_create_related + +=over 4 + +=item Arguments: $rel_name, \%col_data, { key => $unique_constraint, L<%attrs|DBIx::Class::ResultSet/ATTRIBUTES> }? + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> + +=back + +Update or create a result object of a related class. See +L for details. + +=cut + +sub update_or_create_related { + #my ($self, $rel, @args) = @_; + shift->related_resultset(shift)->update_or_create(@_); } -=item set_from_related +=head2 set_from_related + +=over 4 + +=item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass> + +=item Return Value: not defined + +=back + + $book->set_from_related('author', $author_obj); + $book->author($author_obj); ## same thing + +Set column values on the current object, using related values from the given +related object. This is used to associate previously separate objects, for +example, to set the correct author for a book, find the Author object, then +call set_from_related on the book. + +This is called internally when you pass existing objects as values to +L, or pass an object to a belongs_to accessor. - My::Table->set_from_related('relname', $rel_obj); +The columns are only set in the local copy of the object, call L to +set them in the storage. =cut sub set_from_related { my ($self, $rel, $f_obj) = @_; - my $rel_obj = $self->_relationships->{$rel}; - $self->throw( "No such relationship ${rel}" ) unless $rel_obj; - my $cond = $rel_obj->{cond}; - $self->throw( "set_from_related can only handle a hash condition; the " - ."condition for $rel is of type ".(ref $cond ? ref $cond : 'plain scalar')) - unless ref $cond eq 'HASH'; - my $f_class = $self->resolve_class($rel_obj->{class}); - $self->throw( "Object $f_obj isn't a ".$f_class ) - unless $f_obj->isa($f_class); - foreach my $key (keys %$cond) { - next if ref $cond->{$key}; # Skip literals and complex conditions - $self->throw("set_from_related can't handle $key as key") - unless $key =~ m/^foreign\.([^\.]+)$/; - my $val = $f_obj->get_column($1); - $self->throw("set_from_related can't handle ".$cond->{$key}." as value") - unless $cond->{$key} =~ m/^self\.([^\.]+)$/; - $self->set_column($1 => $val); + + my $rsrc = $self->result_source; + my $rel_info = $rsrc->relationship_info($rel) + or $self->throw_exception( "No such relationship '$rel'" ); + + if (defined $f_obj) { + my $f_class = $rel_info->{class}; + $self->throw_exception( "Object '$f_obj' isn't a ".$f_class ) + unless blessed $f_obj and $f_obj->isa($f_class); } + + + # FIXME - this is a bad position for this (also an identical copy in + # new_related), but I have no saner way to hook, and I absolutely + # want this to throw at least for coderefs, instead of the "insert a NULL + # when it gets hard" insanity --ribasushi + # + # sanity check - currently throw when a complex coderef rel is encountered + # FIXME - should THROW MOAR! + my ($cond, $crosstable, $nonequality_foreign_columns) = $rsrc->_resolve_condition ( + $rel_info->{cond}, $f_obj, $rel, $rel + ); + $self->throw_exception("Relationship '$rel' does not resolve to a join-free condition fragment") + if $crosstable; + + $self->throw_exception(sprintf ( + "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s", + $rel, + map { "'$_'" } @$nonequality_foreign_columns + )) if $nonequality_foreign_columns; + + $self->set_columns($cond); + return 1; } -=item update_from_related +=head2 update_from_related + +=over 4 + +=item Arguments: $rel_name, L<$result|DBIx::Class::Manual::ResultClass> - My::Table->update_from_related('relname', $rel_obj); +=item Return Value: not defined + +=back + + $book->update_from_related('author', $author_obj); + +The same as L, but the changes are immediately updated +in storage. =cut @@ -314,24 +865,138 @@ sub update_from_related { $self->update; } -=item delete_related +=head2 delete_related + +=over 4 + +=item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES> + +=item Return Value: $underlying_storage_rv + +=back + +Delete any related row, subject to the given conditions. Internally, this +calls: + + $self->search_related(@_)->delete - My::Table->delete_related('relname', $cond, $attrs); +And returns the result of that. =cut sub delete_related { my $self = shift; - return $self->search_related(@_)->delete; + my $obj = $self->search_related(@_)->delete; + delete $self->{related_resultsets}->{$_[0]}; + return $obj; } -1; +=head2 add_to_$rel + +B, C and 'multi' type +relationships.> + +=head3 has_many / multi + +=over 4 + +=item Arguments: \%col_data + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> =back -=head1 AUTHORS +Creates/inserts a new result object. Internally, this calls: + + $self->create_related($rel, @_) -Matt S. Trout +And returns the result of that. + +=head3 many_to_many + +=over 4 + +=item Arguments: (\%col_data | L<$result|DBIx::Class::Manual::ResultClass>), \%link_col_data? + +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> + +=back + + my $role = $schema->resultset('Role')->find(1); + $actor->add_to_roles($role); + # creates a My::DBIC::Schema::ActorRoles linking table result object + + $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 }); + # creates a new My::DBIC::Schema::Role result object and the linking table + # object with an extra column in the link + +Adds a linking table object. If the first argument is a hash reference, the +related object is created first with the column values in the hash. If an object +reference is given, just the linking table object is created. In either case, +any additional column values for the linking table object can be specified in +C<\%link_col_data>. + +See L for additional details. + +=head2 set_$rel + +B relationships.> + +=over 4 + +=item Arguments: (\@hashrefs_of_col_data | L<\@result_objs|DBIx::Class::Manual::ResultClass>), $link_vals? + +=item Return Value: not defined + +=back + + my $actor = $schema->resultset('Actor')->find(1); + my @roles = $schema->resultset('Role')->search({ role => + { '-in' => ['Fred', 'Barney'] } } ); + + $actor->set_roles(\@roles); + # Replaces all of $actor's previous roles with the two named + + $actor->set_roles(\@roles, { salary => 15_000_000 }); + # Sets a column in the link table for all roles + + +Replace all the related objects with the given reference to a list of +objects. This does a C B to remove the +association between the current object and all related objects, then calls +C repeatedly to link all the new objects. + +Note that this means that this method will B delete any objects in the +table on the right side of the relation, merely that it will delete the link +between them. + +Due to a mistake in the original implementation of this method, it will also +accept a list of objects or hash references. This is B and will be +removed in a future version. + +=head2 remove_from_$rel + +B relationships.> + +=over 4 + +=item Arguments: L<$result|DBIx::Class::Manual::ResultClass> + +=item Return Value: not defined + +=back + + my $role = $schema->resultset('Role')->find(1); + $actor->remove_from_roles($role); + # removes $role's My::DBIC::Schema::ActorRoles linking table result object + +Removes the link between the current object and the related object. Note that +the related object itself won't be deleted unless you call ->delete() on +it. This method just removes the link between the two objects. + +=head1 AUTHOR AND CONTRIBUTORS + +See L and L in DBIx::Class =head1 LICENSE @@ -339,3 +1004,4 @@ You may distribute this code under the same terms as Perl itself. =cut +1;