X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBase.pm;h=35ae568eb183efe8289ff8fd5f0d92240695fe6b;hb=b7bbc39f79d4f179f85ef655981bdb68411f0a2a;hp=6f25075232cdb785344583263d7f6c8676e9b871;hpb=70ecd5a103ed5ab8f674df100da40ff47d4ae658;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 6f25075..35ae568 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -3,11 +3,10 @@ package DBIx::Class::Relationship::Base; use strict; use warnings; +use Scalar::Util (); use base qw/DBIx::Class/; -__PACKAGE__->mk_classdata('_relationships', { } ); - -=head1 NAME +=head1 NAME DBIx::Class::Relationship::Base - Inter-table relationships @@ -15,28 +14,73 @@ DBIx::Class::Relationship::Base - Inter-table relationships =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 Arguments: 'relname', 'Foreign::Class', $cond, $attrs + +=back + __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs); -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, +=head3 condition - { 'foreign.foo_id' => 'self.id' } +The condition needs to be an L-style representation of the +join between the tables. When resolving the condition for use in a C, +keys using the pseudo-table C are resolved to mean "the Table on the +other side of the relationship", and values using the pseudo-table C +are resolved to mean "the Table this class is representing". Other +restrictions, such as by value, sub-select and other tables, may also be +used. Please check your database for C parameter support. -will result in the JOIN clause +For example, if you're creating a relationship from C to C, where +the C table has a column C containing the ID of the C +row: - foo me JOIN bar bar ON bar.foo_id = me.id + { 'foreign.author_id' => 'self.id' } + +will result in the C clause + + author me JOIN book book ON book.author_id = me.id + +For multi-column foreign keys, you will need to specify a C-to-C +mapping for each column in the key. For example, if you're creating a +relationship from C to C, where the C table refers to a +publisher and a type (e.g. "paperback"): + + { + 'foreign.publisher_id' => 'self.publisher_id', + 'foreign.type_id' => 'self.type_id', + } -You can specify as many foreign => self mappings as necessary. +This will result in the C clause: -Valid attributes are as follows: + book me JOIN edition edition ON edition.publisher_id = me.publisher_id + AND edition.type_id = me.type_id + +Each key-value pair provided in a hashref will be used as Ced conditions. +To add an Ced condition, use an arrayref of hashrefs. See the +L documentation for more details. + +=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 @@ -48,16 +92,20 @@ command immediately before C. =item proxy -An arrayref containing a list of accessors in the foreign class to proxy in +An arrayref containing a list of accessors in the foreign class to create in the main class. If, for example, you do the following: - - __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/ ] }); - -Then, assuming Bar has an accessor named margle, you can do: - - my $obj = Foo->find(1); - $obj->margle(10); # set margle; Bar object is created if it doesn't exist - + + MyDB::Schema::CD->might_have(liner_notes => 'MyDB::Schema::LinerNotes', + undef, { + proxy => [ qw/notes/ ], + }); + +Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do: + + my $cd = MyDB::Schema::CD->find(1); + $cd->notes('Notes go here'); # set notes -- LinerNotes object is + # created if it doesn't exist + =item accessor Specifies the type of accessor that should be created for the relationship. @@ -67,21 +115,183 @@ 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. + +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 -=head3 Arguments: ($relname, $rel_info) +=over 4 + +=item Arguments: $relname, $rel_info -Registers a relationship on the class +=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: $relationship_name + +=item Return Value: $related_resultset + +=back + + $rs = $cd->related_resultset('artist'); + +Returns a L for the relationship named +$relationship_name. + +=cut + +sub related_resultset { + my $self = shift; + $self->throw_exception("Can't call *_related as class methods") + unless ref $self; + my $rel = shift; + my $rel_info = $self->relationship_info($rel); + $self->throw_exception( "No such relationship ${rel}" ) + unless $rel_info; + + return $self->{related_resultsets}{$rel} ||= do { + 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 $source = $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 = eval { $source->_resolve_condition( $rel_info->{cond}, $rel, $self ) }; + if (my $err = $@) { + if ($self->in_storage) { + $self->throw_exception ($err); + } + else { + $cond = $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION; + } + } + + if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { + my $reverse = $source->reverse_relationship_info($rel); + foreach my $rev_rel (keys %$reverse) { + if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') { + $attrs->{related_objects}{$rev_rel} = [ $self ]; + Scalar::Util::weaken($attrs->{related_object}{$rev_rel}[0]); + } else { + $attrs->{related_objects}{$rev_rel} = $self; + Scalar::Util::weaken($attrs->{related_object}{$rev_rel}); + } + } + } + if (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); + $self->result_source->related_source($rel)->resultset->search( + $query, $attrs + ); + }; +} + =head2 search_related - My::Table->search_related('relname', $cond, $attrs); + @objects = $rs->search_related('relname', $cond, $attrs); + $objects_rs = $rs->search_related('relname', $cond, $attrs); + +Run a search on a related resultset. The search will be restricted to the +item or items represented by the L it was called +upon. This method can be called on a ResultSet, a Row or a ResultSource class. =cut @@ -89,10 +299,28 @@ sub search_related { return shift->related_resultset(shift)->search(@_); } +=head2 search_related_rs + + ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs); + +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(@_); +} + =head2 count_related $obj->count_related('relname', $cond, $attrs); +Returns the count of all the items in the related resultset, restricted by the +current item or where conditions. Can be called on a +L or a +L object. + =cut sub count_related { @@ -100,9 +328,31 @@ sub count_related { return $self->search_related(@_)->count; } +=head2 new_related + + my $new_obj = $obj->new_related('relname', \%col_data); + +Create a new item of the related foreign class. If called on a +L object, 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 item will +not be saved into your storage until you call L +on it. + +=cut + +sub new_related { + my ($self, $rel, $values, $attrs) = @_; + return $self->search_related($rel)->new($values, $attrs); +} + =head2 create_related - My::Table->create_related('relname', \%col_data); + my $new_obj = $obj->create_related('relname', \%col_data); + +Creates a new item, similarly to new_related, and also inserts the item's data +into your storage medium. See the distinction between C and C +in L for details. =cut @@ -114,66 +364,112 @@ sub create_related { return $obj; } -=head2 new_related +=head2 find_related + + my $found_item = $obj->find_related('relname', @pri_vals | \%pri_vals); - 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) = @_; - return $self->search_related($rel)->new($values, $attrs); +sub find_related { + my $self = shift; + my $rel = shift; + return $self->search_related($rel)->find(@_); } -=head2 find_related +=head2 find_or_new_related - My::Table->find_related('relname', @pri_vals | \%pri_vals); + my $new_obj = $obj->find_or_new_related('relname', \%col_data); + +Find an item of a related class. If none exists, instantiate a new item of the +related class. The object will not be saved into your storage until you call +L on it. =cut -sub find_related { +sub find_or_new_related { my $self = shift; - my $rel = shift; - return $self->search_related($rel)->find(@_); + my $obj = $self->find_related(@_); + return defined $obj ? $obj : $self->new_related(@_); } =head2 find_or_create_related - My::Table->find_or_create_related('relname', \%col_data); + my $new_obj = $obj->find_or_create_related('relname', \%col_data); + +Find or create an item 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 + + my $updated_item = $obj->update_or_create_related('relname', \%col_data, \%attrs?); + +Update or create an item of a related class. See +L for details. + +=cut + +sub update_or_create_related { + my $self = shift; + my $rel = shift; + return $self->related_resultset($rel)->update_or_create(@_); } =head2 set_from_related - My::Table->set_from_related('relname', $rel_obj); + $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. + +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->relationship_info($rel); - $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj; - my $cond = $rel_obj->{cond}; - $self->throw_exception( "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->result_source->schema->class($rel_obj->{class}); - $self->throw_exception( "Object $f_obj isn't a ".$f_class ) - unless $f_obj->isa($f_class); + my $rel_info = $self->relationship_info($rel); + $self->throw_exception( "No such relationship ${rel}" ) unless $rel_info; + my $cond = $rel_info->{cond}; + $self->throw_exception( + "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'; + if (defined $f_obj) { + my $f_class = $rel_info->{class}; + $self->throw_exception( "Object $f_obj isn't a ".$f_class ) + unless Scalar::Util::blessed($f_obj) and $f_obj->isa($f_class); + } $self->set_columns( - $self->result_source->resolve_condition( - $rel_obj->{cond}, $f_obj, $rel)); + $self->result_source->_resolve_condition( + $rel_info->{cond}, $f_obj, $rel)); return 1; } =head2 update_from_related - My::Table->update_from_related('relname', $rel_obj); + $book->update_from_related('author', $author_obj); + +The same as L, but the changes are immediately updated +in storage. =cut @@ -185,7 +481,9 @@ sub update_from_related { =head2 delete_related - My::Table->delete_related('relname', $cond, $attrs); + $obj->delete_related('relname', $cond, $attrs); + +Delete any related item subject to the given conditions. =cut @@ -196,66 +494,82 @@ sub delete_related { return $obj; } -1; +=head2 add_to_$rel -=head2 related_resultset($name) +B, C and 'multi' type +relationships.> -Returns a L for the relationship named $name. +=over 4 - $rs = My::Table->related_resultset('related_table'); +=item Arguments: ($foreign_vals | $obj), $link_vals? -=cut +=back -sub related_resultset { - my $self = shift; - $self->throw_exception("Can't call *_related as class methods") unless ref $self; - my $rel = shift; - $self->{related_resultsets} ||= {}; - #use Data::Dumper; warn "related_resultsets: ", Dumper $self->{related_resultsets}; - my $resultsets = $self->{related_resultsets}; - if( !exists $resultsets->{$rel} ) { + my $role = $schema->resultset('Role')->find(1); + $actor->add_to_roles($role); + # creates a My::DBIC::Schema::ActorRoles linking table row object - #warn "creating related resultset for relation '$rel'", \$self; - my $source = $self->result_source; - # if relation exists but resultset doesn't, create the resultset + $actor->add_to_roles({ name => 'lead' }, { salary => 15_000_000 }); + # creates a new My::DBIC::Schema::Role row object and the linking table + # object with an extra column in the link - my $attrs = { }; - if (@_ > 1 && ref $_[$#_] eq 'HASH') { - $attrs = { %{ pop(@_) } }; - } - - my $rel_obj = $self->relationship_info($rel); - $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj; - $attrs = { %{$rel_obj->{attrs} || {}}, %{$attrs || {}} }; +Adds a linking table object for C<$obj> or C<$foreign_vals>. 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_vals>. - $self->throw_exception( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1)); - my $query = ((@_ > 1) ? {@_} : shift); +=head2 set_$rel - my ($cond) = $self->result_source->resolve_condition($rel_obj->{cond}, $rel, $self); - if (ref $cond eq 'ARRAY') { - $cond = [ map { my %hash; - foreach my $key (keys %{$_}) { - unless ($key =~ m/\./) { - $hash{"me.$key"} = $_->{$key}; - } else { - $hash{$key} = $_->{$key}; - } - }; \%hash; } @$cond ]; - } else { - foreach my $key (keys %$cond) { - unless ($key =~ m/\./) { - $cond->{"me.$key"} = delete $cond->{$key}; - } - } - } - $query = ($query ? { '-and' => [ $cond, $query ] } : $cond); - #use Data::Dumper; warn Dumper($cond); - #warn $rel_obj->{class}." $meth $cond ".join(', ', @{$attrs->{bind}||[]}); - $resultsets->{$rel} = - $self->result_source->related_source($rel)->resultset->search($query, $attrs); - } - return $resultsets->{$rel}; -} +B relationships.> + +=over 4 + +=item Arguments: (\@hashrefs | \@objs), $link_vals? + +=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: $obj + +=back + + my $role = $schema->resultset('Role')->find(1); + $actor->remove_from_roles($role); + # removes $role's My::DBIC::Schema::ActorRoles linking table row 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 AUTHORS @@ -267,3 +581,4 @@ You may distribute this code under the same terms as Perl itself. =cut +1;