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, |
91adde75 |
23 | script_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; |
fc4b7602 |
31 | |
32 | mkpath(catfile(qw( t sql SQLite preinstall 1.0 ))); |
33 | open my $prerun, '>', |
34 | catfile(qw( t sql SQLite preinstall 1.0 003-semiautomatic.pl )); |
5b5defbc |
35 | print {$prerun} "sub {use File::Touch; touch(q(foobar));}"; |
fc4b7602 |
36 | close $prerun; |
be140a5f |
37 | $dm->preinstall({ version => '1.0' }); |
fc4b7602 |
38 | |
09bc35e3 |
39 | ok -e 'foobar'; |
fc4b7602 |
40 | |
d50f2521 |
41 | { |
42 | my $warned = 0; |
43 | local $SIG{__WARN__} = sub{$warned = 1}; |
91557c90 |
44 | $dm->prepare_deploy; |
45 | ok( $warned, 'prepare_deploy warns if you run it twice' ); |
d50f2521 |
46 | } |
3b98a3a1 |
47 | |
48 | ok( |
09bc35e3 |
49 | -f catfile(qw( t sql SQLite schema 1.0 001-auto.sql )), |
3b98a3a1 |
50 | '1.0 schema gets generated properly' |
51 | ); |
52 | |
53 | dies_ok { |
54 | $s->resultset('Foo')->create({ |
55 | bar => 'frew', |
56 | }) |
57 | } 'schema not deployed'; |
58 | |
026eaf0c |
59 | $dm->deploy; |
3b98a3a1 |
60 | |
61 | lives_ok { |
62 | $s->resultset('Foo')->create({ |
63 | bar => 'frew', |
64 | }) |
65 | } 'schema is deployed'; |
66 | } |
67 | |
68 | VERSION2: { |
69 | use_ok 'DBICVersion_v2'; |
70 | my $s = DBICVersion::Schema->connect(@connection); |
71 | my $dm = Translator->new({ |
72 | schema => $s, |
91adde75 |
73 | script_directory => $sql_dir, |
3b98a3a1 |
74 | databases => ['SQLite'], |
02a7b8ac |
75 | sql_translator_args => { add_drop_table => 0 }, |
91557c90 |
76 | txn_wrap => 1, |
3b98a3a1 |
77 | }); |
78 | |
79 | ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly'); |
80 | |
81 | $version = $s->schema_version(); |
91557c90 |
82 | $dm->prepare_deploy; |
3b98a3a1 |
83 | ok( |
09bc35e3 |
84 | -f catfile(qw( t sql SQLite schema 2.0 001-auto.sql )), |
3b98a3a1 |
85 | '2.0 schema gets generated properly' |
86 | ); |
d50f2521 |
87 | mkpath(catfile(qw( t sql SQLite up 1.0-2.0 ))); |
be140a5f |
88 | $dm->prepare_upgrade({ |
89 | from_version => '1.0', |
90 | to_version => '2.0', |
91 | version_set => [qw(1.0 2.0)] |
92 | }); |
d50f2521 |
93 | |
94 | { |
95 | my $warned = 0; |
96 | local $SIG{__WARN__} = sub{$warned = 1}; |
be140a5f |
97 | $dm->prepare_upgrade({ |
98 | from_version => '0.0', |
99 | to_version => '1.0', |
100 | version_set => [qw(0.0 1.0)] |
101 | }); |
d50f2521 |
102 | ok( $warned, 'prepare_upgrade with a bogus preversion warns' ); |
103 | } |
3b98a3a1 |
104 | ok( |
09bc35e3 |
105 | -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )), |
d50f2521 |
106 | '1.0-2.0 diff gets generated properly and default start and end versions get set' |
3b98a3a1 |
107 | ); |
d50f2521 |
108 | mkpath(catfile(qw( t sql SQLite down 2.0-1.0 ))); |
be140a5f |
109 | $dm->prepare_downgrade({ |
110 | from_version => $version, |
111 | to_version => '1.0', |
112 | version_set => [$version, '1.0'] |
113 | }); |
3b98a3a1 |
114 | ok( |
09bc35e3 |
115 | -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql )), |
d50f2521 |
116 | '2.0-1.0 diff gets generated properly' |
3b98a3a1 |
117 | ); |
118 | dies_ok { |
119 | $s->resultset('Foo')->create({ |
120 | bar => 'frew', |
121 | baz => 'frew', |
122 | }) |
123 | } 'schema not deployed'; |
124 | dies_ok { |
125 | $s->resultset('Foo')->create({ |
126 | bar => 'frew', |
127 | baz => 'frew', |
128 | }) |
129 | } 'schema not uppgrayyed'; |
d50f2521 |
130 | |
131 | mkpath catfile(qw( t sql _common up 1.0-2.0 )); |
132 | open my $common, '>', |
133 | catfile(qw( t sql _common up 1.0-2.0 002-semiautomatic.sql )); |
134 | print {$common} qq<INSERT INTO Foo (bar, baz) VALUES ("hello", "world");\n\n>; |
135 | close $common; |
136 | |
0841a743 |
137 | open my $common_pl, '>', |
138 | catfile(qw( t sql _common up 1.0-2.0 003-semiautomatic.pl )); |
139 | print {$common_pl} q| |
5b5defbc |
140 | sub { |
91557c90 |
141 | my $schema = shift; |
142 | $schema->resultset('Foo')->create({ |
143 | bar => 'goodbye', |
144 | baz => 'blue skies', |
145 | }) |
146 | } |
147 | |; |
0841a743 |
148 | close $common_pl; |
149 | |
be140a5f |
150 | $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] }); |
d50f2521 |
151 | is( $s->resultset('Foo')->search({ |
152 | bar => 'hello', |
153 | baz => 'world', |
154 | })->count, 1, '_common migration got run'); |
0841a743 |
155 | is( $s->resultset('Foo')->search({ |
156 | bar => 'goodbye', |
157 | #baz => 'blue skies', |
158 | })->count, 1, '_common perl migration got run'); |
3b98a3a1 |
159 | lives_ok { |
160 | $s->resultset('Foo')->create({ |
161 | bar => 'frew', |
162 | baz => 'frew', |
163 | }) |
164 | } 'schema is deployed'; |
be140a5f |
165 | $dm->downgrade_single_step({ version_set => [qw( 2.0 1.0 )] }); |
d50f2521 |
166 | dies_ok { |
167 | $s->resultset('Foo')->create({ |
168 | bar => 'frew', |
169 | baz => 'frew', |
170 | }) |
fc4b7602 |
171 | } 'schema is downgrayyed'; |
be140a5f |
172 | $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] }); |
459a67e3 |
173 | } |
02d58ac0 |
174 | |
3b98a3a1 |
175 | VERSION3: { |
176 | use_ok 'DBICVersion_v3'; |
177 | my $s = DBICVersion::Schema->connect(@connection); |
178 | my $dm = Translator->new({ |
179 | schema => $s, |
91adde75 |
180 | script_directory => $sql_dir, |
3b98a3a1 |
181 | databases => ['SQLite'], |
02a7b8ac |
182 | sql_translator_args => { add_drop_table => 0 }, |
d50f2521 |
183 | txn_wrap => 0, |
3b98a3a1 |
184 | }); |
185 | |
186 | ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly'); |
187 | |
188 | $version = $s->schema_version(); |
91557c90 |
189 | $dm->prepare_deploy; |
3b98a3a1 |
190 | ok( |
09bc35e3 |
191 | -f catfile(qw( t sql SQLite schema 3.0 001-auto.sql )), |
3b98a3a1 |
192 | '2.0 schema gets generated properly' |
193 | ); |
be140a5f |
194 | $dm->prepare_downgrade({ |
195 | from_version => $version, |
196 | to_version => '1.0', |
197 | version_set => [$version, '1.0'] |
198 | }); |
3b98a3a1 |
199 | ok( |
09bc35e3 |
200 | -f catfile(qw( t sql SQLite down 3.0-1.0 001-auto.sql )), |
d50f2521 |
201 | '3.0-1.0 diff gets generated properly' |
202 | ); |
be140a5f |
203 | $dm->prepare_upgrade({ |
204 | from_version => '1.0', |
205 | to_version => $version, |
206 | version_set => ['1.0', $version] |
207 | }); |
d50f2521 |
208 | ok( |
09bc35e3 |
209 | -f catfile(qw( t sql SQLite up 1.0-3.0 001-auto.sql )), |
3b98a3a1 |
210 | '1.0-3.0 diff gets generated properly' |
211 | ); |
be140a5f |
212 | $dm->prepare_upgrade({ |
213 | from_version => '2.0', |
214 | to_version => $version, |
215 | version_set => ['2.0', $version] |
216 | }); |
d50f2521 |
217 | { |
218 | my $warned = 0; |
219 | local $SIG{__WARN__} = sub{$warned = 1}; |
be140a5f |
220 | $dm->prepare_upgrade({ |
221 | from_version => '2.0', |
222 | to_version => $version, |
223 | version_set => ['2.0', $version] |
224 | }); |
d50f2521 |
225 | ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' ); |
226 | } |
3b98a3a1 |
227 | ok( |
09bc35e3 |
228 | -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )), |
3b98a3a1 |
229 | '2.0-3.0 diff gets generated properly' |
230 | ); |
d50f2521 |
231 | mkpath catfile(qw( t sql _generic up 2.0-3.0 )); |
09bc35e3 |
232 | 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 )); |
d50f2521 |
233 | rmtree(catfile(qw( t sql SQLite ))); |
234 | warn 'how can this be' if -d catfile(qw( t sql SQLite )); |
3b98a3a1 |
235 | dies_ok { |
236 | $s->resultset('Foo')->create({ |
237 | bar => 'frew', |
238 | baz => 'frew', |
239 | biff => 'frew', |
240 | }) |
241 | } 'schema not deployed'; |
be140a5f |
242 | $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] }); |
3b98a3a1 |
243 | lives_ok { |
244 | $s->resultset('Foo')->create({ |
245 | bar => 'frew', |
246 | baz => 'frew', |
247 | biff => 'frew', |
248 | }) |
d50f2521 |
249 | } 'schema is deployed using _generic'; |
250 | rmtree(catfile(qw( t sql SQLite ))); |
251 | rmtree(catfile(qw( t sql _generic ))); |
252 | dies_ok { |
be140a5f |
253 | $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] }); |
d50f2521 |
254 | } 'dies when sql dir does not exist'; |
3b98a3a1 |
255 | } |
02d58ac0 |
256 | done_testing; |
d50f2521 |
257 | #vim: ts=2 sw=2 expandtab |