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_install;
  31    {
  32       my $warned = 0;
  33       local $SIG{__WARN__} = sub{$warned = 1};
  34       $dm->prepare_install;
  35       ok( $warned, 'prepare_install 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 my $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    });
  82
  83    ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly');
  84
  85    $version = $s->schema_version();
  86    $dm->prepare_install;
  87    ok(
  88       -f catfile(qw( t sql SQLite schema 2.0 001-auto.sql )),
  89       '2.0 schema gets generated properly'
  90    );
  91    mkpath(catfile(qw( t sql SQLite up 1.0-2.0 )));
  92    $dm->prepare_upgrade(qw(1.0 2.0), [qw(1.0 2.0)]);
  93
  94    {
  95       my $warned = 0;
  96       local $SIG{__WARN__} = sub{$warned = 1};
  97       $dm->prepare_upgrade(qw(0.0 1.0), [qw(0.0 1.0)]);
  98       ok( $warned, 'prepare_upgrade with a bogus preversion warns' );
  99    }
 100    ok(
 101       -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )),
 102       '1.0-2.0 diff gets generated properly and default start and end versions get set'
 103    );
 104    mkpath(catfile(qw( t sql SQLite down 2.0-1.0 )));
 105    $dm->prepare_downgrade($version, '1.0', [$version, '1.0']);
 106    ok(
 107       -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql )),
 108       '2.0-1.0 diff gets generated properly'
 109    );
 110    dies_ok {
 111       $s->resultset('Foo')->create({
 112          bar => 'frew',
 113          baz => 'frew',
 114       })
 115    } 'schema not deployed';
 116    dies_ok {
 117       $s->resultset('Foo')->create({
 118          bar => 'frew',
 119          baz => 'frew',
 120       })
 121    } 'schema not uppgrayyed';
 122
 123    mkpath catfile(qw( t sql _common up 1.0-2.0 ));
 124    open my $common, '>',
 125       catfile(qw( t sql _common up 1.0-2.0 002-semiautomatic.sql ));
 126    print {$common} qq<INSERT INTO Foo (bar, baz) VALUES ("hello", "world");\n\n>;
 127    close $common;
 128
 129    $dm->upgrade_single_step([qw( 1.0 2.0 )]);
 130    is( $s->resultset('Foo')->search({
 131          bar => 'hello',
 132          baz => 'world',
 133       })->count, 1, '_common migration got run');
 134    lives_ok {
 135       $s->resultset('Foo')->create({
 136          bar => 'frew',
 137          baz => 'frew',
 138       })
 139    } 'schema is deployed';
 140    $dm->downgrade_single_step([qw( 2.0 1.0 )]);
 141    dies_ok {
 142       $s->resultset('Foo')->create({
 143          bar => 'frew',
 144          baz => 'frew',
 145       })
 146    } 'schema is downpgrayyed';
 147    $dm->upgrade_single_step([qw( 1.0 2.0 )]);
 148 }
 149
 150 VERSION3: {
 151    use_ok 'DBICVersion_v3';
 152    my $s = DBICVersion::Schema->connect(@connection);
 153    my $dm = Translator->new({
 154       schema            => $s,
 155       upgrade_directory => $sql_dir,
 156       databases         => ['SQLite'],
 157       sqltargs          => { add_drop_table => 0 },
 158       txn_wrap          => 0,
 159    });
 160
 161    ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly');
 162
 163    $version = $s->schema_version();
 164    $dm->prepare_install;
 165    ok(
 166       -f catfile(qw( t sql SQLite schema 3.0 001-auto.sql )),
 167       '2.0 schema gets generated properly'
 168    );
 169    $dm->prepare_downgrade($version, '1.0', [$version, '1.0']);
 170    ok(
 171       -f catfile(qw( t sql SQLite down 3.0-1.0 001-auto.sql )),
 172       '3.0-1.0 diff gets generated properly'
 173    );
 174    $dm->prepare_upgrade( '1.0', $version, ['1.0', $version] );
 175    ok(
 176       -f catfile(qw( t sql SQLite up 1.0-3.0 001-auto.sql )),
 177       '1.0-3.0 diff gets generated properly'
 178    );
 179    $dm->prepare_upgrade( '2.0', $version, ['2.0', $version]);
 180    {
 181       my $warned = 0;
 182       local $SIG{__WARN__} = sub{$warned = 1};
 183       $dm->prepare_upgrade( '2.0', $version, ['2.0', $version] );
 184       ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' );
 185    }
 186    ok(
 187       -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )),
 188       '2.0-3.0 diff gets generated properly'
 189    );
 190    mkpath catfile(qw( t sql _generic up 2.0-3.0 ));
 191    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 ));
 192    rmtree(catfile(qw( t sql SQLite )));
 193    warn 'how can this be' if -d catfile(qw( t sql SQLite ));
 194    dies_ok {
 195       $s->resultset('Foo')->create({
 196             bar => 'frew',
 197             baz => 'frew',
 198             biff => 'frew',
 199          })
 200    } 'schema not deployed';
 201    $dm->upgrade_single_step([qw( 2.0 3.0 )]);
 202    lives_ok {
 203       $s->resultset('Foo')->create({
 204          bar => 'frew',
 205          baz => 'frew',
 206          biff => 'frew',
 207       })
 208    } 'schema is deployed using _generic';
 209    rmtree(catfile(qw( t sql SQLite )));
 210    rmtree(catfile(qw( t sql _generic )));
 211    dies_ok {
 212       $dm->upgrade_single_step([qw( 2.0 3.0 )]);
 213    } 'dies when sql dir does not exist';
 214 }
 215 done_testing;
 216 #vim: ts=2 sw=2 expandtab