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 use DBIx::Class::_Util 'sigwarn_silencer';
  15
  16 my ($dsn, $user, $pass);
  17
  18 BEGIN {
  19   ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
  20
  21   plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
  22     unless ($dsn);
  23
  24   require DBIx::Class;
  25   plan skip_all =>
  26       'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')
  27     unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy');
  28
  29   plan skip_all =>
  30       'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql')
  31     unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql');
  32 }
  33
  34 # this is just to grab a lock
  35 {
  36   my $s = DBICTest::Schema->connect($dsn, $user, $pass);
  37 }
  38
  39 # in case it came from the env
  40 $ENV{DBIC_NO_VERSION_CHECK} = 0;
  41
  42 # FIXME - work around RT#113965 in combination with -T on older perls:
  43 # the non-deparsing XS portion of D::D gets confused by some of the IO
  44 # handles trapped in the debug object of DBIC. What a mess.
  45 $Data::Dumper::Deparse = 1;
  46
  47 use_ok('DBICVersion_v1');
  48
  49 my $version_table_name = 'dbix_class_schema_versions';
  50 my $old_table_name = 'SchemaVersions';
  51
  52 my $ddl_dir = dir(qw/t var/, "versioning_ddl-$$");
  53 $ddl_dir->mkpath unless -d $ddl_dir;
  54
  55 my $fn = {
  56     v1 => $ddl_dir->file ('DBICVersion-Schema-1.0-MySQL.sql'),
  57     v2 => $ddl_dir->file ('DBICVersion-Schema-2.0-MySQL.sql'),
  58     v3 => $ddl_dir->file ('DBICVersion-Schema-3.0-MySQL.sql'),
  59     trans_v12 => $ddl_dir->file ('DBICVersion-Schema-1.0-2.0-MySQL.sql'),
  60     trans_v23 => $ddl_dir->file ('DBICVersion-Schema-2.0-3.0-MySQL.sql'),
  61 };
  62
  63 my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
  64 eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
  65 eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
  66
  67 is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
  68 unlink( $fn->{v1} ) if ( -e $fn->{v1} );
  69 $schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir);
  70
  71 ok(-f $fn->{v1}, 'Created DDL file');
  72 $schema_v1->deploy({ add_drop_table => 1 });
  73
  74 my $tvrs = $schema_v1->{vschema}->resultset('Table');
  75 is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file');
  76
  77 # loading a new module defining a new version of the same table
  78 DBICVersion::Schema->_unregister_source ('Table');
  79 use_ok('DBICVersion_v2');
  80
  81 my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
  82 {
  83   unlink($fn->{v2});
  84   unlink($fn->{trans_v12});
  85
  86   is($schema_v2->get_db_version(), '1.0', 'get_db_version ok');
  87   is($schema_v2->schema_version, '2.0', 'schema version ok');
  88   $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
  89   ok(-f $fn->{trans_v12}, 'Created DDL file');
  90
  91   warnings_like (
  92     sub { $schema_v2->upgrade() },
  93     qr/DB version .+? is lower than the schema version/,
  94     'Warn before upgrade',
  95   );
  96
  97   is($schema_v2->get_db_version(), '2.0', 'db version number upgraded');
  98
  99   lives_ok ( sub {
 100     $schema_v2->storage->dbh->do('select NewVersionName from TestVersion');
 101   }, 'new column created' );
 102
 103   warnings_exist (
 104     sub { $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0') },
 105     [
 106       qr/Overwriting existing DDL file - \Q$fn->{v2}\E/,
 107       qr/Overwriting existing diff file - \Q$fn->{trans_v12}\E/,
 108     ],
 109     'An overwrite warning generated for both the DDL and the diff',
 110   );
 111 }
 112
 113 {
 114   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
 115   lives_ok (sub {
 116     $schema_version->storage->dbh->do('select * from ' . $version_table_name);
 117   }, 'version table exists');
 118
 119   lives_ok (sub {
 120     $schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name");
 121     $schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name");
 122   }, 'versions table renamed to old style table');
 123
 124   $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
 125   is($schema_version->get_db_version, '2.0', 'transition from old table name to new okay');
 126
 127   dies_ok (sub {
 128     $schema_version->storage->dbh->do('select * from ' . $old_table_name);
 129   }, 'old version table gone');
 130
 131 }
 132
 133 # repeat the v1->v2 process for v2->v3 before testing v1->v3
 134 DBICVersion::Schema->_unregister_source ('Table');
 135 use_ok('DBICVersion_v3');
 136
 137 my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
 138 {
 139   unlink($fn->{v3});
 140   unlink($fn->{trans_v23});
 141
 142   is($schema_v3->get_db_version(), '2.0', 'get_db_version 2.0 ok');
 143   is($schema_v3->schema_version, '3.0', 'schema version 3.0 ok');
 144   $schema_v3->create_ddl_dir('MySQL', '3.0', $ddl_dir, '2.0');
 145   ok(-f $fn->{trans_v23}, 'Created DDL 2.0 -> 3.0 file');
 146
 147   warnings_exist (
 148     sub { $schema_v3->upgrade() },
 149     qr/DB version .+? is lower than the schema version/,
 150     'Warn before upgrade',
 151   );
 152
 153   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
 154
 155   lives_ok ( sub {
 156     $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion');
 157   }, 'new column created');
 158 }
 159
 160 # now put the v1 schema back again
 161 {
 162   # drop all the tables...
 163   eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
 164   eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
 165   eval { $schema_v1->storage->dbh->do('drop table TestVersion') };
 166
 167   {
 168     local $DBICVersion::Schema::VERSION = '1.0';
 169     $schema_v1->deploy;
 170   }
 171   is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok');
 172 }
 173
 174 # attempt v1 -> v3 upgrade
 175 {
 176   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
 177   $schema_v3->upgrade();
 178   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
 179 }
 180
 181 # Now, try a v1 -> v3 upgrade with a file that has comments strategically placed in it.
 182 # First put the v1 schema back again...
 183 {
 184   # drop all the tables...
 185   eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
 186   eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
 187   eval { $schema_v1->storage->dbh->do('drop table TestVersion') };
 188
 189   {
 190     local $DBICVersion::Schema::VERSION = '1.0';
 191     $schema_v1->deploy;
 192   }
 193   is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok');
 194 }
 195
 196 # add a "harmless" comment before one of the statements.
 197 {
 198   my ($perl) = $^X =~ /(.+)/;
 199   local $ENV{PATH};
 200   system( qq($perl -pi.bak -e "s/ALTER/-- this is a comment\nALTER/" $fn->{trans_v23}) );
 201 }
 202
 203 # Then attempt v1 -> v3 upgrade
 204 {
 205   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
 206   $schema_v3->upgrade();
 207   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded to 3.0');
 208
 209   # make sure that the column added after the comment is actually added.
 210   lives_ok ( sub {
 211     $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion');
 212   }, 'new column created');
 213 }
 214
 215
 216 # check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr
 217 {
 218   my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
 219   eval {
 220     $schema_version->storage->dbh->do("DELETE from $version_table_name");
 221   };
 222
 223
 224   warnings_like ( sub {
 225     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
 226   }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr' );
 227
 228   warnings_like ( sub {
 229     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
 230   },  [], 'warning not detected with attr set');
 231
 232
 233   local $ENV{DBIC_NO_VERSION_CHECK} = 1;
 234   warnings_like ( sub {
 235     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
 236   }, [], 'warning not detected with env var set');
 237
 238   warnings_like ( sub {
 239     $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
 240   }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
 241 }
 242
 243 # attempt a deploy/upgrade cycle within one second
 244 {
 245   eval { $schema_v2->storage->dbh->do('drop table ' . $version_table_name) };
 246   eval { $schema_v2->storage->dbh->do('drop table ' . $old_table_name) };
 247   eval { $schema_v2->storage->dbh->do('drop table TestVersion') };
 248
 249   # this attempts to sleep until the turn of the second
 250   my $t = time();
 251   sleep (int ($t) + 1 - $t);
 252   note ('Fast deploy/upgrade start: ', time() );
 253
 254   {
 255     local $DBICVersion::Schema::VERSION = '2.0';
 256     $schema_v2->deploy;
 257   }
 258
 259   local $SIG{__WARN__} = sigwarn_silencer( qr/Attempting upgrade\.$/ );
 260
 261   $schema_v2->upgrade();
 262
 263   is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade');
 264 };
 265
 266 # Check that it Schema::Versioned deals with new/all forms of connect arguments.
 267 {
 268   my $get_db_version_run = 0;
 269
 270   no warnings qw/once redefine/;
 271   local *DBIx::Class::Schema::Versioned::get_db_version = sub {
 272     $get_db_version_run = 1;
 273     return $_[0]->schema_version;
 274   };
 275
 276   # Make sure the env var isn't whats triggering it
 277   local $ENV{DBIC_NO_VERSION_CHECK} = 0;
 278
 279   DBICVersion::Schema->connect({
 280     dsn => $dsn,
 281     user => $user,
 282     pass => $pass,
 283     ignore_version => 1
 284   });
 285
 286   ok($get_db_version_run == 0, "attributes pulled from hashref connect_info");
 287   $get_db_version_run = 0;
 288
 289   DBICVersion::Schema->connect( $dsn, $user, $pass, { ignore_version => 1 } );
 290   ok($get_db_version_run == 0, "attributes pulled from list connect_info");
 291 }
 292
 293 # at this point we have v1, v2 and v3 still connected
 294 # make sure they are the only connections and everything else is gone
 295 is
 296   scalar( grep
 297     { defined $_ and $_->{Active} }
 298     map
 299       { @{$_->{ChildHandles}} }
 300       values %{ { DBI->installed_drivers } }
 301   ), 3, "Expected number of connections at end of script"
 302 ;
 303
 304 # Test custom HandleError setting on an in-memory instance
 305 {
 306   my $custom_handler = sub { die $_[0] };
 307
 308   # try to setup a custom error handle without unsafe set -- should
 309   # fail, same behavior as regular Schema
 310   throws_ok {
 311     DBICVersion::Schema->connect( 'dbi:SQLite::memory:', undef, undef, {
 312       HandleError => $custom_handler,
 313       ignore_version => 1,
 314     })->deploy;
 315   }
 316     qr/Refusing clobbering of \{HandleError\} installed on externally supplied DBI handle/,
 317     'HandleError with unsafe not set causes an exception'
 318   ;
 319
 320   # now try it with unsafe set -- should work (see RT #113741)
 321   my $s = DBICVersion::Schema->connect( 'dbi:SQLite::memory:', undef, undef, {
 322     unsafe => 1,
 323     HandleError => $custom_handler,
 324     ignore_version => 1,
 325   });
 326
 327   $s->deploy;
 328
 329   is $s->storage->dbh->{HandleError}, $custom_handler, 'Handler properly set on main schema';
 330   is $s->{vschema}->storage->dbh->{HandleError}, $custom_handler, 'Handler properly set on version subschema';
 331 }
 332
 333 END {
 334   unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
 335     $ddl_dir->rmtree;
 336   }
 337 }
 338
 339 done_testing;