X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBase.pm;h=dd84ef40ad95742633fec154d289d5701f6d9c73;hp=35f906725662ccda689d1216847f8d3a5f5505c3;hb=68f3b0dd9e91421b02c818ca42543b79bc197dfd;hpb=87772e46b99bc03f36c5a82ec29282a3228c29c7 diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 35f9067..dd84ef4 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,60 @@ 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, +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. + +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: + + { 'foreign.author_id' => 'self.id' } + +will result in the C clause - { 'foreign.foo_id' => 'self.id' } + author me JOIN book book ON book.author_id = me.id -will result in the JOIN clause +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"): - foo me JOIN bar bar ON bar.foo_id = me.id + { + 'foreign.publisher_id' => 'self.publisher_id', + 'foreign.type_id' => 'self.type_id', + } + +This will result in the C clause: + + book me JOIN edition edition ON edition.publisher_id = me.publisher_id + AND edition.type_id = me.type_id -You can specify as many foreign => self mappings as necessary. +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. -Valid attributes are as follows: +In addition to standard result set attributes, the following attributes are also valid: =over 4 @@ -48,15 +79,19 @@ 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 /] }); + MyDB::Schema::CD->might_have(liner_notes => 'MyDB::Schema::LinerNotes', + undef, { + proxy => [ qw/notes/ ], + }); -Then, assuming Bar has an accessor named margle, you can do: +Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do: - my $obj = Foo->find(1); - $obj->margle(10); # set margle; Bar object is created if it doesn't exist + 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 @@ -67,154 +102,180 @@ 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 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: $relname, $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 add_relationship { - shift->result_source->add_relationship(@_); -} +sub register_relationship { } -sub relationships { - shift->result_source->relationships(@_); -} +=head2 related_resultset -sub relationship_info { - shift->result_source->relationship_info(@_); -} +=over 4 -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 :("); - } -} +=item Arguments: $relationship_name -sub _cond_key { - my ($self, $attrs, $key, $alias) = @_; - my $action = $attrs->{_action} || ''; - if ($action eq 'convert') { - unless ($key =~ s/^foreign\.//) { - $self->throw("Unable to convert relationship to WHERE clause: invalid key ${key}"); - } - if (defined (my $alias = $attrs->{_aliases}{foreign})) { - return "${alias}.${key}"; - } else { - 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} || {}}) ); - } - } - return $self->next::method($attrs, $key); -} +=item Return Value: $related_resultset -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}" ); - } - unless ($self->has_column($value)) { - $self->throw( "Unable to convert relationship to WHERE clause: no such accessor ${value}" ); +=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_obj = $self->relationship_info($rel); + $self->throw_exception( "No such relationship ${rel}" ) + unless $rel_obj; + + return $self->{related_resultsets}{$rel} ||= do { + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + $attrs = { %{$rel_obj->{attrs} || {}}, %$attrs }; + + $self->throw_exception( "Invalid query: @_" ) + if (@_ > 1 && (@_ % 2 == 1)); + my $query = ((@_ > 1) ? {@_} : shift); + + my $source = $self->result_source; + my $cond = $source->resolve_condition( + $rel_obj->{cond}, $rel, $self + ); + if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { + my $reverse = $source->reverse_relationship_info($rel); + foreach my $rev_rel (keys %$reverse) { + $attrs->{related_objects}{$rev_rel} = $self; + Scalar::Util::weaken($attrs->{related_object}{$rev_rel}); + } } - 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} || {}}) ); + 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}; + } } - } - - return $self->next::method($attrs, $key, $value) + $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 sub search_related { - my $self = shift; - my $rel = shift; - my $attrs = { }; - if (@_ > 1 && ref $_[$#_] eq 'HASH') { - $attrs = { %{ pop(@_) } }; - } - my $rel_obj = $self->relationship_info($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->result_source->schema->resultset($rel_obj->{class} - )->search($query, $attrs); + return shift->related_resultset(shift)->search(@_); } -=head2 count_related +=head2 search_related_rs - My::Table->count_related('relname', $cond, $attrs); + ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs); + +This method works exactly the same as search_related, except that +it guarantees a restultset, even in list context. =cut -sub count_related { - my $self = shift; - return $self->search_related(@_)->count; +sub search_related_rs { + return shift->related_resultset(shift)->search_rs(@_); } -=head2 create_related +=head2 count_related - My::Table->create_related('relname', \%col_data); + $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 create_related { - my $class = shift; - my $rel = shift; - return $class->search_related($rel)->create(@_); +sub count_related { + my $self = shift; + return $self->search_related(@_)->count; } =head2 new_related - My::Table->new_related('relname', \%col_data); + 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 @@ -223,9 +284,30 @@ sub new_related { return $self->search_related($rel)->new($values, $attrs); } +=head2 create_related + + 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 + +sub create_related { + my $self = shift; + my $rel = shift; + my $obj = $self->search_related($rel)->create(@_); + delete $self->{related_resultsets}->{$rel}; + return $obj; +} + =head2 find_related - My::Table->find_related('relname', @pri_vals | \%pri_vals); + my $found_item = $obj->find_related('relname', @pri_vals | \%pri_vals); + +Attempt to find a related object using its primary key or unique constraints. +See L for details. =cut @@ -235,49 +317,97 @@ sub find_related { return $self->search_related($rel)->find(@_); } +=head2 find_or_new_related + + 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_or_new_related { + my $self = shift; + 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 acessor. + +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( "No such relationship ${rel}" ) unless $rel_obj; + $self->throw_exception( "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->result_source->schema->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); + $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 = $self->result_source->schema->class($rel_obj->{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)); 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 @@ -289,16 +419,91 @@ 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 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.> + +=over 4 + +=item Arguments: ($foreign_vals | $obj), $link_vals? + +=back + + my $role = $schema->resultset('Role')->find(1); + $actor->add_to_roles($role); + # creates a My::DBIC::Schema::ActorRoles linking table row object + + $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 + +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>. + +=head2 set_$rel + +B relationships.> + +=over 4 + +=item Arguments: (\@hashrefs | \@objs) + +=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 + +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 @@ -310,3 +515,4 @@ You may distribute this code under the same terms as Perl itself. =cut +1;