t/deploy_methods/sql_translator.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal qw(lives_ok dies_ok);
   8
   9 use lib 't/lib';
  10 use DBICDHTest;
  11 use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
  12 use Path::Class qw(dir file);
  13 use File::Temp qw(tempfile tempdir);
  14
  15 my $dbh = DBICDHTest::dbh();
  16 my @connection = (sub { $dbh }, { ignore_version => 1 });
  17 my $sql_dir = tempdir( CLEANUP => 1 );
  18 my (undef, $stuffthatran_fn) = tempfile(OPEN => 0);
  19
  20 for (qw(initialize upgrade downgrade deploy)) {
  21    dir($sql_dir, '_common',  $_, '_any')->mkpath;
  22    open my $fh, '>',
  23       file($sql_dir, '_common', $_, qw(_any 000-win.pl ));
  24    print {$fh} qq^sub {open my \$fh, ">>", '$stuffthatran_fn'; use Data::Dumper::Concise; print {\$fh} join(",", \@{\$_[1]||[]}) . "\\n";  }^;
  25    close $fh;
  26 }
  27
  28 for (qw(initialize upgrade downgrade deploy)) {
  29    dir($sql_dir, 'SQLite',  $_, '_any')->mkpath;
  30    open my $fh, '>',
  31       file($sql_dir, 'SQLite', $_, qw(_any 000-win2.pl ));
  32    print {$fh} qq^sub {open my \$fh, ">>", '$stuffthatran_fn'; use Data::Dumper::Concise; print {\$fh} join(",", \@{\$_[1]||[]}) . "\\n";  }^;
  33    close $fh;
  34 }
  35
  36 VERSION1: {
  37    use_ok 'DBICVersion_v1';
  38    my $s = DBICVersion::Schema->connect(@connection);
  39    my $dm = Translator->new({
  40       schema            => $s,
  41       script_directory => $sql_dir,
  42       databases         => ['SQLite'],
  43       sql_translator_args          => { add_drop_table => 0 },
  44    });
  45
  46    ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' );
  47
  48    $dm->prepare_deploy;
  49
  50    dir($sql_dir, qw(SQLite initialize 1.0 ))->mkpath;
  51    open my $prerun, '>',
  52       file($sql_dir, qw(SQLite initialize 1.0 003-semiautomatic.pl ));
  53    my (undef, $fn) = tempfile(OPEN => 0);
  54    print {$prerun} "sub { open my \$fh, '>', '$fn'}";
  55    close $prerun;
  56    $dm->initialize({ version => '1.0' });
  57
  58    ok -e $fn, 'code got run in preinit';
  59
  60    dies_ok {$dm->prepare_deploy} 'prepare_deploy dies if you run it twice' ;
  61
  62    ok(
  63       -f file($sql_dir, qw(SQLite deploy 1.0 001-auto.sql )),
  64       '1.0 schema gets generated properly'
  65    );
  66
  67    dies_ok {
  68       $s->resultset('Foo')->create({
  69          bar => 'frew',
  70       })
  71    } 'schema not deployed';
  72
  73    $dm->deploy;
  74
  75    lives_ok {
  76       $s->resultset('Foo')->create({
  77          bar => 'frew',
  78       })
  79    } 'schema is deployed';
  80 }
  81
  82 VERSION2: {
  83    use_ok 'DBICVersion_v2';
  84    my $s = DBICVersion::Schema->connect(@connection);
  85    my $dm = Translator->new({
  86       schema            => $s,
  87       script_directory => $sql_dir,
  88       databases         => ['SQLite'],
  89       sql_translator_args          => { add_drop_table => 0 },
  90       txn_wrap          => 1,
  91    });
  92
  93    ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly');
  94
  95    my $version = $s->schema_version();
  96    $dm->prepare_deploy;
  97    ok(
  98       -f file($sql_dir, qw(SQLite deploy 2.0 001-auto.sql )),
  99       '2.0 schema gets generated properly'
 100    );
 101    dir($sql_dir, qw(SQLite upgrade 1.0-2.0 ))->mkpath;
 102    $dm->prepare_upgrade({
 103      from_version => '1.0',
 104      to_version => '2.0',
 105      version_set => [qw(1.0 2.0)]
 106    });
 107
 108    {
 109       my $warned = 0;
 110       local $SIG{__WARN__} = sub{$warned = 1};
 111       $dm->prepare_upgrade({
 112         from_version => '0.0',
 113         to_version => '1.0',
 114         version_set => [qw(0.0 1.0)]
 115       });
 116       ok( $warned, 'prepare_upgrade with a bogus preversion warns' );
 117    }
 118    ok(
 119       -f file($sql_dir, qw(SQLite upgrade 1.0-2.0 001-auto.sql )),
 120       '1.0-2.0 diff gets generated properly and default start and end versions get set'
 121    );
 122    dir($sql_dir, qw(SQLite downgrade 2.0-1.0 ))->mkpath;
 123    $dm->prepare_downgrade({
 124      from_version => $version,
 125      to_version => '1.0',
 126      version_set => [$version, '1.0']
 127    });
 128    ok(
 129       -f file($sql_dir, qw(SQLite downgrade 2.0-1.0 001-auto.sql )),
 130       '2.0-1.0 diff gets generated properly'
 131    );
 132    dies_ok {
 133       $s->resultset('Foo')->create({
 134          bar => 'frew',
 135          baz => 'frew',
 136       })
 137    } 'schema not deployed';
 138    dies_ok {
 139       $s->resultset('Foo')->create({
 140          bar => 'frew',
 141          baz => 'frew',
 142       })
 143    } 'schema not uppgrayyed';
 144
 145    dir($sql_dir, qw(_common upgrade 1.0-2.0 ))->mkpath;
 146    open my $common, '>',
 147       file($sql_dir, qw(_common upgrade 1.0-2.0 002-semiautomatic.sql ));
 148    print {$common} qq<INSERT INTO Foo (bar, baz) VALUES ("hello", "world");\n\n>;
 149    close $common;
 150
 151    open my $common_pl, '>',
 152       file($sql_dir, qw(_common upgrade 1.0-2.0 003-semiautomatic.pl ));
 153    print {$common_pl} q|
 154       sub {
 155          my $schema = shift;
 156          $schema->resultset('Foo')->create({
 157             bar => 'goodbye',
 158             baz => 'blue skies',
 159          })
 160       }
 161    |;
 162    close $common_pl;
 163
 164    $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
 165    is( $s->resultset('Foo')->search({
 166          bar => 'hello',
 167          baz => 'world',
 168       })->count, 1, '_common migration got run');
 169    is( $s->resultset('Foo')->search({
 170          bar => 'goodbye',
 171          #baz => 'blue skies',
 172       })->count, 1, '_common perl migration got run');
 173    lives_ok {
 174       $s->resultset('Foo')->create({
 175          bar => 'frew',
 176          baz => 'frew',
 177       })
 178    } 'schema is deployed';
 179    $dm->downgrade_single_step({ version_set => [qw( 2.0 1.0 )] });
 180    dies_ok {
 181       $s->resultset('Foo')->create({
 182          bar => 'frew',
 183          baz => 'frew',
 184       })
 185    } 'schema is downgrayyed';
 186    $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
 187 }
 188
 189 VERSION3: {
 190    use_ok 'DBICVersion_v3';
 191    my $s = DBICVersion::Schema->connect(@connection);
 192    my $dm = Translator->new({
 193       schema            => $s,
 194       script_directory => $sql_dir,
 195       databases         => ['SQLite'],
 196       sql_translator_args          => { add_drop_table => 0 },
 197       txn_wrap          => 0,
 198    });
 199
 200    ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly');
 201
 202    my $version = $s->schema_version();
 203    $dm->prepare_deploy;
 204    ok(
 205       -f file($sql_dir, qw(SQLite deploy 3.0 001-auto.sql )),
 206       '2.0 schema gets generated properly'
 207    );
 208    $dm->prepare_downgrade({
 209      from_version => $version,
 210      to_version => '1.0',
 211      version_set => [$version, '1.0']
 212    });
 213    ok(
 214       -f file($sql_dir, qw(SQLite downgrade 3.0-1.0 001-auto.sql )),
 215       '3.0-1.0 diff gets generated properly'
 216    );
 217    $dm->prepare_upgrade({
 218      from_version => '1.0',
 219      to_version => $version,
 220      version_set => ['1.0', $version]
 221    });
 222    ok(
 223       -f file($sql_dir, qw(SQLite upgrade 1.0-3.0 001-auto.sql )),
 224       '1.0-3.0 diff gets generated properly'
 225    );
 226    $dm->prepare_upgrade({
 227      from_version => '2.0',
 228      to_version => $version,
 229      version_set => ['2.0', $version]
 230    });
 231    dies_ok {
 232       $dm->prepare_upgrade({
 233         from_version => '2.0',
 234         to_version => $version,
 235         version_set => ['2.0', $version]
 236       });
 237       }
 238    'prepare_upgrade dies if you clobber an existing upgrade file' ;
 239    ok(
 240       -f file($sql_dir, qw(SQLite upgrade 1.0-2.0 001-auto.sql )),
 241       '2.0-3.0 diff gets generated properly'
 242    );
 243    dies_ok {
 244       $s->resultset('Foo')->create({
 245             bar => 'frew',
 246             baz => 'frew',
 247             biff => 'frew',
 248          })
 249    } 'schema not deployed';
 250    $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] });
 251    lives_ok {
 252       $s->resultset('Foo')->create({
 253          bar => 'frew',
 254          baz => 'frew',
 255          biff => 'frew',
 256       })
 257    } 'schema is deployed';
 258    dies_ok {
 259       $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] });
 260    } 'dies when sql dir does not exist';
 261 }
 262
 263 my $stuff_that_ran = do { local( @ARGV, $/ ) = $stuffthatran_fn; <> };
 264 is $stuff_that_ran,
 265 '
 266
 267 1.0
 268 1.0
 269 1.0,2.0
 270 1.0,2.0
 271 2.0,1.0
 272 2.0,1.0
 273 1.0,2.0
 274 1.0,2.0
 275 2.0,3.0
 276 2.0,3.0
 277 2.0,3.0
 278 2.0,3.0
 279 ', '_any got ran the right amount of times with the right args';
 280
 281 done_testing;
 282 #vim: ts=2 sw=2 expandtab