time (mainly benefiting CGI users)
- Make sure all namespaces are clean of rogue imports
+0.08190-TRIAL 2011-01-24 15:35 (UTC)
+
+ * New Features / Changes
+ - Support for completely arbitrary SQL::Abstract-based conditions
+ in all types of relationships
+
0.08127 2011-01-19 16:40 (UTC)
* New Features / Changes
- Schema/resultsource instances are now crossreferenced via a new
# Always remember to do all digits for the version even if they're 0
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.08127';
+$VERSION = '0.08190';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
All helper methods are called similar to the following template:
- __PACKAGE__->$method_name('relname', 'Foreign::Class', \%cond | \@cond, \%attrs);
+ __PACKAGE__->$method_name('relname', 'Foreign::Class', \%cond|\@cond|\&cond?, \%attrs?);
-Both C<$cond> and C<$attrs> are optional. Pass C<undef> for C<$cond> if
-you want to use the default value for it, but still want to set C<\%attrs>.
+Both C<cond> and C<attrs> are optional. Pass C<undef> for C<cond> if
+you want to use the default value for it, but still want to set C<attrs>.
-See L<DBIx::Class::Relationship::Base> for documentation on the
-attributes that are allowed in the C<\%attrs> argument.
+See L<DBIx::Class::Relationship::Base/condition> for full documentation on
+definition of the C<cond> argument.
+
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on the
+attributes that are allowed in the C<attrs> argument.
=head2 belongs_to
=over 4
-=item Arguments: $accessor_name, $related_class, $our_fk_column|\%cond|\@cond?, \%attrs?
+=item Arguments: $accessor_name, $related_class, $our_fk_column|\%cond|\@cond|\$cond?, \%attrs?
=back
This relationship defaults to using C<$accessor_name> as the column
name in this class to resolve the join against the primary key from
C<$related_class>, unless C<$our_fk_column> specifies the foreign key column
-in this class or C<cond> specifies a reference to a join condition hash.
+in this class or C<cond> specifies a reference to a join condition.
=over
=item cond
-A hashref where the keys are C<foreign.$column_on_related_table> and
-the values are C<self.$our_fk_column>. This is useful for
-relations that are across multiple columns.
+A hashref, arrayref or coderef specifying a custom join expression. For
+more info see L<DBIx::Class::Relationship/condition>.
=back
-
# in a Book class (where Author has many Books)
My::DBIC::Schema::Book->belongs_to(
author =>
$book->get_column('author_id');
-If the relationship is optional -- i.e. the column containing the foreign key
-can be NULL -- then the belongs_to relationship does the right thing. Thus, in
-the example above C<$obj-E<gt>author> would return C<undef>. However in this
-case you would probably want to set the C<join_type> attribute so that a C<LEFT
-JOIN> is done, which makes complex resultsets involving C<join> or C<prefetch>
-operations work correctly. The modified declaration is shown below:
+If the relationship is optional -- i.e. the column containing the
+foreign key can be NULL -- then the belongs_to relationship does the
+right thing. Thus, in the example above C<< $obj->author >> would
+return C<undef>. However in this case you would probably want to set
+the L<join_type|DBIx::Class::Relationship/join_type> attribute so that
+a C<LEFT JOIN> is done, which makes complex resultsets involving
+C<join> or C<prefetch> operations work correctly. The modified
+declaration is shown below:
# in a Book class (where Author has_many Books)
__PACKAGE__->belongs_to(
By default, DBIC will return undef and avoid querying the database if a
C<belongs_to> accessor is called when any part of the foreign key IS NULL. To
-disable this behavior, pass C<< undef_on_null_fk => 0 >> in the C<$attr>
+disable this behavior, pass C<< undef_on_null_fk => 0 >> in the C<\%attrs>
hashref.
NOTE: If you are used to L<Class::DBI> relationships, this is the equivalent
of C<has_a>.
-See L<DBIx::Class::Relationship::Base> for documentation on relationship
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on relationship
methods and valid relationship attributes. Also see L<DBIx::Class::ResultSet>
for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
which can be assigned to relationships as well.
=over 4
-=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond?, \%attrs?
+=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond|\&cond?, \%attrs?
=back
defaults to using the end of this classes namespace as the foreign key
in C<$related_class> to resolve the join, unless C<$their_fk_column>
specifies the foreign key column in C<$related_class> or C<cond>
-specifies a reference to a join condition hash.
+specifies a reference to a join condition.
=over
=item cond
-A hashref where the keys are C<foreign.$their_fk_column> and
-the values are C<self.$matching_column>. This is useful for
-relations that are across multiple columns.
-
-OR
-
-An arrayref containing an SQL::Abstract-like condition. For example a
-link table where two columns link back to the same table. This is an
-OR condition.
-
- My::Schema::Item->has_many('rels', 'My::Schema::Relationships',
- [ { 'foreign.LItemID' => 'self.ID' },
- { 'foreign.RItemID' => 'self.ID'} ]);
+A hashref, arrayref or coderef specifying a custom join expression. For
+more info see L<DBIx::Class::Relationship/condition>.
=back
$author->add_to_books(\%col_data);
-Three methods are created when you create a has_many relationship. The first
-method is the expected accessor method, C<$accessor_name()>. The second is
-almost exactly the same as the accessor method but "_rs" is added to the end of
-the method name. This method works just like the normal accessor, except that
-it always returns a resultset, even in list context. The third method,
-named C<< add_to_$relname >>, will also be added to your Row items; this
-allows you to insert new related items, using the same mechanism as in
+Three methods are created when you create a has_many relationship.
+The first method is the expected accessor method, C<$accessor_name()>.
+The second is almost exactly the same as the accessor method but "_rs"
+is added to the end of the method name, eg C<$accessor_name_rs()>.
+This method works just like the normal accessor, except that it always
+returns a resultset, even in list context. The third method, named C<<
+add_to_$relname >>, will also be added to your Row items; this allows
+you to insert new related items, using the same mechanism as in
L<DBIx::Class::Relationship::Base/"create_related">.
If you delete an object in a class with a C<has_many> relationship, all
pass C<< cascade_copy => 0 >> in the C<$attr> hashref. The behaviour
defaults to C<< cascade_copy => 1 >>.
-See L<DBIx::Class::Relationship::Base> for documentation on relationship
-methods and valid relationship attributes. Also see L<DBIx::Class::ResultSet>
-for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
-which can be assigned to relationships as well.
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on
+relationship methods and valid relationship attributes. Also see
+L<DBIx::Class::ResultSet> for a L<list of standard resultset
+attributes|DBIx::Class::ResultSet/ATTRIBUTES> which can be assigned to
+relationships as well.
=head2 might_have
=over 4
-=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond?, \%attrs?
+=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond|\&cond?, \%attrs?
=back
defaults to using C<$accessor_name> as the foreign key in C<$related_class> to
resolve the join, unless C<$their_fk_column> specifies the foreign key
column in C<$related_class> or C<cond> specifies a reference to a join
-condition hash.
+condition.
=over
=item cond
-A hashref where the keys are C<foreign.$their_fk_column> and
-the values are C<self.$matching_column>. This is useful for
-relations that are across multiple columns.
+A hashref, arrayref or coderef specifying a custom join expression. For
+more info see L<DBIx::Class::Relationship/condition>.
=back
will have deleted/updated the related records or raised an exception
before DBIx::Class gets to perform the cascaded operation.
-See L<DBIx::Class::Relationship::Base> for documentation on relationship
-methods and valid relationship attributes. Also see L<DBIx::Class::ResultSet>
-for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
-which can be assigned to relationships as well.
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on
+relationship methods and valid relationship attributes. Also see
+L<DBIx::Class::ResultSet> for a L<list of standard resultset
+attributes|DBIx::Class::ResultSet/ATTRIBUTES> which can be assigned to
+relationships as well.
-Note that if you supply a condition on which to join, if the column in the
+Note that if you supply a condition on which to join, and the column in the
current table allows nulls (i.e., has the C<is_nullable> attribute set to a
true value), than C<might_have> will warn about this because it's naughty and
-you shouldn't do that.
+you shouldn't do that. The warning will look something like:
- "might_have/has_one" must not be on columns with is_nullable set to true (MySchema::SomeClass/key)
+ "might_have/has_one" must not be on columns with is_nullable set to true (MySchema::SomeClass/key)
If you must be naughty, you can suppress the warning by setting
C<DBIC_DONT_VALIDATE_RELS> environment variable to a true value. Otherwise,
-you probably just want to use C<DBIx::Class::Relationship/belongs_to>.
+you probably just meant to use C<DBIx::Class::Relationship/belongs_to>.
=head2 has_one
=over 4
-=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond?, \%attrs?
+=item Arguments: $accessor_name, $related_class, $their_fk_column|\%cond|\@cond|\&cond?, \%attrs?
=back
defaults to using C<$accessor_name> as the foreign key in C<$related_class> to
resolve the join, unless C<$their_fk_column> specifies the foreign key
column in C<$related_class> or C<cond> specifies a reference to a join
-condition hash.
+condition.
=over
=item cond
-A hashref where the keys are C<foreign.$their_fk_column> and
-the values are C<self.$matching_column>. This is useful for
-relations that are across multiple columns.
+A hashref, arrayref or coderef specifying a custom join expression. For
+more info see L<DBIx::Class::Relationship/condition>.
=back
C<might_have> is that C<has_one> uses an (ordinary) inner join,
whereas C<might_have> defaults to a left join.
-The has_one relationship should be used when a row in the table has exactly one
-related row in another table. If the related row might not exist in the foreign
-table, use the L<DBIx::Class::Relationship/might_have> relationship.
+The has_one relationship should be used when a row in the table must
+have exactly one related row in another table. If the related row
+might not exist in the foreign table, use the
+L<DBIx::Class::Relationship/might_have> relationship.
In the above example, each Book in the database is associated with exactly one
ISBN object.
-See L<DBIx::Class::Relationship::Base> for documentation on relationship
-methods and valid relationship attributes. Also see L<DBIx::Class::ResultSet>
-for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
-which can be assigned to relationships as well.
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on
+relationship methods and valid relationship attributes. Also see
+L<DBIx::Class::ResultSet> for a L<list of standard resultset
+attributes|DBIx::Class::ResultSet/ATTRIBUTES> which can be assigned to
+relationships as well.
Note that if you supply a condition on which to join, if the column in the
current table allows nulls (i.e., has the C<is_nullable> attribute set to a
will be created for the Role class for the C<actors> many_to_many
relationship.
-See L<DBIx::Class::Relationship::Base> for documentation on relationship
-methods and valid relationship attributes. Also see L<DBIx::Class::ResultSet>
-for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
-which can be assigned to relationships as well.
+See L<DBIx::Class::Relationship::Base/attributes> for documentation on
+relationship methods and valid relationship attributes. Also see
+L<DBIx::Class::ResultSet> for a L<list of standard resultset
+attributes|DBIx::Class::ResultSet/ATTRIBUTES> which can be assigned to
+relationships as well.
=cut
return $self->{_relationship_data}{$rel};
} else {
my $cond = $self->result_source->_resolve_condition(
- $rel_info->{cond}, $rel, $self
+ $rel_info->{cond}, $rel, $self, $rel
);
if ($rel_info->{attrs}->{undef_on_null_fk}){
return undef unless ref($cond) eq 'HASH';
=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 provides methods to describe the relationships between the
=over 4
-=item Arguments: 'relname', 'Foreign::Class', $cond, $attrs
+=item Arguments: 'relname', 'Foreign::Class', $condition, $attrs
=back
- __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
+ __PACKAGE__->add_relationship('relname',
+ 'Foreign::Class',
+ $condition, $attrs);
+
+Create a custom relationship between one result source and another
+source, indicated by its class name.
=head3 condition
-The condition needs to be an L<SQL::Abstract>-style representation of the
-join between the tables. When resolving the condition for use in a C<JOIN>,
-keys using the pseudo-table C<foreign> are resolved to mean "the Table on the
-other side of the relationship", and values using the pseudo-table C<self>
-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<JOIN> parameter support.
+The condition argument describes the C<ON> clause of the C<JOIN>
+expression used to connect the two sources when creating SQL queries.
+
+To create simple equality joins, supply a hashref containing the
+remote table column name as the key(s), and the local table column
+name as the value(s), for example given:
+
+ My::Schema::Author->has_many(
+ books => 'My::Schema::Book',
+ { 'foreign.author_id' => 'self.id' }
+ );
+
+A query like:
+
+ $author_rs->search_related('books')->next
+
+will result in the following C<JOIN> clause:
+
+ ... FROM author me LEFT JOIN book books ON books.author_id = me.id ...
+
+This describes a relationship between the C<Author> table and the
+C<Book> table where the C<Book> table has a column C<author_id>
+containing the ID value of the C<Author>.
+
+C<foreign> and C<self> are pseudo aliases and must be entered
+literally. They will be replaced with the actual correct table alias
+when the SQL is produced.
+
+Similarly:
+
+ My::Schema::Book->has_many(
+ editions => 'My::Schema::Edition',
+ {
+ 'foreign.publisher_id' => 'self.publisher_id',
+ 'foreign.type_id' => 'self.type_id',
+ }
+ );
+
+ ...
+
+ $book_rs->search_related('editions')->next
+
+will result in the C<JOIN> 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<Book> to C<Edition>, where the
+C<Edition> table refers to a publisher and a type (e.g. "paperback"):
+
+As is the default in L<SQL::Abstract>, the key-value pairs will be
+C<AND>ed in the result. C<OR> 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<JOIN> 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<Item> to C<Item::Links>, where
+C<Item::Links> is a many-to-many linking table, linking items back to
+themselves in a peer fashion (without a "parent-child" designation)
+
+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<JOIN> clause:
+
+ ... FROM artist me LEFT JOIN cd cds_80s ON
+ cds_80s.artist = me.artistid
+ AND cds_80s.year < ?
+ AND cds_80s.year > ?
-For example, if you're creating a relationship from C<Author> to C<Book>, where
-the C<Book> table has a column C<author_id> containing the ID of the C<Author>
-row:
+with the bind values:
- { 'foreign.author_id' => 'self.id' }
+ '1990', '1979'
-will result in the C<JOIN> clause
+C<< $args->{foreign_alias} >> and C<< $args->{self_alias} >> are supplied the
+same values that would be otherwise substituted for C<foreign> and C<self>
+in the simple hashref syntax case.
- author me JOIN book book ON book.author_id = me.id
+The coderef is expected to return a valid L<SQL::Abstract> query-structure, just
+like what one would supply as the first argument to
+L<DBIx::Class::ResultSet/search>. The return value will be passed directly to
+L<SQL::Abstract> and the resulting SQL will be used verbatim as the C<ON>
+clause of the C<JOIN> statement associated with this relationship.
-For multi-column foreign keys, you will need to specify a C<foreign>-to-C<self>
-mapping for each column in the key. For example, if you're creating a
-relationship from C<Book> to C<Edition>, where the C<Edition> table refers to a
-publisher and a type (e.g. "paperback"):
+While every coderef-based condition must return a valid C<ON> clause, it may
+elect to additionally return a simplified join-free condition hashref when
+invoked as C<< $row_object->relationship >>, as opposed to
+C<< $rs->related_resultset('relationship') >>. In this case C<$row_object> is
+passed to the coderef as C<< $args->{self_rowobj} >>, so a user can do the
+following:
- {
- 'foreign.publisher_id' => 'self.publisher_id',
- 'foreign.type_id' => 'self.type_id',
+ sub {
+ my $args = shift;
+
+ return (
+ {
+ "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
+ "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" },
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.artist" => $args->{self_rowobj}->artistid,
+ "$args->{foreign_alias}.year" => { '>', "1979", '<', "1990" },
+ },
+ );
}
-This will result in the C<JOIN> clause:
+Now this code:
+
+ my $artist = $schema->resultset("Artist")->find({ id => 4 });
+ $artist->cds_80s->all;
+
+Can skip a C<JOIN> altogether and instead produce:
- book me JOIN edition edition ON edition.publisher_id = me.publisher_id
- AND edition.type_id = me.type_id
+ 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 > ?
-Each key-value pair provided in a hashref will be used as C<AND>ed conditions.
-To add an C<OR>ed condition, use an arrayref of hashrefs. See the
-L<SQL::Abstract> documentation for more details.
+With the bind values:
+
+ '4', '1990', '1979'
+
+Note that in order to be able to use
+L<< $row->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<DBIx::Class::Relationship::Base/set_from_related>. For
+instance the C<year> constraint in the above example prevents the relationship
+from being used to to create related objects (an exception will be thrown).
+
+In order to allow the user to go truly crazy when generating a custom C<ON>
+clause, the C<$args> hashref passed to the subroutine contains some extra
+metadata. Currently the supplied coderef is executed as:
+
+ $relationship_info->{cond}->({
+ self_alias => The alias of the invoking resultset ('me' in case of a row object),
+ foreign_alias => The alias of the to-be-joined resultset (often matches relname),
+ self_resultsource => The invocant's resultsource,
+ foreign_relname => The relationship name (does *not* always match foreign_alias),
+ self_rowobj => The invocant itself in case of $row_obj->relationship
+ });
=head3 attributes
# condition resolution may fail if an incomplete master-object prefetch
# is encountered - that is ok during prefetch construction (not yet in_storage)
- my $cond = try {
- $source->_resolve_condition( $rel_info->{cond}, $rel, $self )
+ my ($cond, $is_crosstable) = try {
+ $source->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel )
}
catch {
if ($self->in_storage) {
$DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION; # RV
};
- 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 ];
- weaken $attrs->{related_object}{$rev_rel}[0];
- } else {
- $attrs->{related_objects}{$rev_rel} = $self;
- weaken $attrs->{related_object}{$rev_rel};
+ # keep in mind that the following if() block is part of a do{} - no return()s!!!
+ if ($is_crosstable) {
+ $self->throw_exception (
+ "A cross-table relationship condition returned for statically declared '$rel'")
+ unless 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 $source->{_relationships}{me} = $source->{_relationships}{$rel}; # make the fake 'me' rel
+ my $obj_table_alias = lc($source->source_name) . '__row';
+
+ $source->resultset->search(
+ $self->ident_condition($obj_table_alias),
+ { alias => $obj_table_alias },
+ )->search_related('me', $query, $attrs)
+ }
+ 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 = $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 ];
+ weaken $attrs->{related_object}{$rev_rel}[0];
+ } else {
+ $attrs->{related_objects}{$rev_rel} = $self;
+ 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};
+ 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 {
+ $_;
}
- $hash;
- } else {
- $_;
+ } @$cond ];
+ }
+ elsif (ref $cond eq 'HASH') {
+ foreach my $key (grep { ! /\./ } keys %$cond) {
+ $cond->{"me.$key"} = delete $cond->{$key};
}
- } @$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
+ );
}
- $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
- $self->result_source->related_source($rel)->resultset->search(
- $query, $attrs
- );
};
}
sub new_related {
my ($self, $rel, $values, $attrs) = @_;
- return $self->search_related($rel)->new($values, $attrs);
+
+ # 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 (undef, $crosstable, $relcols) = $rsrc->_resolve_condition (
+ $rsrc->relationship_info($rel)->{cond}, $rel, $self, $rel
+ );
+
+ $self->throw_exception("Custom relationship '$rel' does not resolve to a join-free condition fragment")
+ if $crosstable;
+
+ if (@{$relcols || []} and @$relcols = grep { ! exists $values->{$_} } @$relcols) {
+ $self->throw_exception(sprintf (
+ "Custom relationship '%s' not definitive - returns conditions instead of values for column(s): %s",
+ $rel,
+ map { "'$_'" } @$relcols
+ ));
+ }
+ }
+
+ my $row = $self->search_related($rel)->new($values, $attrs);
+ return $row;
}
=head2 create_related
sub create_related {
my $self = shift;
my $rel = shift;
- my $obj = $self->search_related($rel)->create(@_);
+ my $obj = $self->new_related($rel, @_)->insert;
delete $self->{related_resultsets}->{$rel};
return $obj;
}
sub set_from_related {
my ($self, $rel, $f_obj) = @_;
- 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';
+
+ 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);
}
- $self->set_columns(
- $self->result_source->_resolve_condition(
- $rel_info->{cond}, $f_obj, $rel));
+
+
+ # 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, $relcols) = $rsrc->_resolve_condition (
+ $rel_info->{cond}, $f_obj, $rel, $rel
+ );
+ $self->throw_exception("Custom 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 { "'$_'" } @$relcols
+ )) if @{$relcols || []};
+
+ $self->set_columns($cond);
+
return 1;
}
$cond = { "foreign.${f_key}" => "self.${pri}" };
}
+ my $default_cascade = ref $cond eq 'CODE' ? 0 : 1;
+
$class->add_relationship($rel, $f_class, $cond, {
accessor => 'multi',
join_type => 'LEFT',
- cascade_delete => 1,
- cascade_copy => 1,
+ cascade_delete => $default_cascade,
+ cascade_copy => $default_cascade,
%{$attrs||{}}
});
}
$cond = { "foreign.${f_key}" => "self.${pri}" };
}
$class->_validate_has_one_condition($cond);
+
+ my $default_cascade = ref $cond eq 'CODE' ? 0 : 1;
+
$class->add_relationship($rel, $f_class,
$cond,
{ accessor => 'single',
- cascade_update => 1, cascade_delete => 1,
+ cascade_update => $default_cascade,
+ cascade_delete => $default_cascade,
($join_type ? ('join_type' => $join_type) : ()),
%{$attrs || {}} });
1;
unless blessed ($obj);
my $rel_source = $self->search_related($rel)->result_source;
my $cond = $rel_source->relationship_info($f_rel)->{cond};
- my $link_cond = $rel_source->_resolve_condition(
- $cond, $obj, $f_rel
+ my ($link_cond, $crosstable) = $rel_source->_resolve_condition(
+ $cond, $obj, $f_rel, $f_rel
);
+
+ $self->throw_exception(
+ "Custom relationship '$rel' does not resolve to a join-free condition, "
+ ."unable to use with the ManyToMany helper '$f_rel'"
+ ) if $crosstable;
+
$self->search_related($rel, $link_cond)->delete;
};
next if $keyref eq 'ARRAY'; # has_many for multi_create
my $rel_q = $rsrc->_resolve_condition(
- $relinfo->{cond}, $val, $key
+ $relinfo->{cond}, $val, $key, $key
);
die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
@related{keys %$rel_q} = values %$rel_q;
$reverse_relinfo->{cond},
$self,
$result,
+ $rel,
);
delete $data->[$index]->{$rel};
$rels->{$rel}{cond},
$child,
$main_row,
+ $rel,
);
my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
while ( my($col, $value) = each %implied ) {
my $vref = ref $value;
- if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
+ if (
+ $vref eq 'HASH'
+ and
+ keys(%$value) == 1
+ and
+ (keys %$value)[0] eq '='
+ ) {
$new_data{$col} = $value->{'='};
}
elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
use DBIx::Class::Carp;
use Try::Tiny;
use List::Util 'first';
-use Scalar::Util qw/weaken isweak/;
+use Scalar::Util qw/blessed weaken isweak/;
use namespace::clean;
use base qw/DBIx::Class/;
-alias => $as,
-relation_chain_depth => $seen->{-relation_chain_depth} || 0,
},
- $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
+ $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
+ ];
}
}
$self->_resolve_condition (@_);
}
-# Resolves the passed condition to a concrete query fragment. If given an alias,
-# returns a join condition; if given an object, inverts that object to produce
-# a related conditional from that object.
-our $UNRESOLVABLE_CONDITION = \'1 = 0';
+our $UNRESOLVABLE_CONDITION = \ '1 = 0';
+# Resolves the passed condition to a concrete query fragment and a flag
+# indicating whether this is a cross-table condition. Also an optional
+# list of non-triviail values (notmally conditions) returned as a part
+# of a joinfree condition hash
sub _resolve_condition {
- my ($self, $cond, $as, $for) = @_;
- if (ref $cond eq 'HASH') {
+ my ($self, $cond, $as, $for, $relname) = @_;
+
+ my $obj_rel = !!blessed $for;
+
+ if (ref $cond eq 'CODE') {
+ my $relalias = $obj_rel ? 'me' : $as;
+
+ my ($crosstable_cond, $joinfree_cond) = $cond->({
+ self_alias => $obj_rel ? $as : $for,
+ foreign_alias => $relalias,
+ self_resultsource => $self,
+ foreign_relname => $relname || ($obj_rel ? $as : $for),
+ self_rowobj => $obj_rel ? $for : undef
+ });
+
+ my $cond_cols;
+ if ($joinfree_cond) {
+
+ # FIXME sanity check until things stabilize, remove at some point
+ $self->throw_exception (
+ "A join-free condition returned for relationship '$relname' whithout a row-object to chain from"
+ ) unless $obj_rel;
+
+ # FIXME another sanity check
+ if (
+ ref $joinfree_cond ne 'HASH'
+ or
+ first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
+ ) {
+ $self->throw_exception (
+ "The join-free condition returned for relationship '$relname' must be a hash "
+ .'reference with all keys being valid columns on the related result source'
+ );
+ }
+
+ # normalize
+ for (values %$joinfree_cond) {
+ $_ = $_->{'='} if (
+ ref $_ eq 'HASH'
+ and
+ keys %$_ == 1
+ and
+ exists $_->{'='}
+ );
+ }
+
+ # see which parts of the joinfree cond are conditionals
+ my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
+
+ for my $c (keys %$joinfree_cond) {
+ my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
+
+ unless ($relcol_list->{$colname}) {
+ push @$cond_cols, $colname;
+ next;
+ }
+
+ if (
+ ref $joinfree_cond->{$c}
+ and
+ ref $joinfree_cond->{$c} ne 'SCALAR'
+ and
+ ref $joinfree_cond->{$c} ne 'REF'
+ ) {
+ push @$cond_cols, $colname;
+ next;
+ }
+ }
+
+ return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
+ }
+ else {
+ return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
+ }
+ }
+ elsif (ref $cond eq 'HASH') {
my %ret;
foreach my $k (keys %{$cond}) {
my $v = $cond->{$k};
} elsif (!defined $as) { # undef, i.e. "no reverse object"
$ret{$v} = undef;
} else {
- $ret{"${as}.${k}"} = "${for}.${v}";
+ $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
}
}
- return \%ret;
- } elsif (ref $cond eq 'ARRAY') {
- return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
- } else {
- die("Can't handle condition $cond yet :(");
+
+ return wantarray
+ ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
+ : \%ret
+ ;
+ }
+ elsif (ref $cond eq 'ARRAY') {
+ my (@ret, $crosstable);
+ for (@$cond) {
+ my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
+ push @ret, $cond;
+ $crosstable ||= $crosstab;
+ }
+ return wantarray ? (\@ret, $crosstable) : \@ret;
+ }
+ else {
+ $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
}
}
-
# Accepts one or more relationships for the current source and returns an
# array of column names for each of those relationships. Column names are
# prefixed relative to the current source, in accordance with where they appear
"Can't prefetch has_many ${pre} (join cond too complex)")
unless ref($rel_info->{cond}) eq 'HASH';
my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
+
if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
keys %{$collapse}) {
my ($last) = ($fail =~ /([^\.]+)$/);
. 'Use at your own risk.'
);
}
+
#my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
# values %{$rel_info->{cond}};
$collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
next unless $rel_info->{attrs}{cascade_copy};
my $resolved = $self->result_source->_resolve_condition(
- $rel_info->{cond}, $rel, $new
+ $rel_info->{cond}, $rel, $new, $rel
);
my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
package DBIx::Class::SQLMaker;
+use strict;
+use warnings;
+
=head1 NAME
DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
DBIx::Class
/;
use mro 'c3';
-use strict;
-use warnings;
+
use Sub::Name 'subname';
use DBIx::Class::Carp;
use DBIx::Class::Exception;
push(@j, $self->_from_chunk_to_sql($to));
}
- push(@j, ' ON ', $self->_join_condition($on));
+ my ($sql, @bind) = $self->_join_condition($on);
+ push(@j, ' ON ', $sql);
+ push @{$self->{from_bind}}, @bind;
push @fchunks, join '', @j;
}
sub _join_condition {
my ($self, $cond) = @_;
- if (ref $cond eq 'HASH') {
- my %j;
- for (keys %$cond) {
- my $v = $cond->{$_};
- if (ref $v) {
- $self->throw_exception (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
- if ref($v) ne 'SCALAR';
- $j{$_} = $v;
- }
- else {
- my $x = '= '.$self->_quote($v); $j{$_} = \$x;
- }
- };
- return scalar($self->_recurse_where(\%j));
- } elsif (ref $cond eq 'ARRAY') {
- return join(' OR ', map { $self->_join_condition($_) } @$cond);
- } else {
- die "Can't handle this yet!";
+ # Backcompat for the old days when a plain hashref
+ # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
+ # Once things settle we should start warning here so that
+ # folks unroll their hacks
+ if (
+ ref $cond eq 'HASH'
+ and
+ keys %$cond == 1
+ and
+ (keys %$cond)[0] =~ /\./
+ and
+ ! ref ( (values %$cond)[0] )
+ ) {
+ $cond = { keys %$cond => { -ident => values %$cond } }
}
+ elsif ( ref $cond eq 'ARRAY' ) {
+ # do our own ORing so that the hashref-shim above is invoked
+ my @parts;
+ my @binds;
+ foreach my $c (@$cond) {
+ my ($sql, @bind) = $self->_join_condition($c);
+ push @binds, @bind;
+ push @parts, $sql;
+ }
+ return join(' OR ', @parts), @binds;
+ }
+
+ return $self->_recurse_where($cond);
}
1;
&& $jt !~ /inner/i;
}
+ # sadly SQLA treats where($scalar) as literal, so we need to jump some hoops
push @where, map { \sprintf ('%s%s = %s%s',
- $self->_quote($_),
+ ref $_ ? $self->_recurse_where($_) : $self->_quote($_),
$left_join,
- $self->_quote($on->{$_}),
+ ref $on->{$_} ? $self->_recurse_where($on->{$_}) : $self->_quote($on->{$_}),
$right_join,
)} keys %$on;
}
'join 5 (SCALAR reference for ON statement) ok'
);
-my @j6 = (
- { child => 'person' },
- [ { father => 'person' }, { 'father.person_id' => { '!=', '42' } }, ],
- [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ],
-);
-$match = qr/HASH reference arguments are not supported in JOINS/;
-eval { $sa->_recurse_from(@j6) };
-like( $@, $match, 'join 6 (HASH reference for ON statement dies) ok' );
-
my $rs = $schema->resultset("CD")->search(
{ 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ from => [ { 'me' => 'cd' },
DBICTest::Schema::Artist;
use base qw/DBICTest::BaseResult/;
+use Carp qw/confess/;
__PACKAGE__->table('artist');
__PACKAGE__->source_info({
cds => 'DBICTest::Schema::CD', undef,
{ order_by => { -asc => 'year'} },
);
+
+
+__PACKAGE__->has_many(
+ cds_80s => 'DBICTest::Schema::CD',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artist" => { '=' => { -ident => "$args->{self_alias}.artistid"} },
+ "$args->{foreign_alias}.year" => { '>' => 1979, '<' => 1990 },
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.artist" => $args->{self_rowobj}->artistid,
+ "$args->{foreign_alias}.year" => { '>' => 1979, '<' => 1990 },
+ }
+ );
+ },
+);
+
+
+__PACKAGE__->has_many(
+ cds_84 => 'DBICTest::Schema::CD',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
+ "$args->{foreign_alias}.year" => 1984,
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.artist" => $args->{self_rowobj}->artistid,
+ "$args->{foreign_alias}.year" => 1984,
+ }
+ );
+ }
+);
+
+
+__PACKAGE__->has_many(
+ cds_90s => 'DBICTest::Schema::CD',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artist" => { -ident => "$args->{self_alias}.artistid" },
+ "$args->{foreign_alias}.year" => { '>' => 1989, '<' => 2000 },
+ }
+ );
+ }
+);
+
+
__PACKAGE__->has_many(
cds_unordered => 'DBICTest::Schema::CD'
);
DBICTest::Schema::Artwork;
use base qw/DBICTest::BaseResult/;
+use Carp qw/confess/;
__PACKAGE__->table('cd_artwork');
__PACKAGE__->add_columns(
__PACKAGE__->has_many('artwork_to_artist', 'DBICTest::Schema::Artwork_to_Artist', 'artwork_cd_id');
__PACKAGE__->many_to_many('artists', 'artwork_to_artist', 'artist');
+# both to test manytomany with custom rel
+__PACKAGE__->many_to_many('artists_test_m2m', 'artwork_to_artist', 'artist_test_m2m');
+__PACKAGE__->many_to_many('artists_test_m2m_noopt', 'artwork_to_artist', 'artist_test_m2m_noopt');
+
+# other test to manytomany
+__PACKAGE__->has_many('artwork_to_artist_test_m2m', 'DBICTest::Schema::Artwork_to_Artist',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artwork_cd_id" => { -ident => "$args->{self_alias}.cd_id" },
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.artwork_cd_id" => $args->{self_rowobj}->cd_id,
+ }
+ );
+ }
+);
+__PACKAGE__->many_to_many('artists_test_m2m2', 'artwork_to_artist_test_m2m', 'artist');
+
1;
DBICTest::Schema::Artwork_to_Artist;
use base qw/DBICTest::BaseResult/;
+use Carp qw/confess/;
__PACKAGE__->table('artwork_to_artist');
__PACKAGE__->add_columns(
__PACKAGE__->belongs_to('artwork', 'DBICTest::Schema::Artwork', 'artwork_cd_id');
__PACKAGE__->belongs_to('artist', 'DBICTest::Schema::Artist', 'artist_id');
+__PACKAGE__->belongs_to('artist_test_m2m', 'DBICTest::Schema::Artist',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artistid" => { -ident => "$args->{self_alias}.artist_id" },
+ "$args->{foreign_alias}.rank" => { '<' => 10 },
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.artistid" => $args->{self_rowobj}->artist_id,
+ "$args->{foreign_alias}.rank" => { '<' => 10 },
+ }
+ );
+ }
+);
+
+__PACKAGE__->belongs_to('artist_test_m2m_noopt', 'DBICTest::Schema::Artist',
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.artistid" => { -ident => "$args->{self_alias}.artist_id" },
+ "$args->{foreign_alias}.rank" => { '<' => 10 },
+ }
+ );
+ }
+);
+
1;
-package # hide from PAUSE
+package # hide from PAUSE
DBICTest::Schema::Track;
use base qw/DBICTest::BaseResult/;
+use Carp qw/confess/;
+
__PACKAGE__->load_components(qw/InflateColumn::DateTime Ordered/);
__PACKAGE__->table('track');
{ join_type => 'left' },
);
+__PACKAGE__->might_have (
+ next_track => __PACKAGE__,
+ sub {
+ my $args = shift;
+
+ # This is for test purposes only. A regular user does not
+ # need to sanity check the passed-in arguments, this is what
+ # the tests are for :)
+ my @missing_args = grep { ! defined $args->{$_} }
+ qw/self_alias foreign_alias self_resultsource foreign_relname/;
+ confess "Required arguments not supplied to custom rel coderef: @missing_args\n"
+ if @missing_args;
+
+ return (
+ { "$args->{foreign_alias}.cd" => { -ident => "$args->{self_alias}.cd" },
+ "$args->{foreign_alias}.position" => { '>' => { -ident => "$args->{self_alias}.position" } },
+ },
+ $args->{self_rowobj} && {
+ "$args->{foreign_alias}.cd" => $args->{self_rowobj}->cd,
+ "$args->{foreign_alias}.position" => { '>' => $args->{self_rowobj}->position },
+ }
+ )
+ }
+);
+
1;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+$schema->resultset('Artist')->delete;
+$schema->resultset('CD')->delete;
+
+my $artist = $schema->resultset("Artist")->create({ artistid => 21, name => 'Michael Jackson', rank => 20 });
+my $artist2 = $schema->resultset("Artist")->create({ artistid => 22, name => 'Chico Buarque', rank => 1 }) ;
+my $artist3 = $schema->resultset("Artist")->create({ artistid => 23, name => 'Ziraldo', rank => 1 });
+my $artist4 = $schema->resultset("Artist")->create({ artistid => 24, name => 'Paulo Caruso', rank => 20 });
+
+my @artworks;
+
+foreach my $year (1975..1985) {
+ my $cd = $artist->create_related('cds', { year => $year, title => 'Compilation from ' . $year });
+ push @artworks, $cd->create_related('artwork', {});
+}
+
+foreach my $year (1975..1995) {
+ my $cd = $artist2->create_related('cds', { year => $year, title => 'Compilation from ' . $year });
+ push @artworks, $cd->create_related('artwork', {});
+}
+
+foreach my $artwork (@artworks) {
+ $artwork->create_related('artwork_to_artist', { artist => $_ }) for ($artist3, $artist4);
+}
+
+
+my $cds_80s_rs = $artist->cds_80s;
+is_same_sql_bind(
+ $cds_80s_rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ WHERE ( ( me.artist = ? AND ( me.year < ? AND me.year > ? ) ) )
+ )',
+ [
+ [
+ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 21
+ ],
+ [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.year' }
+ => 1990
+ ],
+ [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.year' }
+ => 1979
+ ],
+ ],
+);
+my @cds_80s = $cds_80s_rs->all;
+is(@cds_80s, 6, '6 80s cds found (1980 - 1985)');
+map { ok($_->year < 1990 && $_->year > 1979) } @cds_80s;
+
+
+my $cds_90s_rs = $artist2->cds_90s;
+is_same_sql_bind(
+ $cds_90s_rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM artist artist__row
+ JOIN cd me
+ ON ( me.artist = artist__row.artistid AND ( me.year < ? AND me.year > ? ) )
+ WHERE ( artist__row.artistid = ? )
+ )',
+ [
+ [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.year' }
+ => 2000
+ ],
+ [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.year' }
+ => 1989
+ ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'artist__row.artistid' }
+ => 22
+ ],
+ ]
+);
+my @cds_90s = $cds_90s_rs->all;
+is(@cds_90s, 6, '6 90s cds found (1990 - 1995) even with non-optimized search');
+map { ok($_->year < 2000 && $_->year > 1989) } @cds_90s;
+
+lives_ok {
+ my @cds_90s_95 = $artist2->cds_90s->search({ 'me.year' => 1995 });
+ is(@cds_90s_95, 1, '1 90s (95) cds found even with non-optimized search');
+ map { ok($_->year == 1995) } @cds_90s_95;
+} 'should preserve chain-head "me" alias (API-consistency)';
+
+# search for all artists prefetching published cds in the 80s...
+my @all_artists_with_80_cds = $schema->resultset("Artist")->search
+ ({ 'cds_80s.cdid' => { '!=' => undef } }, { join => 'cds_80s', distinct => 1 });
+
+is_deeply(
+ [ sort ( map { $_->year } map { $_->cds_80s->all } @all_artists_with_80_cds ) ],
+ [ sort (1980..1989, 1980..1985) ],
+ '16 correct cds found'
+);
+
+TODO: {
+local $TODO = 'Prefetch on custom rels can not work until the collapse rewrite is finished '
+ . '(currently collapser requires a right-side (which is indeterministic) order-by)';
+lives_ok {
+
+my @all_artists_with_80_cds_pref = $schema->resultset("Artist")->search
+ ({ 'cds_80s.cdid' => { '!=' => undef } }, { prefetch => 'cds_80s' });
+
+is_deeply(
+ [ sort ( map { $_->year } map { $_->cds_80s->all } @all_artists_with_80_cds_pref ) ],
+ [ sort (1980..1989, 1980..1985) ],
+ '16 correct cds found'
+);
+
+} 'prefetchy-fetchy-fetch';
+} # end of TODO
+
+
+# try to create_related a 80s cd
+throws_ok {
+ $artist->create_related('cds_80s', { title => 'related creation 1' });
+} qr/\QCustom relationship 'cds_80s' not definitive - returns conditions instead of values for column(s): 'year'/,
+'Create failed - complex cond';
+
+# now supply an explicit arg overwriting the ambiguous cond
+my $id_2020 = $artist->create_related('cds_80s', { title => 'related creation 2', year => '2020' })->id;
+is(
+ $schema->resultset('CD')->find($id_2020)->title,
+ 'related creation 2',
+ '2020 CD created correctly'
+);
+
+# try a default year from a specific rel
+my $id_1984 = $artist->create_related('cds_84', { title => 'related creation 3' })->id;
+is(
+ $schema->resultset('CD')->find($id_1984)->title,
+ 'related creation 3',
+ '1984 CD created correctly'
+);
+
+# try a specific everything via a non-simplified rel
+throws_ok {
+ $artist->create_related('cds_90s', { title => 'related_creation 4', year => '2038' });
+} qr/\QCustom relationship 'cds_90s' does not resolve to a join-free condition fragment/,
+'Create failed - non-simplified rel';
+
+# Do a self-join last-entry search
+my @last_tracks;
+for my $cd ($schema->resultset('CD')->search ({}, { order_by => 'cdid'})->all) {
+ push @last_tracks, $cd->tracks
+ ->search ({}, { order_by => { -desc => 'position'} })
+ ->next || ();
+}
+
+my $last_tracks_rs = $schema->resultset('Track')->search (
+ {'next_track.trackid' => undef},
+ { join => 'next_track', order_by => 'me.cd' },
+);
+
+is_deeply (
+ [$last_tracks_rs->get_column ('trackid')->all],
+ [ map { $_->trackid } @last_tracks ],
+ 'last group-entry via self-join works',
+);
+
+my $artwork = $schema->resultset('Artwork')->search({},{ order_by => 'cd_id' })->first;
+my @artists = $artwork->artists->all;
+is(scalar @artists, 2, 'the two artists are associated');
+
+my @artwork_artists = $artwork->artwork_to_artist->all;
+foreach (@artwork_artists) {
+ lives_ok {
+ my $artista = $_->artist;
+ my $artistb = $_->artist_test_m2m;
+ ok($artista->rank < 10 ? $artistb : 1, 'belongs_to with custom rel works.');
+ my $artistc = $_->artist_test_m2m_noopt;
+ ok($artista->rank < 10 ? $artistc : 1, 'belongs_to with custom rel works even in non-simplified.');
+ } 'belongs_to works with custom rels';
+}
+
+@artists = ();
+lives_ok {
+ @artists = $artwork->artists_test_m2m2->all;
+} 'manytomany with extended rels in the has many works';
+is(scalar @artists, 2, 'two artists');
+
+@artists = ();
+lives_ok {
+ @artists = $artwork->artists_test_m2m->all;
+} 'can fetch many to many with optimized version';
+is(scalar @artists, 1, 'only one artist is associated');
+
+@artists = ();
+lives_ok {
+ @artists = $artwork->artists_test_m2m_noopt->all;
+} 'can fetch many to many with non-optimized version';
+is(scalar @artists, 1, 'only one artist is associated');
+
+
+# Make a single for each last_track
+my @singles = map {
+ $_->create_related('cd_single', {
+ title => $_->title . ' (the single)',
+ artist => $artist,
+ year => 1999,
+ }) } @last_tracks
+;
+
+# See if chaining works
+is_deeply (
+ [ map { $_->title } $last_tracks_rs->search_related('cd_single')->all ],
+ [ map { $_->title } @singles ],
+ 'Retrieved singles in proper order'
+);
+
+# See if prefetch works
+is_deeply (
+ [ map { $_->cd_single->title } $last_tracks_rs->search({}, { prefetch => 'cd_single' })->all ],
+ [ map { $_->title } @singles ],
+ 'Prefetched singles in proper order'
+);
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff