dbix-class-query.sql

SELECT
  me.title, rel_b.title, rel_b.obj, object.title, object.info
FROM
  subject me
  LEFT JOIN rel_a rel_a ON rel_a.title = me.title
  LEFT JOIN object object ON object.title = rel_a.obj
  LEFT JOIN rel_b rel_b ON rel_b.title = me.title
  LEFT JOIN object object_2 ON object_2.title = rel_b.obj
ORDER BY rel_b.title

generated by 

$s->resultset('subject')
	->search(undef, {
		join => [{'rel_a' => 'object'}],
		prefetch => [{'rel_b' => 'object'}],
	})

diamond.pl

package S::Result::object;

use base 'DBIx::Class';

__PACKAGE__->load_components('Core');

__PACKAGE__->table('object');
__PACKAGE__->add_columns('title', 'info');
__PACKAGE__->set_primary_key('title');

__PACKAGE__->has_many('rel_a', 'S::Result::rel_a', 'obj');
__PACKAGE__->has_many('rel_b', 'S::Result::rel_b', 'obj');

package S::Result::subject;

use base 'DBIx::Class';

__PACKAGE__->load_components('Core');

__PACKAGE__->table('subject');
__PACKAGE__->add_columns('title');
__PACKAGE__->set_primary_key('title');

__PACKAGE__->has_many('rel_a', 'S::Result::rel_a', 'title');
__PACKAGE__->has_many('rel_b', 'S::Result::rel_b', 'title');

package S::Result::rel_a;

use base 'DBIx::Class';

__PACKAGE__->load_components('Core');

__PACKAGE__->table('rel_a');
__PACKAGE__->add_columns('title', 'obj');
__PACKAGE__->set_primary_key('title', 'obj');

__PACKAGE__->belongs_to('subject', 'S::Result::subject', 'title');
__PACKAGE__->belongs_to('object', 'S::Result::object', 'obj');

package S::Result::rel_b;

use base 'DBIx::Class';

__PACKAGE__->load_components('Core');

__PACKAGE__->table('rel_b');
__PACKAGE__->add_columns('title', 'obj');
__PACKAGE__->set_primary_key('title', 'obj');

__PACKAGE__->belongs_to('subject', 'S::Result::subject', 'title');
__PACKAGE__->belongs_to('object', 'S::Result::object', 'obj');

package S;

use base 'DBIx::Class::Schema';

__PACKAGE__->register_class($_, 'S::Result::' . $_)
	foreach (qw(subject object rel_a rel_b));

package main;

my $s = S->connect('dbi:SQLite:diamond.db');

# foreach ($s->resultset('subject')
# 	->search({
# 		'object.title' => 'foo'
# 	}, {
# 		join => {
# 			'rel_a' => 'object'
# 		}
# 	})
# 	->search(undef, {
# 		prefetch => {
# 			rel_b => 'object'
# 		}
# 	})->all()
# ) {
# 	# should return bar
# 	print $_->rel_b->first->object->title, "\n";
# }
# 
# foreach ($s->resultset('subject')
# 	->search({
# 		'object.title' => 'foo'
# 	}, {
# 		join => {
# 			rel_a => 'object'
# 		}
# 	})->all()
# ) {
# 	# should return bar
# 	print $_->rel_b->first->object->title, "\n";
# }

print "No prefetch:\n";
foreach ($s->resultset('subject')->all()) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "prefetch rel_a, rel_b:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		prefetch => ['rel_a', 'rel_b'],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "prefetch rel_a => object, rel_b:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		prefetch => [{'rel_a' => 'object'}, 'rel_b'],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "prefetch rel_a, rel_b => object:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		prefetch => ['rel_a', {'rel_b' => 'object'}],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "prefetch rel_a => object, rel_b => object:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		prefetch => [{'rel_a' => 'object'}, {'rel_b' => 'object'}],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "join rel_a, prefetch rel_b:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		join => ['rel_a'],
		prefetch => ['rel_b'],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "join rel_a => object, prefetch rel_b:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		join => [{'rel_a' => 'object'}],
		prefetch => ['rel_b'],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

print "join rel_a, prefetch rel_b => object:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		join => ['rel_a'],
		prefetch => [{'rel_b' => 'object'}],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

# this fails
print "join rel_a => object, prefetch rel_b => object:\n";
foreach ($s->resultset('subject')
	->search(undef, {
		join => [{'rel_a' => 'object'}],
		prefetch => [{'rel_b' => 'object'}],
	})
) {
	print "foo: ";
	print $_->rel_a->first->object->title, "\n";

	print "bar: ";
	print $_->rel_b->first->object->title, "\n";
}

__DATA__

Database:

BEGIN TRANSACTION;
CREATE TABLE rel_a (title text, obj text);
INSERT INTO "rel_a" VALUES('blub','foo');
CREATE TABLE subject (title text);
INSERT INTO "subject" VALUES('blub');
CREATE TABLE rel_b (title text, obj text);
INSERT INTO "rel_b" VALUES('blub','bar');
CREATE TABLE object (title text, info text);
INSERT INTO "object" VALUES('foo','this is foo');
INSERT INTO "object" VALUES('bar','this is bar');
COMMIT;

diamond.t

gheift@gheift:~/Project/Perl/0.08$ cat t/prefetch/diamond_2.t 
# Test if prefetch and join in diamond relationship fetching the correct rows
use strict;
use warnings;

use Test::More;
use lib qw(t/lib);
use DBICTest;
use Data::Dumper;

my $schema = DBICTest->init_schema();

$schema->populate('Artwork', [
    [ qw/cd_id/ ],
    [ 1 ],
]);

$schema->populate('Artwork_to_Artist', [
    [ qw/artwork_cd_id artist_id/ ],
    [ 1, 2 ],
]);

my $ars = $schema->resultset ('Artwork');

# The relationship diagram here is:
#
#  $ars --> artwork_to_artist
#   |              |
#   |              |
#   V              V
#   cd  ------>  artist
#
# The current artwork belongs to a cd by artist1
# but the artwork itself is painted by artist2
#
# What we try is all possible permutations of join/prefetch 
# combinations in both directions, while always expecting to
# arrive at the specific artist at the end of each path.


my $cd_paths = {
  'no cd' => [],
  'cd' => ['cd'],
  'cd->artist1' => [{'cd' => 'artist'}]
};
my $a2a_paths = {
  'no a2a' => [],
  'a2a' => ['artwork_to_artist'],
  'a2a->artist2' => [{'artwork_to_artist' => 'artist'}]
};

my %tests;

sub join_attr {
  my $attr = {
    'join' => [],
    'prefetch' => [],
  };

  my @how;
  my @ref;
  ($how[0], $ref[0], $how[1], $ref[1]) = @_;

  foreach my $i (0, 1) {
    push @{$attr->{$how[$i]}}, @{$ref[$i]};
  }

  return $attr;
}

my @joins = (
  ['join', 'join'],
  ['join', 'prefetch'],
  ['prefetch', 'join'],
  ['prefetch', 'prefetch'],
);

my %statement = ();

$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;

foreach my $cd_path_1 (keys %$cd_paths) {
foreach my $a2a_path_1 (keys %$a2a_paths) {
foreach my $join_1 (@joins) {
foreach my $cd_path_2 (keys %$cd_paths) {
foreach my $a2a_path_2 (keys %$a2a_paths) {
foreach my $join_2 (@joins) {

    my $name = sprintf "1. search: %s %s, %s %s, 2. search %s %s, %s %s",
        $join_1->[0] => $cd_path_1, $join_1->[1] => $a2a_path_1,
        $join_2->[0] => $cd_path_2, $join_2->[1] => $a2a_path_2;

    my $attr1 =
        join_attr($join_1->[0] => $cd_paths->{$cd_path_1}, $join_1->[1] => $a2a_paths->{$a2a_path_1});

    my $attr2 =
        join_attr($join_2->[0] => $cd_paths->{$cd_path_2}, $join_2->[1] => $a2a_paths->{$a2a_path_2});

    $tests{$name} = $ars->search({}, $attr1)->search({}, $attr2);
    $statement{$name} = sprintf('$ars->search({}, %s)->search({}, %s)',
      Data::Dumper::Dumper($attr1),
      Data::Dumper::Dumper($attr2),
    );

}}}}}}

plan tests => (scalar (keys %tests) * 3);

foreach my $name (keys %tests) {
  foreach my $artwork ($tests{$name}->all()) {
    is($artwork->id, 1, 'artwork: ' . $name)
      or diag($statement{$name});
    is($artwork->cd->artist->artistid, 1, 'artist_id over cd: ' . $name)
      or diag($statement{$name});
    is($artwork->artwork_to_artist->first->artist->artistid, 2, 'artist_id over A2A: '. $name)
      or diag($statement{$name});
  }
}