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