Institute a central "load this first in testing" package

[dbsrgits/DBIx-Class.git] / t / relationship / info.t

BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }

use strict;
use warnings;

use Test::More;

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;