Commit | Line | Data |
70350518 |
1 | use strict; |
2 | use warnings; |
3 | |
637ca936 |
4 | use Test::More; |
5 | use lib qw(t/lib); |
6 | use DBICTest; |
637ca936 |
7 | |
8 | eval "use SQL::Translator"; |
9 | plan skip_all => 'SQL::Translator required' if $@; |
10 | |
661fc8eb |
11 | my $schema = DBICTest->init_schema; |
637ca936 |
12 | |
b1edf9f9 |
13 | plan tests => 53; |
637ca936 |
14 | |
661fc8eb |
15 | my $translator = SQL::Translator->new( |
16 | parser_args => { |
17 | 'DBIx::Schema' => $schema, |
18 | }, |
19 | producer_args => {}, |
637ca936 |
20 | ); |
21 | |
22 | $translator->parser('SQL::Translator::Parser::DBIx::Class'); |
23 | $translator->producer('SQLite'); |
24 | |
25 | my $output = $translator->translate(); |
26 | |
b1edf9f9 |
27 | # Note that the constraints listed here are the only ones that are tested -- if |
28 | # more exist in the Schema than are listed here and all listed constraints are |
c75b18e9 |
29 | # correct, the test will still pass. If you add a class with UNIQUE or FOREIGN |
30 | # KEY constraints to DBICTest::Schema, add tests here if you think the existing |
31 | # test coverage is not sufficient |
b1edf9f9 |
32 | |
33 | my %fk_constraints = ( |
661fc8eb |
34 | |
35 | # TwoKeys |
b1edf9f9 |
36 | twokeys => [ |
37 | { |
38 | 'display' => 'twokeys->cd', |
39 | 'selftable' => 'twokeys', 'foreigntable' => 'cd', |
40 | 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], |
41 | on_delete => '', on_update => '', |
42 | }, |
43 | { |
44 | 'display' => 'twokeys->artist', |
45 | 'selftable' => 'twokeys', 'foreigntable' => 'artist', |
46 | 'selfcols' => ['artist'], 'foreigncols' => ['artistid'], |
47 | on_delete => 'CASCADE', on_update => 'CASCADE', |
48 | }, |
49 | ], |
661fc8eb |
50 | |
51 | # FourKeys_to_TwoKeys |
b1edf9f9 |
52 | fourkeys_to_twokeys => [ |
53 | { |
54 | 'display' => 'fourkeys_to_twokeys->twokeys', |
55 | 'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'twokeys', |
56 | 'selfcols' => ['t_artist', 't_cd'], 'foreigncols' => ['artist', 'cd'], |
57 | on_delete => 'CASCADE', on_update => 'CASCADE', |
58 | }, |
59 | { |
60 | 'display' => 'fourkeys_to_twokeys->fourkeys', |
61 | 'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'fourkeys', |
62 | 'selfcols' => [qw(f_foo f_bar f_hello f_goodbye)], |
63 | 'foreigncols' => [qw(foo bar hello goodbye)], |
64 | on_delete => 'CASCADE', on_update => 'CASCADE', |
65 | }, |
66 | ], |
661fc8eb |
67 | |
68 | # CD_to_Producer |
b1edf9f9 |
69 | cd_to_producer => [ |
70 | { |
71 | 'display' => 'cd_to_producer->cd', |
72 | 'selftable' => 'cd_to_producer', 'foreigntable' => 'cd', |
73 | 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], |
74 | on_delete => 'CASCADE', on_update => 'CASCADE', |
75 | }, |
76 | { |
77 | 'display' => 'cd_to_producer->producer', |
78 | 'selftable' => 'cd_to_producer', 'foreigntable' => 'producer', |
79 | 'selfcols' => ['producer'], 'foreigncols' => ['producerid'], |
80 | on_delete => '', on_update => '', |
81 | }, |
82 | ], |
661fc8eb |
83 | |
84 | # Self_ref_alias |
b1edf9f9 |
85 | self_ref_alias => [ |
86 | { |
87 | 'display' => 'self_ref_alias->self_ref for self_ref', |
88 | 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', |
89 | 'selfcols' => ['self_ref'], 'foreigncols' => ['id'], |
90 | on_delete => 'CASCADE', on_update => 'CASCADE', |
91 | }, |
92 | { |
93 | 'display' => 'self_ref_alias->self_ref for alias', |
94 | 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', |
95 | 'selfcols' => ['alias'], 'foreigncols' => ['id'], |
96 | on_delete => '', on_update => '', |
97 | }, |
98 | ], |
661fc8eb |
99 | |
100 | # CD |
b1edf9f9 |
101 | cd => [ |
102 | { |
103 | 'display' => 'cd->artist', |
104 | 'selftable' => 'cd', 'foreigntable' => 'artist', |
105 | 'selfcols' => ['artist'], 'foreigncols' => ['artistid'], |
106 | on_delete => 'CASCADE', on_update => 'CASCADE', |
107 | }, |
108 | ], |
661fc8eb |
109 | |
110 | # Artist_undirected_map |
b1edf9f9 |
111 | artist_undirected_map => [ |
112 | { |
113 | 'display' => 'artist_undirected_map->artist for id1', |
114 | 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', |
115 | 'selfcols' => ['id1'], 'foreigncols' => ['artistid'], |
116 | on_delete => 'CASCADE', on_update => '', |
117 | }, |
118 | { |
119 | 'display' => 'artist_undirected_map->artist for id2', |
120 | 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', |
121 | 'selfcols' => ['id2'], 'foreigncols' => ['artistid'], |
122 | on_delete => 'CASCADE', on_update => '', |
123 | }, |
124 | ], |
661fc8eb |
125 | |
126 | # Track |
b1edf9f9 |
127 | track => [ |
128 | { |
129 | 'display' => 'track->cd', |
130 | 'selftable' => 'track', 'foreigntable' => 'cd', |
131 | 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], |
132 | on_delete => 'CASCADE', on_update => 'CASCADE', |
133 | }, |
134 | ], |
661fc8eb |
135 | |
136 | # TreeLike |
b1edf9f9 |
137 | treelike => [ |
138 | { |
139 | 'display' => 'treelike->treelike for parent', |
140 | 'selftable' => 'treelike', 'foreigntable' => 'treelike', |
141 | 'selfcols' => ['parent'], 'foreigncols' => ['id'], |
4481a67c |
142 | on_delete => 'CASCADE', on_update => 'CASCADE', |
b1edf9f9 |
143 | }, |
144 | ], |
145 | |
146 | # TwoKeyTreeLike |
147 | twokeytreelike => [ |
148 | { |
149 | 'display' => 'twokeytreelike->twokeytreelike for parent1,parent2', |
150 | 'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike', |
151 | 'selfcols' => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'], |
152 | on_delete => '', on_update => '', |
153 | }, |
154 | ], |
ae515736 |
155 | |
661fc8eb |
156 | # Tags |
b1edf9f9 |
157 | tags => [ |
158 | { |
159 | 'display' => 'tags->cd', |
160 | 'selftable' => 'tags', 'foreigntable' => 'cd', |
161 | 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], |
162 | on_delete => 'CASCADE', on_update => 'CASCADE', |
163 | }, |
164 | ], |
661fc8eb |
165 | |
166 | # Bookmark |
b1edf9f9 |
167 | bookmark => [ |
168 | { |
169 | 'display' => 'bookmark->link', |
170 | 'selftable' => 'bookmark', 'foreigntable' => 'link', |
171 | 'selfcols' => ['link'], 'foreigncols' => ['id'], |
172 | on_delete => '', on_update => '', |
173 | }, |
174 | ], |
175 | ); |
176 | |
177 | my %unique_constraints = ( |
178 | # CD |
179 | cd => [ |
180 | { |
181 | 'display' => 'cd artist and title unique', |
182 | 'table' => 'cd', 'cols' => ['artist', 'title'], |
183 | }, |
184 | ], |
185 | |
186 | # Producer |
187 | producer => [ |
188 | { |
189 | 'display' => 'producer name unique', |
190 | 'table' => 'producer', 'cols' => ['name'], |
191 | }, |
192 | ], |
193 | |
194 | # TwoKeyTreeLike |
195 | twokeytreelike => [ |
196 | { |
197 | 'display' => 'twokeytreelike name unique', |
198 | 'table' => 'twokeytreelike', 'cols' => ['name'], |
199 | }, |
200 | ], |
201 | |
202 | # Employee |
203 | # Constraint is commented out in DBICTest/Schema/Employee.pm |
204 | # employee => [ |
205 | # { |
206 | # 'display' => 'employee position and group_id unique', |
207 | # 'table' => 'employee', cols => ['position', 'group_id'], |
208 | # }, |
209 | # ], |
7b90bb13 |
210 | ); |
211 | |
637ca936 |
212 | my $tschema = $translator->schema(); |
b1edf9f9 |
213 | |
214 | # Test that nonexistent constraints are not found |
215 | my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']); |
216 | ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' ); |
217 | $constraint = get_constraint('UNIQUE', 'cd', ['artist']); |
218 | ok( !defined($constraint), 'nonexistent UNIQUE constraint not found' ); |
219 | |
220 | for my $expected_constraints (keys %fk_constraints) { |
221 | for my $expected_constraint (@{ $fk_constraints{$expected_constraints} }) { |
222 | my $desc = $expected_constraint->{display}; |
223 | my $constraint = get_constraint( |
224 | 'FOREIGN KEY', |
225 | $expected_constraint->{selftable}, $expected_constraint->{selfcols}, |
226 | $expected_constraint->{foreigntable}, $expected_constraint->{foreigncols}, |
227 | ); |
228 | ok( defined($constraint), "FOREIGN KEY constraint matching `$desc' found" ); |
229 | test_fk($expected_constraint, $constraint); |
661fc8eb |
230 | } |
637ca936 |
231 | } |
232 | |
b1edf9f9 |
233 | for my $expected_constraints (keys %unique_constraints) { |
234 | for my $expected_constraint (@{ $unique_constraints{$expected_constraints} }) { |
235 | my $desc = $expected_constraint->{display}; |
236 | my $constraint = get_constraint( |
237 | 'UNIQUE', $expected_constraint->{table}, $expected_constraint->{cols}, |
238 | ); |
239 | ok( defined($constraint), "UNIQUE constraint matching `$desc' found" ); |
240 | } |
637ca936 |
241 | } |
242 | |
b1edf9f9 |
243 | # Returns the Constraint object for the specified constraint type, table and |
244 | # columns from the SQL::Translator schema, or undef if no matching constraint |
245 | # is found. |
246 | # |
247 | # NB: $type is either 'FOREIGN KEY' or 'UNIQUE'. In UNIQUE constraints the last |
248 | # two parameters are not used. |
249 | sub get_constraint { |
250 | my ($type, $table_name, $cols, $f_table, $f_cols) = @_; |
251 | $f_table ||= ''; # For UNIQUE constraints, reference_table is '' |
252 | $f_cols ||= []; |
253 | |
254 | my $table = $tschema->get_table($table_name); |
255 | |
256 | my %fields = map { $_ => 1 } @$cols; |
257 | my %f_fields = map { $_ => 1 } @$f_cols; |
258 | |
259 | CONSTRAINT: |
260 | for my $constraint ( $table->get_constraints ) { |
261 | next unless $constraint->type eq $type; |
262 | next unless $constraint->reference_table eq $f_table; |
263 | |
264 | my %rev_fields = map { $_ => 1 } $constraint->fields; |
265 | my %rev_f_fields = map { $_ => 1 } $constraint->reference_fields; |
266 | |
267 | # Check that the given fields are a subset of the constraint's fields |
268 | for my $field ($constraint->fields) { |
269 | next CONSTRAINT unless $fields{$field}; |
270 | } |
271 | if ($type eq 'FOREIGN KEY') { |
272 | for my $f_field ($constraint->reference_fields) { |
273 | next CONSTRAINT unless $f_fields{$f_field}; |
661fc8eb |
274 | } |
b1edf9f9 |
275 | } |
661fc8eb |
276 | |
b1edf9f9 |
277 | # Check that the constraint's fields are a subset of the given fields |
278 | for my $field (@$cols) { |
279 | next CONSTRAINT unless $rev_fields{$field}; |
280 | } |
281 | if ($type eq 'FOREIGN KEY') { |
282 | for my $f_field (@$f_cols) { |
283 | next CONSTRAINT unless $rev_f_fields{$f_field}; |
661fc8eb |
284 | } |
285 | } |
b1edf9f9 |
286 | |
287 | return $constraint; # everything passes, found the constraint |
661fc8eb |
288 | } |
b1edf9f9 |
289 | return undef; # didn't find a matching constraint |
7b90bb13 |
290 | } |
291 | |
b1edf9f9 |
292 | # Test parameters in a FOREIGN KEY constraint other than columns |
293 | sub test_fk { |
294 | my ($expected, $got) = @_; |
295 | my $desc = $expected->{display}; |
296 | is( $got->on_delete, $expected->{on_delete}, |
297 | "on_delete parameter correct for `$desc'" ); |
298 | is( $got->on_update, $expected->{on_update}, |
299 | "on_update parameter correct for `$desc'" ); |
637ca936 |
300 | } |