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