t/deploy_methods/sql_translator.t

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