t/20invocations.t

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