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