Commit | Line | Data |
c9d2e0a2 |
1 | use strict; |
2 | use warnings; |
68de9438 |
3 | |
c9d2e0a2 |
4 | use Test::More; |
d7a58a29 |
5 | use Test::Warn; |
6 | use Test::Exception; |
7 | |
4bea1fe7 |
8 | use Path::Class; |
9 | use File::Copy; |
10 | use Time::HiRes qw/time sleep/; |
11 | |
12 | use lib qw(t/lib); |
8d6b1478 |
13 | use DBICTest; |
052a832c |
14 | use DBIx::Class::_Util 'sigwarn_silencer'; |
4bea1fe7 |
15 | |
1d48fcff |
16 | my ($dsn, $user, $pass); |
17 | |
c9d2e0a2 |
18 | BEGIN { |
1d48fcff |
19 | ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; |
20 | |
21 | plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test' |
8424c090 |
22 | unless ($dsn); |
1d48fcff |
23 | |
2527233b |
24 | require DBIx::Class; |
7f6f5b69 |
25 | plan skip_all => |
2527233b |
26 | 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') |
49b3a264 |
27 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy'); |
28 | |
29 | plan skip_all => |
30 | 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql') |
31 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql'); |
c9d2e0a2 |
32 | } |
33 | |
8d6b1478 |
34 | # this is just to grab a lock |
35 | { |
36 | my $s = DBICTest::Schema->connect($dsn, $user, $pass); |
37 | } |
38 | |
eed5492f |
39 | # in case it came from the env |
40 | $ENV{DBIC_NO_VERSION_CHECK} = 0; |
41 | |
21357344 |
42 | # FIXME - work around RT#113965 in combination with -T on older perls: |
43 | # the non-deparsing XS portion of D::D gets confused by some of the IO |
44 | # handles trapped in the debug object of DBIC. What a mess. |
45 | $Data::Dumper::Deparse = 1; |
46 | |
b9ae34d3 |
47 | use_ok('DBICVersion_v1'); |
b9ae34d3 |
48 | |
b4b1e91c |
49 | my $version_table_name = 'dbix_class_schema_versions'; |
50 | my $old_table_name = 'SchemaVersions'; |
51 | |
8d6b1478 |
52 | my $ddl_dir = dir(qw/t var/, "versioning_ddl-$$"); |
53 | $ddl_dir->mkpath unless -d $ddl_dir; |
b9ae34d3 |
54 | |
1475105d |
55 | my $fn = { |
d7a58a29 |
56 | v1 => $ddl_dir->file ('DBICVersion-Schema-1.0-MySQL.sql'), |
57 | v2 => $ddl_dir->file ('DBICVersion-Schema-2.0-MySQL.sql'), |
d40a22fc |
58 | v3 => $ddl_dir->file ('DBICVersion-Schema-3.0-MySQL.sql'), |
4f591da2 |
59 | trans_v12 => $ddl_dir->file ('DBICVersion-Schema-1.0-2.0-MySQL.sql'), |
60 | trans_v23 => $ddl_dir->file ('DBICVersion-Schema-2.0-3.0-MySQL.sql'), |
1475105d |
61 | }; |
62 | |
d2bc7045 |
63 | my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); |
64 | eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) }; |
65 | eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) }; |
c9d2e0a2 |
66 | |
d2bc7045 |
67 | is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working'); |
1475105d |
68 | unlink( $fn->{v1} ) if ( -e $fn->{v1} ); |
d2bc7045 |
69 | $schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir); |
c9d2e0a2 |
70 | |
1475105d |
71 | ok(-f $fn->{v1}, 'Created DDL file'); |
d2bc7045 |
72 | $schema_v1->deploy({ add_drop_table => 1 }); |
c9d2e0a2 |
73 | |
d2bc7045 |
74 | my $tvrs = $schema_v1->{vschema}->resultset('Table'); |
75 | is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file'); |
c9d2e0a2 |
76 | |
1475105d |
77 | # loading a new module defining a new version of the same table |
78 | DBICVersion::Schema->_unregister_source ('Table'); |
7eb9a6f1 |
79 | use_ok('DBICVersion_v2'); |
1475105d |
80 | |
d2bc7045 |
81 | my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); |
f925f7cb |
82 | { |
1475105d |
83 | unlink($fn->{v2}); |
d2bc7045 |
84 | unlink($fn->{trans_v12}); |
f925f7cb |
85 | |
d2bc7045 |
86 | is($schema_v2->get_db_version(), '1.0', 'get_db_version ok'); |
87 | is($schema_v2->schema_version, '2.0', 'schema version ok'); |
88 | $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); |
89 | ok(-f $fn->{trans_v12}, 'Created DDL file'); |
1475105d |
90 | |
d7a58a29 |
91 | warnings_like ( |
d40a22fc |
92 | sub { $schema_v2->upgrade() }, |
d7a58a29 |
93 | qr/DB version .+? is lower than the schema version/, |
94 | 'Warn before upgrade', |
95 | ); |
1475105d |
96 | |
d2bc7045 |
97 | is($schema_v2->get_db_version(), '2.0', 'db version number upgraded'); |
f925f7cb |
98 | |
d7a58a29 |
99 | lives_ok ( sub { |
d2bc7045 |
100 | $schema_v2->storage->dbh->do('select NewVersionName from TestVersion'); |
d7a58a29 |
101 | }, 'new column created' ); |
102 | |
103 | warnings_exist ( |
d40a22fc |
104 | sub { $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0') }, |
d7a58a29 |
105 | [ |
475713af |
106 | qr/Overwriting existing DDL file - \Q$fn->{v2}\E/, |
107 | qr/Overwriting existing diff file - \Q$fn->{trans_v12}\E/, |
d7a58a29 |
108 | ], |
109 | 'An overwrite warning generated for both the DDL and the diff', |
110 | ); |
f925f7cb |
111 | } |
b4b1e91c |
112 | |
113 | { |
114 | my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); |
d7a58a29 |
115 | lives_ok (sub { |
b4b1e91c |
116 | $schema_version->storage->dbh->do('select * from ' . $version_table_name); |
d7a58a29 |
117 | }, 'version table exists'); |
b4b1e91c |
118 | |
d7a58a29 |
119 | lives_ok (sub { |
b4b1e91c |
120 | $schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name"); |
86456031 |
121 | $schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name"); |
d7a58a29 |
122 | }, 'versions table renamed to old style table'); |
b4b1e91c |
123 | |
124 | $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); |
125 | is($schema_version->get_db_version, '2.0', 'transition from old table name to new okay'); |
126 | |
d7a58a29 |
127 | dies_ok (sub { |
b4b1e91c |
128 | $schema_version->storage->dbh->do('select * from ' . $old_table_name); |
d7a58a29 |
129 | }, 'old version table gone'); |
b4b1e91c |
130 | |
131 | } |
f81b9157 |
132 | |
d2bc7045 |
133 | # repeat the v1->v2 process for v2->v3 before testing v1->v3 |
134 | DBICVersion::Schema->_unregister_source ('Table'); |
7eb9a6f1 |
135 | use_ok('DBICVersion_v3'); |
d2bc7045 |
136 | |
137 | my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); |
138 | { |
139 | unlink($fn->{v3}); |
140 | unlink($fn->{trans_v23}); |
141 | |
142 | is($schema_v3->get_db_version(), '2.0', 'get_db_version 2.0 ok'); |
143 | is($schema_v3->schema_version, '3.0', 'schema version 3.0 ok'); |
144 | $schema_v3->create_ddl_dir('MySQL', '3.0', $ddl_dir, '2.0'); |
145 | ok(-f $fn->{trans_v23}, 'Created DDL 2.0 -> 3.0 file'); |
146 | |
b9ae34d3 |
147 | warnings_exist ( |
148 | sub { $schema_v3->upgrade() }, |
149 | qr/DB version .+? is lower than the schema version/, |
150 | 'Warn before upgrade', |
151 | ); |
d2bc7045 |
152 | |
153 | is($schema_v3->get_db_version(), '3.0', 'db version number upgraded'); |
154 | |
b9ae34d3 |
155 | lives_ok ( sub { |
d2bc7045 |
156 | $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion'); |
b9ae34d3 |
157 | }, 'new column created'); |
d2bc7045 |
158 | } |
159 | |
160 | # now put the v1 schema back again |
161 | { |
162 | # drop all the tables... |
163 | eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) }; |
164 | eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) }; |
165 | eval { $schema_v1->storage->dbh->do('drop table TestVersion') }; |
166 | |
167 | { |
168 | local $DBICVersion::Schema::VERSION = '1.0'; |
169 | $schema_v1->deploy; |
170 | } |
171 | is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok'); |
172 | } |
173 | |
b9ae34d3 |
174 | # attempt v1 -> v3 upgrade |
d2bc7045 |
175 | { |
052a832c |
176 | local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ ); |
7eb9a6f1 |
177 | $schema_v3->upgrade(); |
d2bc7045 |
178 | is($schema_v3->get_db_version(), '3.0', 'db version number upgraded'); |
179 | } |
180 | |
b703fec7 |
181 | # Now, try a v1 -> v3 upgrade with a file that has comments strategically placed in it. |
182 | # First put the v1 schema back again... |
183 | { |
184 | # drop all the tables... |
185 | eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) }; |
186 | eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) }; |
187 | eval { $schema_v1->storage->dbh->do('drop table TestVersion') }; |
188 | |
189 | { |
190 | local $DBICVersion::Schema::VERSION = '1.0'; |
191 | $schema_v1->deploy; |
192 | } |
193 | is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok'); |
194 | } |
195 | |
196 | # add a "harmless" comment before one of the statements. |
f3ec358e |
197 | { |
198 | my ($perl) = $^X =~ /(.+)/; |
199 | local $ENV{PATH}; |
200 | system( qq($perl -pi.bak -e "s/ALTER/-- this is a comment\nALTER/" $fn->{trans_v23}) ); |
201 | } |
b703fec7 |
202 | |
203 | # Then attempt v1 -> v3 upgrade |
204 | { |
052a832c |
205 | local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ ); |
b703fec7 |
206 | $schema_v3->upgrade(); |
207 | is($schema_v3->get_db_version(), '3.0', 'db version number upgraded to 3.0'); |
208 | |
209 | # make sure that the column added after the comment is actually added. |
210 | lives_ok ( sub { |
211 | $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion'); |
212 | }, 'new column created'); |
213 | } |
214 | |
215 | |
f81b9157 |
216 | # check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr |
217 | { |
218 | my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); |
219 | eval { |
d0dfedc2 |
220 | $schema_version->storage->dbh->do("DELETE from $version_table_name"); |
f81b9157 |
221 | }; |
222 | |
d0dfedc2 |
223 | |
d7a58a29 |
224 | warnings_like ( sub { |
225 | $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); |
226 | }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr' ); |
f81b9157 |
227 | |
d7a58a29 |
228 | warnings_like ( sub { |
229 | $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); |
230 | }, [], 'warning not detected with attr set'); |
d0dfedc2 |
231 | |
f81b9157 |
232 | |
1475105d |
233 | local $ENV{DBIC_NO_VERSION_CHECK} = 1; |
d7a58a29 |
234 | warnings_like ( sub { |
235 | $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); |
236 | }, [], 'warning not detected with env var set'); |
f81b9157 |
237 | |
d7a58a29 |
238 | warnings_like ( sub { |
239 | $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 }); |
240 | }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr'); |
f81b9157 |
241 | } |
1475105d |
242 | |
243 | # attempt a deploy/upgrade cycle within one second |
7eb9a6f1 |
244 | { |
d2bc7045 |
245 | eval { $schema_v2->storage->dbh->do('drop table ' . $version_table_name) }; |
246 | eval { $schema_v2->storage->dbh->do('drop table ' . $old_table_name) }; |
247 | eval { $schema_v2->storage->dbh->do('drop table TestVersion') }; |
1475105d |
248 | |
249 | # this attempts to sleep until the turn of the second |
250 | my $t = time(); |
251 | sleep (int ($t) + 1 - $t); |
7eb9a6f1 |
252 | note ('Fast deploy/upgrade start: ', time() ); |
1475105d |
253 | |
254 | { |
d2bc7045 |
255 | local $DBICVersion::Schema::VERSION = '2.0'; |
256 | $schema_v2->deploy; |
1475105d |
257 | } |
1475105d |
258 | |
052a832c |
259 | local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ ); |
260 | |
d2bc7045 |
261 | $schema_v2->upgrade(); |
1475105d |
262 | |
d2bc7045 |
263 | is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade'); |
e9fbbbf4 |
264 | }; |
1475105d |
265 | |
8012b15c |
266 | # Check that it Schema::Versioned deals with new/all forms of connect arguments. |
267 | { |
268 | my $get_db_version_run = 0; |
269 | |
270 | no warnings qw/once redefine/; |
271 | local *DBIx::Class::Schema::Versioned::get_db_version = sub { |
272 | $get_db_version_run = 1; |
273 | return $_[0]->schema_version; |
274 | }; |
275 | |
276 | # Make sure the env var isn't whats triggering it |
277 | local $ENV{DBIC_NO_VERSION_CHECK} = 0; |
278 | |
279 | DBICVersion::Schema->connect({ |
280 | dsn => $dsn, |
8273e845 |
281 | user => $user, |
8012b15c |
282 | pass => $pass, |
283 | ignore_version => 1 |
284 | }); |
8273e845 |
285 | |
8012b15c |
286 | ok($get_db_version_run == 0, "attributes pulled from hashref connect_info"); |
287 | $get_db_version_run = 0; |
288 | |
289 | DBICVersion::Schema->connect( $dsn, $user, $pass, { ignore_version => 1 } ); |
290 | ok($get_db_version_run == 0, "attributes pulled from list connect_info"); |
291 | } |
292 | |
81023d83 |
293 | # at this point we have v1, v2 and v3 still connected |
294 | # make sure they are the only connections and everything else is gone |
295 | is |
296 | scalar( grep |
297 | { defined $_ and $_->{Active} } |
298 | map |
299 | { @{$_->{ChildHandles}} } |
300 | values %{ { DBI->installed_drivers } } |
301 | ), 3, "Expected number of connections at end of script" |
302 | ; |
303 | |
7150ea46 |
304 | # Test custom HandleError setting on an in-memory instance |
305 | { |
306 | my $custom_handler = sub { die $_[0] }; |
307 | |
308 | # try to setup a custom error handle without unsafe set -- should |
309 | # fail, same behavior as regular Schema |
310 | throws_ok { |
311 | DBICVersion::Schema->connect( 'dbi:SQLite::memory:', undef, undef, { |
312 | HandleError => $custom_handler, |
313 | ignore_version => 1, |
314 | })->deploy; |
315 | } |
316 | qr/Refusing clobbering of \{HandleError\} installed on externally supplied DBI handle/, |
317 | 'HandleError with unsafe not set causes an exception' |
318 | ; |
319 | |
320 | # now try it with unsafe set -- should work (see RT #113741) |
321 | my $s = DBICVersion::Schema->connect( 'dbi:SQLite::memory:', undef, undef, { |
322 | unsafe => 1, |
323 | HandleError => $custom_handler, |
324 | ignore_version => 1, |
325 | }); |
326 | |
327 | $s->deploy; |
328 | |
329 | is $s->storage->dbh->{HandleError}, $custom_handler, 'Handler properly set on main schema'; |
330 | is $s->{vschema}->storage->dbh->{HandleError}, $custom_handler, 'Handler properly set on version subschema'; |
331 | } |
332 | |
8d6b1478 |
333 | END { |
334 | unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) { |
335 | $ddl_dir->rmtree; |
336 | } |
1475105d |
337 | } |
7f6f5b69 |
338 | |
339 | done_testing; |