t/relationship/info.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use lib qw(t/lib);
   6 use DBICTest;
   7
   8 #
   9 # The test must be performed on non-registered result classes
  10 #
  11 {
  12   package DBICTest::Thing;
  13   use warnings;
  14   use strict;
  15   use base qw/DBIx::Class::Core/;
  16   __PACKAGE__->table('thing');
  17   __PACKAGE__->add_columns(qw/id ancestor_id/);
  18   __PACKAGE__->set_primary_key('id');
  19   __PACKAGE__->has_many(children => __PACKAGE__, 'id');
  20   __PACKAGE__->belongs_to(parent => __PACKAGE__, 'id', { join_type => 'left' } );
  21
  22   __PACKAGE__->has_many(subthings => 'DBICTest::SubThing', 'thing_id');
  23 }
  24
  25 {
  26   package DBICTest::SubThing;
  27   use warnings;
  28   use strict;
  29   use base qw/DBIx::Class::Core/;
  30   __PACKAGE__->table('subthing');
  31   __PACKAGE__->add_columns(qw/thing_id/);
  32   __PACKAGE__->belongs_to(thing => 'DBICTest::Thing', 'thing_id');
  33   __PACKAGE__->belongs_to(thing2 => 'DBICTest::Thing', 'thing_id', { join_type => 'left' } );
  34 }
  35
  36 my $schema = DBICTest->init_schema;
  37
  38 for my $without_schema (1,0) {
  39
  40   my ($t, $s) = $without_schema
  41     ? (qw/DBICTest::Thing DBICTest::SubThing/)
  42     : do {
  43       $schema->register_class(relinfo_thing => 'DBICTest::Thing');
  44       $schema->register_class(relinfo_subthing => 'DBICTest::SubThing');
  45
  46       map { $schema->source ($_) } qw/relinfo_thing relinfo_subthing/;
  47     }
  48   ;
  49
  50   is_deeply(
  51     [ sort $t->relationships ],
  52     [qw/ children parent subthings/],
  53     "Correct relationships on $t",
  54   );
  55
  56   is_deeply(
  57     [ sort $s->relationships ],
  58     [qw/ thing thing2 /],
  59     "Correct relationships on $s",
  60   );
  61
  62   is_deeply(
  63     _instance($s)->reverse_relationship_info('thing'),
  64     { subthings => $t->relationship_info('subthings') },
  65     'reverse_rel_info works cross-class belongs_to direction',
  66   );
  67   is_deeply(
  68     _instance($s)->reverse_relationship_info('thing2'),
  69     { subthings => $t->relationship_info('subthings') },
  70     'reverse_rel_info works cross-class belongs_to direction 2',
  71   );
  72
  73   is_deeply(
  74     _instance($t)->reverse_relationship_info('subthings'),
  75     { map { $_ => $s->relationship_info($_) } qw/thing thing2/ },
  76     'reverse_rel_info works cross-class has_many direction',
  77   );
  78
  79   is_deeply(
  80     _instance($t)->reverse_relationship_info('parent'),
  81     { children => $t->relationship_info('children') },
  82     'reverse_rel_info works in-class belongs_to direction',
  83   );
  84   is_deeply(
  85     _instance($t)->reverse_relationship_info('children'),
  86     { parent => $t->relationship_info('parent') },
  87     'reverse_rel_info works in-class has_many direction',
  88   );
  89 }
  90
  91 sub _instance {
  92   $_[0]->isa('DBIx::Class::ResultSource')
  93     ? $_[0]
  94     : $_[0]->result_source_instance
  95 }
  96
  97 done_testing;