t/deploy_methods/sql_translator.t

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