Add import-time-skip support to OptDeps, switch most tests over to that
[dbsrgits/DBIx-Class.git] / t / 94versioning.t
1 use DBIx::Class::Optional::Dependencies -skip_all_without => qw(deploy test_rdbms_mysql);
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Warn;
8 use Test::Exception;
9
10 use Path::Class;
11 use File::Copy;
12 use Time::HiRes qw/time sleep/;
13
14 use lib qw(t/lib);
15 use DBICTest;
16 use DBIx::Class::_Util 'sigwarn_silencer';
17
18 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
19
20 # this is just to grab a lock
21 {
22   my $s = DBICTest::Schema->connect($dsn, $user, $pass);
23 }
24
25 # in case it came from the env
26 $ENV{DBIC_NO_VERSION_CHECK} = 0;
27
28 use_ok('DBICVersion_v1');
29
30 my $version_table_name = 'dbix_class_schema_versions';
31 my $old_table_name = 'SchemaVersions';
32
33 my $ddl_dir = dir(qw/t var/, "versioning_ddl-$$");
34 $ddl_dir->mkpath unless -d $ddl_dir;
35
36 my $fn = {
37     v1 => $ddl_dir->file ('DBICVersion-Schema-1.0-MySQL.sql'),
38     v2 => $ddl_dir->file ('DBICVersion-Schema-2.0-MySQL.sql'),
39     v3 => $ddl_dir->file ('DBICVersion-Schema-3.0-MySQL.sql'),
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'),
42 };
43
44 my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
45 eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
46 eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
47
48 is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
49 unlink( $fn->{v1} ) if ( -e $fn->{v1} );
50 $schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir);
51
52 ok(-f $fn->{v1}, 'Created DDL file');
53 $schema_v1->deploy({ add_drop_table => 1 });
54
55 my $tvrs = $schema_v1->{vschema}->resultset('Table');
56 is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file');
57
58 # loading a new module defining a new version of the same table
59 DBICVersion::Schema->_unregister_source ('Table');
60 use_ok('DBICVersion_v2');
61
62 my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
63 {
64   unlink($fn->{v2});
65   unlink($fn->{trans_v12});
66
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');
71
72   warnings_like (
73     sub { $schema_v2->upgrade() },
74     qr/DB version .+? is lower than the schema version/,
75     'Warn before upgrade',
76   );
77
78   is($schema_v2->get_db_version(), '2.0', 'db version number upgraded');
79
80   lives_ok ( sub {
81     $schema_v2->storage->dbh->do('select NewVersionName from TestVersion');
82   }, 'new column created' );
83
84   warnings_exist (
85     sub { $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0') },
86     [
87       qr/Overwriting existing DDL file - \Q$fn->{v2}\E/,
88       qr/Overwriting existing diff file - \Q$fn->{trans_v12}\E/,
89     ],
90     'An overwrite warning generated for both the DDL and the diff',
91   );
92 }
93
94 {
95   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
96   lives_ok (sub {
97     $schema_version->storage->dbh->do('select * from ' . $version_table_name);
98   }, 'version table exists');
99
100   lives_ok (sub {
101     $schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name");
102     $schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name");
103   }, 'versions table renamed to old style table');
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
108   dies_ok (sub {
109     $schema_version->storage->dbh->do('select * from ' . $old_table_name);
110   }, 'old version table gone');
111
112 }
113
114 # repeat the v1->v2 process for v2->v3 before testing v1->v3
115 DBICVersion::Schema->_unregister_source ('Table');
116 use_ok('DBICVersion_v3');
117
118 my $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
128   warnings_exist (
129     sub { $schema_v3->upgrade() },
130     qr/DB version .+? is lower than the schema version/,
131     'Warn before upgrade',
132   );
133
134   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
135
136   lives_ok ( sub {
137     $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion');
138   }, 'new column created');
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
155 # attempt v1 -> v3 upgrade
156 {
157   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
158   $schema_v3->upgrade();
159   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
160 }
161
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.
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 }
183
184 # Then attempt v1 -> v3 upgrade
185 {
186   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
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
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 {
201     $schema_version->storage->dbh->do("DELETE from $version_table_name");
202   };
203
204
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' );
208
209   warnings_like ( sub {
210     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
211   },  [], 'warning not detected with attr set');
212
213
214   local $ENV{DBIC_NO_VERSION_CHECK} = 1;
215   warnings_like ( sub {
216     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
217   }, [], 'warning not detected with env var set');
218
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');
222 }
223
224 # attempt a deploy/upgrade cycle within one second
225 {
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') };
229
230   # this attempts to sleep until the turn of the second
231   my $t = time();
232   sleep (int ($t) + 1 - $t);
233   note ('Fast deploy/upgrade start: ', time() );
234
235   {
236     local $DBICVersion::Schema::VERSION = '2.0';
237     $schema_v2->deploy;
238   }
239
240   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
241
242   $schema_v2->upgrade();
243
244   is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade');
245 };
246
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,
262     user => $user,
263     pass => $pass,
264     ignore_version => 1
265   });
266
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
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
276 is
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
285 END {
286   unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
287     $ddl_dir->rmtree;
288   }
289 }
290
291 done_testing;