upgrade sql should work now
[dbsrgits/DBIx-Class-DeploymentHandler.git] / t / deploy_methods / sql_translator.t
CommitLineData
02d58ac0 1#!perl
2
3use Test::More;
4use Test::Exception;
5
6use lib 't/lib';
7use DBICDHTest;
459a67e3 8use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
3b98a3a1 9use File::Spec::Functions;
d50f2521 10use File::Path qw(rmtree mkpath);
459a67e3 11
12my $db = 'dbi:SQLite:db.db';
13my @connection = ($db, '', '', { ignore_version => 1 });
14my $sql_dir = 't/sql';
15
16DBICDHTest::ready;
17
18VERSION1: {
19 use_ok 'DBICVersion_v1';
20 my $s = DBICVersion::Schema->connect(@connection);
21 my $dm = Translator->new({
3b98a3a1 22 schema => $s,
459a67e3 23 upgrade_directory => $sql_dir,
3b98a3a1 24 databases => ['SQLite'],
25 sqltargs => { add_drop_table => 0 },
459a67e3 26 });
27
28 ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' );
3b98a3a1 29
30 $dm->prepare_install;
d50f2521 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;
3b98a3a1 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
d50f2521 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 }
3b98a3a1 65
66 lives_ok {
67 $s->resultset('Foo')->create({
68 bar => 'frew',
69 })
70 } 'schema is deployed';
71}
72
73VERSION2: {
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 );
d50f2521 91 mkpath(catfile(qw( t sql SQLite up 1.0-2.0 )));
92 $dm->prepare_upgrade;
93
94 {
95 my $warned = 0;
96 local $SIG{__WARN__} = sub{$warned = 1};
97 $dm->prepare_upgrade('0.0', '1.0');
98 ok( $warned, 'prepare_upgrade with a bogus preversion warns' );
99 }
3b98a3a1 100 ok(
101 -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )),
d50f2521 102 '1.0-2.0 diff gets generated properly and default start and end versions get set'
3b98a3a1 103 );
d50f2521 104 mkpath(catfile(qw( t sql SQLite down 2.0-1.0 )));
3b98a3a1 105 $dm->prepare_downgrade($version, '1.0');
106 ok(
107 -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql )),
d50f2521 108 '2.0-1.0 diff gets generated properly'
3b98a3a1 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';
d50f2521 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
3b98a3a1 129 $dm->_upgrade_single_step([qw( 1.0 2.0 )]);
d50f2521 130 is( $s->resultset('Foo')->search({
131 bar => 'hello',
132 baz => 'world',
133 })->count, 1, '_common migration got run');
3b98a3a1 134 lives_ok {
135 $s->resultset('Foo')->create({
136 bar => 'frew',
137 baz => 'frew',
138 })
139 } 'schema is deployed';
d50f2521 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 )]);
459a67e3 148}
02d58ac0 149
3b98a3a1 150VERSION3: {
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 },
d50f2521 158 txn_wrap => 0,
3b98a3a1 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 );
d50f2521 169 $dm->prepare_downgrade($version, '1.0');
3b98a3a1 170 ok(
d50f2521 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 )),
3b98a3a1 177 '1.0-3.0 diff gets generated properly'
178 );
179 $dm->prepare_upgrade( '2.0', $version );
d50f2521 180 {
181 my $warned = 0;
182 local $SIG{__WARN__} = sub{$warned = 1};
183 $dm->prepare_upgrade( '2.0', $version );
184 ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' );
185 }
3b98a3a1 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 );
d50f2521 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 ));
3b98a3a1 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 })
d50f2521 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';
3b98a3a1 214}
02d58ac0 215done_testing;
d50f2521 216#vim: ts=2 sw=2 expandtab