1use strict;
2use Test::More;
3use lib qw(t/lib);
4use make_dbictest_db;
5
6local $SIG{__WARN__} = sub {
7    warn $_[0] unless $_[0] =~ /really_erase_my_files/
8};
9
10# Takes a $schema as input, runs 4 basic tests
11sub 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
27my @invocations = (
28    'hardcode' => sub {
29        package DBICTest::Schema::5;
30        use base qw/ DBIx::Class::Schema::Loader /;
31        __PACKAGE__->naming('current');
32        __PACKAGE__->connection($make_dbictest_db::dsn);
33        __PACKAGE__;
34    },
35    'normal' => sub {
36        package DBICTest::Schema::6;
37        use base qw/ DBIx::Class::Schema::Loader /;
38        __PACKAGE__->loader_options();
39        __PACKAGE__->naming('current');
40        __PACKAGE__->connect($make_dbictest_db::dsn);
41    },
42    'make_schema_at' => sub {
43        use DBIx::Class::Schema::Loader qw/ make_schema_at /;
44        make_schema_at(
45            'DBICTest::Schema::7',
46            { really_erase_my_files => 1, naming => 'current' },
47            [ $make_dbictest_db::dsn ],
48        );
49        DBICTest::Schema::7->clone;
50    },
51    'embedded_options' => sub {
52        package DBICTest::Schema::8;
53        use base qw/ DBIx::Class::Schema::Loader /;
54        __PACKAGE__->naming('current');
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__->naming('current');
64        __PACKAGE__->connect(
65            $make_dbictest_db::dsn,
66            undef,
67            undef,
68            { AutoCommit => 1, loader_options => { really_erase_my_files => 1 } }
69        );
70    },
71    'embedded_options_make_schema_at' => sub {
72        use DBIx::Class::Schema::Loader qw/ make_schema_at /;
73        make_schema_at(
74            'DBICTest::Schema::10',
75            { },
76            [
77                $make_dbictest_db::dsn,
78                { loader_options => {
79                    really_erase_my_files => 1,
80                    naming => 'current'
81                } },
82            ],
83        );
84        "DBICTest::Schema::10";
85    },
86    'almost_embedded' => sub {
87        package DBICTest::Schema::11;
88        use base qw/ DBIx::Class::Schema::Loader /;
89        __PACKAGE__->loader_options(
90            really_erase_my_files => 1,
91            naming => 'current'
92        );
93        __PACKAGE__->connect(
94            $make_dbictest_db::dsn,
95            undef, undef, { AutoCommit => 1 }
96        );
97    },
98    'make_schema_at_explicit' => sub {
99        use DBIx::Class::Schema::Loader;
100        DBIx::Class::Schema::Loader::make_schema_at(
101            'DBICTest::Schema::12',
102            { really_erase_my_files => 1, naming => 'current' },
103            [ $make_dbictest_db::dsn ],
104        );
105        DBICTest::Schema::12->clone;
106    },
107    'skip_load_external_1' => sub {
108        # By default we should pull in t/lib/DBICTest/Schema/13/Foo.pm $skip_me since t/lib is in @INC
109        use DBIx::Class::Schema::Loader;
110        DBIx::Class::Schema::Loader::make_schema_at(
111            'DBICTest::Schema::13',
112            { really_erase_my_files => 1, naming => 'current' },
113            [ $make_dbictest_db::dsn ],
114        );
115        DBICTest::Schema::13->clone;
116    },
117    'skip_load_external_2' => sub {
118        # When we explicitly skip_load_external t/lib/DBICTest/Schema/14/Foo.pm should be ignored
119        use DBIx::Class::Schema::Loader;
120        DBIx::Class::Schema::Loader::make_schema_at(
121            'DBICTest::Schema::14',
122            { really_erase_my_files => 1, naming => 'current', skip_load_external => 1 },
123            [ $make_dbictest_db::dsn ],
124        );
125        DBICTest::Schema::14->clone;
126    },
127);
128
129# 4 tests per k/v pair
130plan tests => 2 * @invocations + 2;  # + 2 more manual ones below.
131
132while(@invocations >= 2) {
133    my $style = shift @invocations;
134    my $subref = shift @invocations;
135    test_schema($style, &$subref);
136}
137
138{
139    no warnings 'once';
140
141    is($DBICTest::Schema::13::Foo::skip_me, "bad mojo",
142        "external content loaded");
143    is($DBICTest::Schema::14::Foo::skip_me, undef,
144        "external content not loaded with skip_load_external => 1");
145}
146