use strict;
use warnings;
use Test::More;
use lib qw(t/lib);
use DBICTest;
#
# The test must be performed on non-registered result classes
#
{
package DBICTest::Thing;
use warnings;
use strict;
use base qw/DBIx::Class::Core/;
__PACKAGE__->table('thing');
__PACKAGE__->add_columns(qw/id ancestor_id/);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->has_many(children => __PACKAGE__, 'id');
__PACKAGE__->belongs_to(parent => __PACKAGE__, 'id', { join_type => 'left' } );
__PACKAGE__->has_many(subthings => 'DBICTest::SubThing', 'thing_id');
}
{
package DBICTest::SubThing;
use warnings;
use strict;
use base qw/DBIx::Class::Core/;
__PACKAGE__->table('subthing');
__PACKAGE__->add_columns(qw/thing_id/);
__PACKAGE__->belongs_to(thing => 'DBICTest::Thing', 'thing_id');
__PACKAGE__->belongs_to(thing2 => 'DBICTest::Thing', 'thing_id', { join_type => 'left' } );
}
my $schema = DBICTest->init_schema;
for my $without_schema (1,0) {
my ($t, $s) = $without_schema
? (qw/DBICTest::Thing DBICTest::SubThing/)
: do {
$schema->register_class(relinfo_thing => 'DBICTest::Thing');
$schema->register_class(relinfo_subthing => 'DBICTest::SubThing');
map { $schema->source ($_) } qw/relinfo_thing relinfo_subthing/;
}
;
is_deeply(
[ sort $t->relationships ],
[qw/ children parent subthings/],
"Correct relationships on $t",
);
is_deeply(
[ sort $s->relationships ],
[qw/ thing thing2 /],
"Correct relationships on $s",
);
is_deeply(
_instance($s)->reverse_relationship_info('thing'),
{ subthings => $t->relationship_info('subthings') },
'reverse_rel_info works cross-class belongs_to direction',
);
is_deeply(
_instance($s)->reverse_relationship_info('thing2'),
{ subthings => $t->relationship_info('subthings') },
'reverse_rel_info works cross-class belongs_to direction 2',
);
is_deeply(
_instance($t)->reverse_relationship_info('subthings'),
{ map { $_ => $s->relationship_info($_) } qw/thing thing2/ },
'reverse_rel_info works cross-class has_many direction',
);
is_deeply(
_instance($t)->reverse_relationship_info('parent'),
{ children => $t->relationship_info('children') },
'reverse_rel_info works in-class belongs_to direction',
);
is_deeply(
_instance($t)->reverse_relationship_info('children'),
{ parent => $t->relationship_info('parent') },
'reverse_rel_info works in-class has_many direction',
);
}
sub _instance {
$_[0]->isa('DBIx::Class::ResultSource')
? $_[0]
: $_[0]->result_source_instance
}
done_testing;