t/20invocations.t

   1 use strict;
   2 use Test::More;
   3 use lib qw(t/lib);
   4 use make_dbictest_db;
   5
   6 $SIG{__WARN__} = sub { }; # Suppress warnings, as we test a lot of deprecated stuff here
   7
   8 # Takes a $schema as input, runs 4 basic tests
   9 sub test_schema {
  10     my ($testname, $schema) = @_;
  11
  12     $schema = $schema->clone if !ref $schema;
  13     isa_ok($schema, 'DBIx::Class::Schema', $testname);
  14
  15     my $foo_rs = $schema->resultset('Bar')->search({ barid => 3})->search_related('fooref');
  16     isa_ok($foo_rs, 'DBIx::Class::ResultSet', $testname);
  17
  18     my $foo_first = $foo_rs->first;
  19     like(ref $foo_first, qr/DBICTest::Schema::\d+::Foo/, $testname);
  20
  21     my $foo_first_text = $foo_first->footext;
  22     is($foo_first_text, 'Foo record associated with the Bar with barid 3');
  23 }
  24
  25 my @invocations = (
  26     'hardcode' => sub {
  27         package DBICTest::Schema::5;
  28         use base qw/ DBIx::Class::Schema::Loader /;
  29         __PACKAGE__->connection($make_dbictest_db::dsn);
  30         __PACKAGE__;
  31     },
  32     'normal' => sub {
  33         package DBICTest::Schema::6;
  34         use base qw/ DBIx::Class::Schema::Loader /;
  35         __PACKAGE__->loader_options();
  36         __PACKAGE__->connect($make_dbictest_db::dsn);
  37     },
  38     'make_schema_at' => sub {
  39         use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  40         make_schema_at(
  41             'DBICTest::Schema::7',
  42             { relationships => 1 },
  43             [ $make_dbictest_db::dsn ],
  44         );
  45         DBICTest::Schema::7->clone;
  46     },
  47     'embedded_options' => sub {
  48         package DBICTest::Schema::8;
  49         use base qw/ DBIx::Class::Schema::Loader /;
  50         __PACKAGE__->connect(
  51             $make_dbictest_db::dsn,
  52             { loader_options => { relationships => 1 } }
  53         );
  54     },
  55     'embedded_options_in_attrs' => sub {
  56         package DBICTest::Schema::9;
  57         use base qw/ DBIx::Class::Schema::Loader /;
  58         __PACKAGE__->connect(
  59             $make_dbictest_db::dsn,
  60             undef,
  61             undef,
  62             { AutoCommit => 1, loader_options => { relationships => 1 } }
  63         );
  64     },
  65     'embedded_options_make_schema_at' => sub {
  66         use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  67         make_schema_at(
  68             'DBICTest::Schema::10',
  69             { },
  70             [
  71                 $make_dbictest_db::dsn,
  72                 { loader_options => { relationships => 1 } },
  73             ],
  74         );
  75         "DBICTest::Schema::10";
  76     },
  77     'almost_embedded' => sub {
  78         package DBICTest::Schema::11;
  79         use base qw/ DBIx::Class::Schema::Loader /;
  80         __PACKAGE__->loader_options( relationships => 1 );
  81         __PACKAGE__->connect(
  82             $make_dbictest_db::dsn,
  83             undef, undef, { AutoCommit => 1 }
  84         );
  85     },
  86     'make_schema_at_explicit' => sub {
  87         use DBIx::Class::Schema::Loader;
  88         DBIx::Class::Schema::Loader::make_schema_at(
  89             'DBICTest::Schema::12',
  90             { relationships => 1 },
  91             [ $make_dbictest_db::dsn ],
  92         );
  93         DBICTest::Schema::12->clone;
  94     }
  95 );
  96
  97 # 4 tests per k/v pair
  98 plan tests => 2 * @invocations;
  99
 100 while(@invocations >= 2) {
 101     my $style = shift @invocations;
 102     my $subref = shift @invocations;
 103     test_schema($style, &$subref);
 104 }