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