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