Commit | Line | Data |
02d58ac0 |
1 | #!perl |
2 | |
3 | use Test::More; |
4 | use Test::Exception; |
5 | |
6 | use lib 't/lib'; |
7 | use DBICDHTest; |
459a67e3 |
8 | use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator'; |
3b98a3a1 |
9 | use File::Spec::Functions; |
d50f2521 |
10 | use File::Path qw(rmtree mkpath); |
459a67e3 |
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({ |
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 | |
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 | ); |
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 |
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 }, |
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 |
215 | done_testing; |
d50f2521 |
216 | #vim: ts=2 sw=2 expandtab |