Commit | Line | Data |
02d58ac0 |
1 | #!perl |
2 | |
3 | use Test::More; |
4 | use Test::Exception; |
5 | |
6 | use lib 't/lib'; |
7 | use DBICDHTest; |
459a67e3 |
8 | use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator'; |
3b98a3a1 |
9 | use File::Spec::Functions; |
d50f2521 |
10 | use File::Path qw(rmtree mkpath); |
459a67e3 |
11 | |
12 | my $db = 'dbi:SQLite:db.db'; |
13 | my @connection = ($db, '', '', { ignore_version => 1 }); |
14 | my $sql_dir = 't/sql'; |
15 | |
16 | DBICDHTest::ready; |
17 | |
18 | VERSION1: { |
19 | use_ok 'DBICVersion_v1'; |
20 | my $s = DBICVersion::Schema->connect(@connection); |
21 | my $dm = Translator->new({ |
3b98a3a1 |
22 | schema => $s, |
459a67e3 |
23 | upgrade_directory => $sql_dir, |
3b98a3a1 |
24 | databases => ['SQLite'], |
02a7b8ac |
25 | sql_translator_args => { add_drop_table => 0 }, |
459a67e3 |
26 | }); |
27 | |
28 | ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' ); |
3b98a3a1 |
29 | |
91557c90 |
30 | $dm->prepare_deploy; |
d50f2521 |
31 | { |
32 | my $warned = 0; |
33 | local $SIG{__WARN__} = sub{$warned = 1}; |
91557c90 |
34 | $dm->prepare_deploy; |
35 | ok( $warned, 'prepare_deploy warns if you run it twice' ); |
d50f2521 |
36 | } |
37 | mkpath(catfile(qw( t sql _common schema 1.0 ))); |
38 | open my $common, '>', |
39 | catfile(qw( t sql _common schema 1.0 002-error.sql )); |
40 | print {$common} qq<syntax fail\n\n>; |
41 | close $common; |
3b98a3a1 |
42 | |
43 | ok( |
44 | -f catfile(qw( t sql SQLite schema 1.0 001-auto.sql )), |
45 | '1.0 schema gets generated properly' |
46 | ); |
47 | |
48 | dies_ok { |
49 | $s->resultset('Foo')->create({ |
50 | bar => 'frew', |
51 | }) |
52 | } 'schema not deployed'; |
53 | |
d50f2521 |
54 | mkpath catfile(qw( t sql _common schema 1.0 )); |
9c4cee90 |
55 | open $common, '>', |
d50f2521 |
56 | catfile(qw( t sql _common schema 1.0 001-auto.sql )); |
57 | print {$common} qq<This will never get run>; |
58 | close $common; |
59 | { |
60 | my $warned = 0; |
61 | local $SIG{__WARN__} = sub{$warned = 1}; |
7d2a6974 |
62 | $dm->deploy; |
d50f2521 |
63 | ok( $warned, 'deploy warns on sql errors' ); |
64 | } |
3b98a3a1 |
65 | |
66 | lives_ok { |
67 | $s->resultset('Foo')->create({ |
68 | bar => 'frew', |
69 | }) |
70 | } 'schema is deployed'; |
71 | } |
72 | |
73 | VERSION2: { |
74 | use_ok 'DBICVersion_v2'; |
75 | my $s = DBICVersion::Schema->connect(@connection); |
76 | my $dm = Translator->new({ |
77 | schema => $s, |
78 | upgrade_directory => $sql_dir, |
79 | databases => ['SQLite'], |
02a7b8ac |
80 | sql_translator_args => { add_drop_table => 0 }, |
91557c90 |
81 | txn_wrap => 1, |
3b98a3a1 |
82 | }); |
83 | |
84 | ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly'); |
85 | |
86 | $version = $s->schema_version(); |
91557c90 |
87 | $dm->prepare_deploy; |
3b98a3a1 |
88 | ok( |
89 | -f catfile(qw( t sql SQLite schema 2.0 001-auto.sql )), |
90 | '2.0 schema gets generated properly' |
91 | ); |
d50f2521 |
92 | mkpath(catfile(qw( t sql SQLite up 1.0-2.0 ))); |
41219a5d |
93 | $dm->prepare_upgrade(qw(1.0 2.0), [qw(1.0 2.0)]); |
d50f2521 |
94 | |
95 | { |
96 | my $warned = 0; |
97 | local $SIG{__WARN__} = sub{$warned = 1}; |
41219a5d |
98 | $dm->prepare_upgrade(qw(0.0 1.0), [qw(0.0 1.0)]); |
d50f2521 |
99 | ok( $warned, 'prepare_upgrade with a bogus preversion warns' ); |
100 | } |
3b98a3a1 |
101 | ok( |
102 | -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )), |
d50f2521 |
103 | '1.0-2.0 diff gets generated properly and default start and end versions get set' |
3b98a3a1 |
104 | ); |
d50f2521 |
105 | mkpath(catfile(qw( t sql SQLite down 2.0-1.0 ))); |
41219a5d |
106 | $dm->prepare_downgrade($version, '1.0', [$version, '1.0']); |
3b98a3a1 |
107 | ok( |
108 | -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql )), |
d50f2521 |
109 | '2.0-1.0 diff gets generated properly' |
3b98a3a1 |
110 | ); |
111 | dies_ok { |
112 | $s->resultset('Foo')->create({ |
113 | bar => 'frew', |
114 | baz => 'frew', |
115 | }) |
116 | } 'schema not deployed'; |
117 | dies_ok { |
118 | $s->resultset('Foo')->create({ |
119 | bar => 'frew', |
120 | baz => 'frew', |
121 | }) |
122 | } 'schema not uppgrayyed'; |
d50f2521 |
123 | |
124 | mkpath catfile(qw( t sql _common up 1.0-2.0 )); |
125 | open my $common, '>', |
126 | catfile(qw( t sql _common up 1.0-2.0 002-semiautomatic.sql )); |
127 | print {$common} qq<INSERT INTO Foo (bar, baz) VALUES ("hello", "world");\n\n>; |
128 | close $common; |
129 | |
0841a743 |
130 | open my $common_pl, '>', |
131 | catfile(qw( t sql _common up 1.0-2.0 003-semiautomatic.pl )); |
132 | print {$common_pl} q| |
91557c90 |
133 | sub run { |
134 | my $schema = shift; |
135 | $schema->resultset('Foo')->create({ |
136 | bar => 'goodbye', |
137 | baz => 'blue skies', |
138 | }) |
139 | } |
140 | |; |
0841a743 |
141 | close $common_pl; |
142 | |
7d2a6974 |
143 | $dm->upgrade_single_step([qw( 1.0 2.0 )]); |
d50f2521 |
144 | is( $s->resultset('Foo')->search({ |
145 | bar => 'hello', |
146 | baz => 'world', |
147 | })->count, 1, '_common migration got run'); |
0841a743 |
148 | is( $s->resultset('Foo')->search({ |
149 | bar => 'goodbye', |
150 | #baz => 'blue skies', |
151 | })->count, 1, '_common perl migration got run'); |
3b98a3a1 |
152 | lives_ok { |
153 | $s->resultset('Foo')->create({ |
154 | bar => 'frew', |
155 | baz => 'frew', |
156 | }) |
157 | } 'schema is deployed'; |
7d2a6974 |
158 | $dm->downgrade_single_step([qw( 2.0 1.0 )]); |
d50f2521 |
159 | dies_ok { |
160 | $s->resultset('Foo')->create({ |
161 | bar => 'frew', |
162 | baz => 'frew', |
163 | }) |
164 | } 'schema is downpgrayyed'; |
7d2a6974 |
165 | $dm->upgrade_single_step([qw( 1.0 2.0 )]); |
459a67e3 |
166 | } |
02d58ac0 |
167 | |
3b98a3a1 |
168 | VERSION3: { |
169 | use_ok 'DBICVersion_v3'; |
170 | my $s = DBICVersion::Schema->connect(@connection); |
171 | my $dm = Translator->new({ |
172 | schema => $s, |
173 | upgrade_directory => $sql_dir, |
174 | databases => ['SQLite'], |
02a7b8ac |
175 | sql_translator_args => { add_drop_table => 0 }, |
d50f2521 |
176 | txn_wrap => 0, |
3b98a3a1 |
177 | }); |
178 | |
179 | ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly'); |
180 | |
181 | $version = $s->schema_version(); |
91557c90 |
182 | $dm->prepare_deploy; |
3b98a3a1 |
183 | ok( |
184 | -f catfile(qw( t sql SQLite schema 3.0 001-auto.sql )), |
185 | '2.0 schema gets generated properly' |
186 | ); |
41219a5d |
187 | $dm->prepare_downgrade($version, '1.0', [$version, '1.0']); |
3b98a3a1 |
188 | ok( |
d50f2521 |
189 | -f catfile(qw( t sql SQLite down 3.0-1.0 001-auto.sql )), |
190 | '3.0-1.0 diff gets generated properly' |
191 | ); |
192 | $dm->prepare_upgrade( '1.0', $version, ['1.0', $version] ); |
193 | ok( |
194 | -f catfile(qw( t sql SQLite up 1.0-3.0 001-auto.sql )), |
3b98a3a1 |
195 | '1.0-3.0 diff gets generated properly' |
196 | ); |
41219a5d |
197 | $dm->prepare_upgrade( '2.0', $version, ['2.0', $version]); |
d50f2521 |
198 | { |
199 | my $warned = 0; |
200 | local $SIG{__WARN__} = sub{$warned = 1}; |
41219a5d |
201 | $dm->prepare_upgrade( '2.0', $version, ['2.0', $version] ); |
d50f2521 |
202 | ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' ); |
203 | } |
3b98a3a1 |
204 | ok( |
205 | -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )), |
206 | '2.0-3.0 diff gets generated properly' |
207 | ); |
d50f2521 |
208 | mkpath catfile(qw( t sql _generic up 2.0-3.0 )); |
209 | rename catfile(qw( t sql SQLite up 2.0-3.0 001-auto.sql )), catfile(qw( t sql _generic up 2.0-3.0 001-auto.sql )); |
210 | rmtree(catfile(qw( t sql SQLite ))); |
211 | warn 'how can this be' if -d catfile(qw( t sql SQLite )); |
3b98a3a1 |
212 | dies_ok { |
213 | $s->resultset('Foo')->create({ |
214 | bar => 'frew', |
215 | baz => 'frew', |
216 | biff => 'frew', |
217 | }) |
218 | } 'schema not deployed'; |
7d2a6974 |
219 | $dm->upgrade_single_step([qw( 2.0 3.0 )]); |
3b98a3a1 |
220 | lives_ok { |
221 | $s->resultset('Foo')->create({ |
222 | bar => 'frew', |
223 | baz => 'frew', |
224 | biff => 'frew', |
225 | }) |
d50f2521 |
226 | } 'schema is deployed using _generic'; |
227 | rmtree(catfile(qw( t sql SQLite ))); |
228 | rmtree(catfile(qw( t sql _generic ))); |
229 | dies_ok { |
7d2a6974 |
230 | $dm->upgrade_single_step([qw( 2.0 3.0 )]); |
d50f2521 |
231 | } 'dies when sql dir does not exist'; |
3b98a3a1 |
232 | } |
02d58ac0 |
233 | done_testing; |
d50f2521 |
234 | #vim: ts=2 sw=2 expandtab |