Some cleanup
[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     trans => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'),
36 };
37
38 use lib qw(t/lib);
39 use DBICTest; # do not remove even though it is not used
40
41 use_ok('DBICVersionOrig');
42
43 my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
44 eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) };
45 eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) };
46
47 is($schema_orig->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
48 unlink( $fn->{v1} ) if ( -e $fn->{v1} );
49 $schema_orig->create_ddl_dir('MySQL', undef, $ddl_dir);
50
51 ok(-f $fn->{v1}, 'Created DDL file');
52 $schema_orig->deploy({ add_drop_table => 1 });
53
54 my $tvrs = $schema_orig->{vschema}->resultset('Table');
55 is($schema_orig->_source_exists($tvrs), 1, 'Created schema from DDL file');
56
57 # loading a new module defining a new version of the same table
58 DBICVersion::Schema->_unregister_source ('Table');
59 eval "use DBICVersionNew";
60
61 my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
62 {
63   unlink($fn->{v2});
64   unlink($fn->{trans});
65
66   is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok');
67   is($schema_upgrade->schema_version, '2.0', 'schema version ok');
68   $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
69   ok(-f $fn->{trans}, 'Created DDL file');
70
71   {
72     my $w;
73     local $SIG{__WARN__} = sub { $w = shift };
74
75     sleep 1;    # remove this when TODO below is completed
76
77     $schema_upgrade->upgrade();
78     like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade');
79   }
80
81   is($schema_upgrade->get_db_version(), '2.0', 'db version number upgraded');
82
83   eval {
84     $schema_upgrade->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_upgrade->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}/, '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 # check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr
129 {
130   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
131   eval {
132     $schema_version->storage->dbh->do("DELETE from $version_table_name");
133   };
134
135
136   my $warn = '';
137   local $SIG{__WARN__} = sub { $warn = shift };
138   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
139   like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
140
141
142   # should warn
143   $warn = '';
144   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
145   is($warn, '', 'warning not detected with attr set');
146   # should not warn
147
148   local $ENV{DBIC_NO_VERSION_CHECK} = 1;
149   $warn = '';
150   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
151   is($warn, '', 'warning not detected with env var set');
152   # should not warn
153
154   $warn = '';
155   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
156   like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
157   # should warn
158 }
159
160 # attempt a deploy/upgrade cycle within one second
161 TODO: {
162
163   local $TODO = 'To fix this properly the table must be extended with an autoinc column, mst will not accept anything less';
164
165   eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) };
166   eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) };
167   eval { $schema_orig->storage->dbh->do('drop table TestVersion') };
168
169   # this attempts to sleep until the turn of the second
170   my $t = time();
171   sleep (int ($t) + 1 - $t);
172   diag ('Fast deploy/upgrade start: ', time() );
173
174   {
175     local $DBICVersion::Schema::VERSION = '1.0';
176     $schema_orig->deploy;
177   }
178
179   local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
180   $schema_upgrade->upgrade();
181
182   is($schema_upgrade->get_db_version(), '2.0', 'Fast deploy/upgrade');
183 };
184
185 unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
186     unlink $_ for (values %$fn);
187 }
188
189 done_testing;