5 # The test must be performed on non-registered result classes
8 package DBICTest::Thing;
11 use base qw/DBIx::Class::Core/;
12 __PACKAGE__->table('thing');
13 __PACKAGE__->add_columns(qw/id ancestor_id/);
14 __PACKAGE__->set_primary_key('id');
15 __PACKAGE__->has_many(children => __PACKAGE__, 'id');
16 __PACKAGE__->belongs_to(parent => __PACKAGE__, 'id', { join_type => 'left' } );
18 __PACKAGE__->has_many(subthings => 'DBICTest::SubThing', 'thing_id');
22 package DBICTest::SubThing;
25 use base qw/DBIx::Class::Core/;
26 __PACKAGE__->table('subthing');
27 __PACKAGE__->add_columns(qw/thing_id/);
28 __PACKAGE__->belongs_to(thing => 'DBICTest::Thing', 'thing_id');
29 __PACKAGE__->belongs_to(thing2 => 'DBICTest::Thing', 'thing_id', { join_type => 'left' } );
37 my $schema = DBICTest->init_schema;
39 for my $without_schema (1,0) {
41 my ($t, $s) = $without_schema
42 ? (qw/DBICTest::Thing DBICTest::SubThing/)
44 $schema->register_class(relinfo_thing => 'DBICTest::Thing');
45 $schema->register_class(relinfo_subthing => 'DBICTest::SubThing');
47 map { $schema->source ($_) } qw/relinfo_thing relinfo_subthing/;
52 [ sort $t->relationships ],
53 [qw/ children parent subthings/],
54 "Correct relationships on $t",
58 [ sort $s->relationships ],
60 "Correct relationships on $s",
64 _instance($s)->reverse_relationship_info('thing'),
65 { subthings => $t->relationship_info('subthings') },
66 'reverse_rel_info works cross-class belongs_to direction',
69 _instance($s)->reverse_relationship_info('thing2'),
70 { subthings => $t->relationship_info('subthings') },
71 'reverse_rel_info works cross-class belongs_to direction 2',
75 _instance($t)->reverse_relationship_info('subthings'),
76 { map { $_ => $s->relationship_info($_) } qw/thing thing2/ },
77 'reverse_rel_info works cross-class has_many direction',
81 _instance($t)->reverse_relationship_info('parent'),
82 { children => $t->relationship_info('children') },
83 'reverse_rel_info works in-class belongs_to direction',
86 _instance($t)->reverse_relationship_info('children'),
87 { parent => $t->relationship_info('parent') },
88 'reverse_rel_info works in-class has_many direction',
93 $_[0]->isa('DBIx::Class::ResultSource')
95 : $_[0]->result_source_instance