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