Changes to support multiple step schema version updates
[dbsrgits/DBIx-Class.git] / t / 94versioning.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Test::More;
6 use File::Spec;
7 use File::Copy;
8
9 #warn "$dsn $user $pass";
10 my ($dsn, $user, $pass);
11
12 BEGIN {
13   ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
14
15   plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
16     unless ($dsn);
17
18   eval { require Time::HiRes }
19     || plan skip_all => 'Test needs Time::HiRes';
20   Time::HiRes->import(qw/time sleep/);
21
22   require DBIx::Class::Storage::DBI;
23   plan skip_all =>
24       'Test needs SQL::Translator ' . DBIx::Class::Storage::DBI->_sqlt_minimum_version
25     if not DBIx::Class::Storage::DBI->_sqlt_version_ok;
26 }
27
28 my $version_table_name = 'dbix_class_schema_versions';
29 my $old_table_name = 'SchemaVersions';
30
31 my $ddl_dir = File::Spec->catdir ('t', 'var');
32 my $fn = {
33     v1 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-MySQL.sql'),
34     v2 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-MySQL.sql'),
35     v3 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-3.0-MySQL.sql'),
36     trans_v12 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'),
37     trans_v23 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-3.0-MySQL.sql'),
38 };
39
40 use lib qw(t/lib);
41 use DBICTest; # do not remove even though it is not used
42
43 use_ok('DBICVersion_v1');
44
45 my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
46 eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
47 eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
48
49 is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
50 unlink( $fn->{v1} ) if ( -e $fn->{v1} );
51 $schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir);
52
53 ok(-f $fn->{v1}, 'Created DDL file');
54 $schema_v1->deploy({ add_drop_table => 1 });
55
56 my $tvrs = $schema_v1->{vschema}->resultset('Table');
57 is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file');
58
59 # loading a new module defining a new version of the same table
60 DBICVersion::Schema->_unregister_source ('Table');
61 eval "use DBICVersion_v2";
62
63 my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
64 {
65   unlink($fn->{v2});
66   unlink($fn->{trans_v12});
67
68   is($schema_v2->get_db_version(), '1.0', 'get_db_version ok');
69   is($schema_v2->schema_version, '2.0', 'schema version ok');
70   $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
71   ok(-f $fn->{trans_v12}, 'Created DDL file');
72
73   {
74     my $w;
75     local $SIG{__WARN__} = sub { $w = shift };
76
77     $schema_v2->upgrade();
78     like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade');
79   }
80
81   is($schema_v2->get_db_version(), '2.0', 'db version number upgraded');
82
83   eval {
84     $schema_v2->storage->dbh->do('select NewVersionName from TestVersion');
85   };
86   is($@, '', 'new column created');
87
88   # should overwrite files and warn about it
89   my @w;
90   local $SIG{__WARN__} = sub { 
91     if ($_[0] =~ /Overwriting existing/) {
92       push @w, $_[0];
93     }
94     else {
95       warn @_;
96     }
97   };
98   $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
99
100   is (2, @w, 'A warning generated for both the DDL and the diff');
101   like ($w[0], qr/Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning');
102   like ($w[1], qr/Overwriting existing diff file - $fn->{trans_v12}/, 'Upgrade diff overwrite warning');
103 }
104
105 {
106   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
107   eval {
108     $schema_version->storage->dbh->do('select * from ' . $version_table_name);
109   };
110   is($@, '', 'version table exists');
111
112   eval {
113     $schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name");
114     $schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name");
115   };
116   is($@, '', 'versions table renamed to old style table');
117
118   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
119   is($schema_version->get_db_version, '2.0', 'transition from old table name to new okay');
120
121   eval {
122     $schema_version->storage->dbh->do('select * from ' . $old_table_name);
123   };
124   ok($@, 'old version table gone');
125
126 }
127
128 # repeat the v1->v2 process for v2->v3 before testing v1->v3
129 DBICVersion::Schema->_unregister_source ('Table');
130 eval "use DBICVersion_v3";
131
132 my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
133 {
134   unlink($fn->{v3});
135   unlink($fn->{trans_v23});
136
137   is($schema_v3->get_db_version(), '2.0', 'get_db_version 2.0 ok');
138   is($schema_v3->schema_version, '3.0', 'schema version 3.0 ok');
139   $schema_v3->create_ddl_dir('MySQL', '3.0', $ddl_dir, '2.0');
140   ok(-f $fn->{trans_v23}, 'Created DDL 2.0 -> 3.0 file');
141
142   {
143     my $w;
144     local $SIG{__WARN__} = sub { $w = shift };
145
146     $schema_v3->upgrade();
147     like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade');
148   }
149
150   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
151
152   eval {
153     $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion');
154   };
155   is($@, '', 'new column created');
156 }
157
158 # now put the v1 schema back again
159 {
160   # drop all the tables...
161   eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
162   eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
163   eval { $schema_v1->storage->dbh->do('drop table TestVersion') };
164
165   {
166     local $DBICVersion::Schema::VERSION = '1.0';
167     $schema_v1->deploy;
168   }
169   is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok');
170 }
171
172 # attempt v1 -> v3 upgrade....
173 {
174   {
175     my $w;
176     local $SIG{__WARN__} = sub { $w = shift };
177
178     $schema_v3->upgrade();
179     like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade');
180   }
181
182   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
183 }
184
185 # check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr
186 {
187   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
188   eval {
189     $schema_version->storage->dbh->do("DELETE from $version_table_name");
190   };
191
192
193   my $warn = '';
194   local $SIG{__WARN__} = sub { $warn = shift };
195   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
196   like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
197
198
199   # should warn
200   $warn = '';
201   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
202   is($warn, '', 'warning not detected with attr set');
203   # should not warn
204
205   local $ENV{DBIC_NO_VERSION_CHECK} = 1;
206   $warn = '';
207   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
208   is($warn, '', 'warning not detected with env var set');
209   # should not warn
210
211   $warn = '';
212   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
213   like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
214   # should warn
215 }
216
217 # attempt a deploy/upgrade cycle within one second
218 TODO: {
219
220   local $TODO = 'To fix this properly the table must be extended with an autoinc column, mst will not accept anything less';
221
222   eval { $schema_v2->storage->dbh->do('drop table ' . $version_table_name) };
223   eval { $schema_v2->storage->dbh->do('drop table ' . $old_table_name) };
224   eval { $schema_v2->storage->dbh->do('drop table TestVersion') };
225
226   # this attempts to sleep until the turn of the second
227   my $t = time();
228   sleep (int ($t) + 1 - $t);
229   diag ('Fast deploy/upgrade start: ', time() );
230
231   {
232     local $DBICVersion::Schema::VERSION = '2.0';
233     $schema_v2->deploy;
234   }
235
236   local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
237   $schema_v2->upgrade();
238
239   is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade');
240 };
241
242 unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
243     unlink $_ for (values %$fn);
244 }
245
246 done_testing;