fix Cursor SYNOPSIS
[dbsrgits/DBIx-Class-Historic.git] / t / 86sqlt.t
CommitLineData
70350518 1use strict;
2use warnings;
3
637ca936 4use Test::More;
5use lib qw(t/lib);
6use DBICTest;
637ca936 7
fed15b91 8use Scalar::Util 'blessed';
9
7f6f5b69 10BEGIN {
2527233b 11 require DBIx::Class;
7f6f5b69 12 plan skip_all =>
2527233b 13 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')
14 unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')
7f6f5b69 15}
637ca936 16
c66a805c 17my $custom_deployment_statements_called = 0;
18
19sub DBICTest::Schema::deployment_statements {
20 $custom_deployment_statements_called = 1;
21 my $self = shift;
22 return $self->next::method(@_);
23}
24
30ae562b 25
26# Check deployment statements ctx sensitivity
27{
6ddb4ac0 28 my $schema = DBICTest->init_schema (no_deploy => 1);
30ae562b 29 my $not_first_table_creation_re = qr/CREATE TABLE fourkeys_to_twokeys/;
30
30ae562b 31 my $statements = $schema->deployment_statements;
32 like (
33 $statements,
34 $not_first_table_creation_re,
35 'All create statements returned in 1 string in scalar ctx'
36 );
37
38 my @statements = $schema->deployment_statements;
39 cmp_ok (scalar @statements, '>', 1, 'Multiple statement lines in array ctx');
40
41 my $i = 0;
42 while ($i <= $#statements) {
43 last if $statements[$i] =~ $not_first_table_creation_re;
44 $i++;
45 }
46
47 ok (
48 ($i > 0) && ($i <= $#statements),
49 "Creation statement was found somewherere within array ($i)"
50 );
51}
52
fed15b91 53{
54 # use our own throw-away schema, since we'll be deploying twice
55 my $schema = DBICTest->init_schema (no_deploy => 1);
56
57 my $deploy_hook_called = 0;
58 $custom_deployment_statements_called = 0;
59
60 # add a temporary sqlt_deploy_hook to a source
a267ea85 61 local $DBICTest::Schema::Track::hook_cb = sub {
7f3fd262 62 my ($class, $sqlt_table) = @_;
fed15b91 63
64 $deploy_hook_called = 1;
65
7f3fd262 66 is ($class, 'DBICTest::Track', 'Result class passed to plain hook');
30ae562b 67
fed15b91 68 is (
69 $sqlt_table->schema->translator->producer_type,
70 join ('::', 'SQL::Translator::Producer', $schema->storage->sqlt_type),
71 'Production type passed to translator object',
72 );
73 };
74
a267ea85 75 my $component_deploy_hook_called = 0;
76 local $DBICTest::DeployComponent::hook_cb = sub {
77 $component_deploy_hook_called = 1;
78 };
79
fed15b91 80 $schema->deploy; # do not remove, this fires the is() test in the callback above
81 ok($deploy_hook_called, 'deploy hook got called');
82 ok($custom_deployment_statements_called, '->deploy used the schemas deploy_statements method');
a267ea85 83 ok($component_deploy_hook_called, 'component deploy hook got called');
fed15b91 84}
30ae562b 85
6ddb4ac0 86my $schema = DBICTest->init_schema (no_deploy => 1);
87
427c4089 88{
89 my $deploy_hook_called = 0;
fed15b91 90 $custom_deployment_statements_called = 0;
65d35121 91 my $sqlt_type = $schema->storage->sqlt_type;
0fd7e9a3 92
427c4089 93 # replace the sqlt calback with a custom version ading an index
94 $schema->source('Track')->sqlt_deploy_callback(sub {
95 my ($self, $sqlt_table) = @_;
0fd7e9a3 96
427c4089 97 $deploy_hook_called = 1;
0fd7e9a3 98
427c4089 99 is (
100 $sqlt_table->schema->translator->producer_type,
65d35121 101 join ('::', 'SQL::Translator::Producer', $sqlt_type),
427c4089 102 'Production type passed to translator object',
103 );
0fd7e9a3 104
65d35121 105 if ($sqlt_type eq 'SQLite' ) {
427c4089 106 $sqlt_table->add_index( name => 'track_title', fields => ['title'] )
107 or die $sqlt_table->error;
108 }
109
110 $self->default_sqlt_deploy_hook($sqlt_table);
111 });
112
113 $schema->deploy; # do not remove, this fires the is() test in the callback above
114 ok($deploy_hook_called, 'deploy hook got called');
c66a805c 115 ok($custom_deployment_statements_called, '->deploy used the schemas deploy_statements method');
427c4089 116}
637ca936 117
637ca936 118
8273e845 119my $translator = SQL::Translator->new(
661fc8eb 120 parser_args => {
121 'DBIx::Schema' => $schema,
122 },
123 producer_args => {},
637ca936 124);
125
e377d723 126{
127 my $warn = '';
128 local $SIG{__WARN__} = sub { $warn = shift };
637ca936 129
e377d723 130 my $relinfo = $schema->source('Artist')->relationship_info ('cds');
131 local $relinfo->{attrs}{on_delete} = 'restrict';
637ca936 132
f89bb832 133
e377d723 134 $translator->parser('SQL::Translator::Parser::DBIx::Class');
135 $translator->producer('SQLite');
256e87b0 136
e377d723 137 my $output = $translator->translate();
138
139 ok($output, "SQLT produced someoutput")
140 or diag($translator->error);
141
0fd7e9a3 142
48850f9a 143 like (
144 $warn,
145 qr/SQLT attribute .+? was supplied for relationship .+? which does not appear to be a foreign constraint/,
146 'Warn about dubious on_delete/on_update attributes',
147 );
e377d723 148}
256e87b0 149
b1edf9f9 150# Note that the constraints listed here are the only ones that are tested -- if
151# more exist in the Schema than are listed here and all listed constraints are
c75b18e9 152# correct, the test will still pass. If you add a class with UNIQUE or FOREIGN
153# KEY constraints to DBICTest::Schema, add tests here if you think the existing
154# test coverage is not sufficient
b1edf9f9 155
156my %fk_constraints = (
661fc8eb 157
158 # TwoKeys
b1edf9f9 159 twokeys => [
160 {
161 'display' => 'twokeys->cd',
bb0f01d0 162 'name' => 'twokeys_fk_cd', 'index_name' => 'twokeys_idx_cd',
8273e845 163 'selftable' => 'twokeys', 'foreigntable' => 'cd',
164 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
9c1f7965 165 'noindex' => 1,
13de943d 166 on_delete => '', on_update => '', deferrable => 0,
b1edf9f9 167 },
168 {
169 'display' => 'twokeys->artist',
bb0f01d0 170 'name' => 'twokeys_fk_artist', 'index_name' => 'twokeys_idx_artist',
8273e845 171 'selftable' => 'twokeys', 'foreigntable' => 'artist',
b1edf9f9 172 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
e394339b 173 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 174 },
175 ],
661fc8eb 176
177 # FourKeys_to_TwoKeys
b1edf9f9 178 fourkeys_to_twokeys => [
179 {
180 'display' => 'fourkeys_to_twokeys->twokeys',
f34cb1fd 181 'name' => 'fourkeys_to_twokeys_fk_t_artist_t_cd', 'index_name' => 'fourkeys_to_twokeys_idx_t_artist_t_cd',
8273e845 182 'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'twokeys',
183 'selfcols' => ['t_artist', 't_cd'], 'foreigncols' => ['artist', 'cd'],
e394339b 184 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 185 },
186 {
f34cb1fd 187 'display' => 'fourkeys_to_twokeys->fourkeys', 'index_name' => 'fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye',
d1b264d3 188 'name' => 'fourkeys_to_twokeys_fk_f_foo_f_bar_f_hello_f_goodbye',
8273e845 189 'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'fourkeys',
b1edf9f9 190 'selfcols' => [qw(f_foo f_bar f_hello f_goodbye)],
8273e845 191 'foreigncols' => [qw(foo bar hello goodbye)],
e394339b 192 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 193 },
194 ],
661fc8eb 195
196 # CD_to_Producer
b1edf9f9 197 cd_to_producer => [
198 {
199 'display' => 'cd_to_producer->cd',
bb0f01d0 200 'name' => 'cd_to_producer_fk_cd', 'index_name' => 'cd_to_producer_idx_cd',
8273e845 201 'selftable' => 'cd_to_producer', 'foreigntable' => 'cd',
b1edf9f9 202 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
e394339b 203 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 204 },
205 {
206 'display' => 'cd_to_producer->producer',
bb0f01d0 207 'name' => 'cd_to_producer_fk_producer', 'index_name' => 'cd_to_producer_idx_producer',
8273e845 208 'selftable' => 'cd_to_producer', 'foreigntable' => 'producer',
b1edf9f9 209 'selfcols' => ['producer'], 'foreigncols' => ['producerid'],
e394339b 210 on_delete => '', on_update => '', deferrable => 1,
b1edf9f9 211 },
212 ],
661fc8eb 213
214 # Self_ref_alias
b1edf9f9 215 self_ref_alias => [
216 {
217 'display' => 'self_ref_alias->self_ref for self_ref',
bb0f01d0 218 'name' => 'self_ref_alias_fk_self_ref', 'index_name' => 'self_ref_alias_idx_self_ref',
8273e845 219 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
b1edf9f9 220 'selfcols' => ['self_ref'], 'foreigncols' => ['id'],
e394339b 221 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 222 },
223 {
224 'display' => 'self_ref_alias->self_ref for alias',
bb0f01d0 225 'name' => 'self_ref_alias_fk_alias', 'index_name' => 'self_ref_alias_idx_alias',
8273e845 226 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
b1edf9f9 227 'selfcols' => ['alias'], 'foreigncols' => ['id'],
e394339b 228 on_delete => '', on_update => '', deferrable => 1,
b1edf9f9 229 },
230 ],
661fc8eb 231
232 # CD
b1edf9f9 233 cd => [
234 {
235 'display' => 'cd->artist',
bb0f01d0 236 'name' => 'cd_fk_artist', 'index_name' => 'cd_idx_artist',
8273e845 237 'selftable' => 'cd', 'foreigntable' => 'artist',
b1edf9f9 238 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
a0dd8679 239 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 240 },
241 ],
661fc8eb 242
243 # Artist_undirected_map
b1edf9f9 244 artist_undirected_map => [
245 {
246 'display' => 'artist_undirected_map->artist for id1',
bb0f01d0 247 'name' => 'artist_undirected_map_fk_id1', 'index_name' => 'artist_undirected_map_idx_id1',
8273e845 248 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
b1edf9f9 249 'selfcols' => ['id1'], 'foreigncols' => ['artistid'],
e377d723 250 on_delete => 'RESTRICT', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 251 },
252 {
253 'display' => 'artist_undirected_map->artist for id2',
bb0f01d0 254 'name' => 'artist_undirected_map_fk_id2', 'index_name' => 'artist_undirected_map_idx_id2',
8273e845 255 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
b1edf9f9 256 'selfcols' => ['id2'], 'foreigncols' => ['artistid'],
b230b4be 257 on_delete => '', on_update => '', deferrable => 1,
b1edf9f9 258 },
259 ],
661fc8eb 260
261 # Track
b1edf9f9 262 track => [
263 {
264 'display' => 'track->cd',
bb0f01d0 265 'name' => 'track_fk_cd', 'index_name' => 'track_idx_cd',
8273e845 266 'selftable' => 'track', 'foreigntable' => 'cd',
b1edf9f9 267 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
e394339b 268 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 269 },
270 ],
661fc8eb 271
272 # TreeLike
b1edf9f9 273 treelike => [
274 {
275 'display' => 'treelike->treelike for parent',
61177e44 276 'name' => 'treelike_fk_parent', 'index_name' => 'treelike_idx_parent',
8273e845 277 'selftable' => 'treelike', 'foreigntable' => 'treelike',
61177e44 278 'selfcols' => ['parent'], 'foreigncols' => ['id'],
e394339b 279 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 280 },
281 ],
282
283 # TwoKeyTreeLike
284 twokeytreelike => [
285 {
286 'display' => 'twokeytreelike->twokeytreelike for parent1,parent2',
bb0f01d0 287 'name' => 'twokeytreelike_fk_parent1_parent2', 'index_name' => 'twokeytreelike_idx_parent1_parent2',
8273e845 288 'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike',
b1edf9f9 289 'selfcols' => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'],
e394339b 290 on_delete => '', on_update => '', deferrable => 1,
b1edf9f9 291 },
292 ],
ae515736 293
661fc8eb 294 # Tags
b1edf9f9 295 tags => [
296 {
297 'display' => 'tags->cd',
bb0f01d0 298 'name' => 'tags_fk_cd', 'index_name' => 'tags_idx_cd',
8273e845 299 'selftable' => 'tags', 'foreigntable' => 'cd',
b1edf9f9 300 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
e394339b 301 on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 302 },
303 ],
661fc8eb 304
305 # Bookmark
b1edf9f9 306 bookmark => [
307 {
308 'display' => 'bookmark->link',
bb0f01d0 309 'name' => 'bookmark_fk_link', 'index_name' => 'bookmark_idx_link',
8273e845 310 'selftable' => 'bookmark', 'foreigntable' => 'link',
b1edf9f9 311 'selfcols' => ['link'], 'foreigncols' => ['id'],
def17c59 312 on_delete => 'SET NULL', on_update => 'CASCADE', deferrable => 1,
b1edf9f9 313 },
314 ],
a0024650 315 # ForceForeign
316 forceforeign => [
317 {
318 'display' => 'forceforeign->artist',
bb0f01d0 319 'name' => 'forceforeign_fk_artist', 'index_name' => 'forceforeign_idx_artist',
8273e845 320 'selftable' => 'forceforeign', 'foreigntable' => 'artist',
321 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
827a808f 322 'noindex' => 1,
e394339b 323 on_delete => '', on_update => '', deferrable => 1,
a0024650 324 },
325 ],
b1edf9f9 326);
327
328my %unique_constraints = (
329 # CD
330 cd => [
331 {
332 'display' => 'cd artist and title unique',
0da8b7da 333 'name' => 'cd_artist_title',
b1edf9f9 334 'table' => 'cd', 'cols' => ['artist', 'title'],
335 },
336 ],
337
338 # Producer
339 producer => [
340 {
341 'display' => 'producer name unique',
0da8b7da 342 'name' => 'prod_name', # explicit name
b1edf9f9 343 'table' => 'producer', 'cols' => ['name'],
344 },
345 ],
346
347 # TwoKeyTreeLike
348 twokeytreelike => [
349 {
350 'display' => 'twokeytreelike name unique',
0da8b7da 351 'name' => 'tktlnameunique', # explicit name
b1edf9f9 352 'table' => 'twokeytreelike', 'cols' => ['name'],
353 },
354 ],
355
356 # Employee
357# Constraint is commented out in DBICTest/Schema/Employee.pm
358# employee => [
359# {
360# 'display' => 'employee position and group_id unique',
0da8b7da 361# 'name' => 'position_group',
b1edf9f9 362# 'table' => 'employee', cols => ['position', 'group_id'],
363# },
364# ],
7b90bb13 365);
366
17cab2f0 367my %indexes = (
c385ecea 368 artist => [
369 {
370 'fields' => ['name']
371 },
f89bb832 372 ],
373 track => [
374 {
375 'fields' => ['title']
376 }
377 ],
c385ecea 378);
379
637ca936 380my $tschema = $translator->schema();
d6c79cb3 381# Test that the $schema->sqlt_deploy_hook was called okay and that it removed
458e0292 382# the 'dummy' table
383ok( !defined($tschema->get_table('dummy')), "Dummy table was removed by hook");
d6c79cb3 384
1f5bf324 385# Test that the Artist resultsource sqlt_deploy_hook was called okay and added
386# an index
387SKIP: {
388 skip ('Artist sqlt_deploy_hook is only called with an SQLite backend', 1)
389 if $schema->storage->sqlt_type ne 'SQLite';
390
8273e845 391 ok( ( grep
1f5bf324 392 { $_->name eq 'artist_name_hookidx' }
393 $tschema->get_table('artist')->get_indices
394 ), 'sqlt_deploy_hook fired within a resultsource');
395}
396
b1edf9f9 397# Test that nonexistent constraints are not found
398my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']);
399ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' );
400$constraint = get_constraint('UNIQUE', 'cd', ['artist']);
401ok( !defined($constraint), 'nonexistent UNIQUE constraint not found' );
a0024650 402$constraint = get_constraint('FOREIGN KEY', 'forceforeign', ['cd'], 'cd', ['cdid']);
403ok( !defined($constraint), 'forced nonexistent FOREIGN KEY constraint not found' );
b1edf9f9 404
405for my $expected_constraints (keys %fk_constraints) {
406 for my $expected_constraint (@{ $fk_constraints{$expected_constraints} }) {
407 my $desc = $expected_constraint->{display};
408 my $constraint = get_constraint(
409 'FOREIGN KEY',
410 $expected_constraint->{selftable}, $expected_constraint->{selfcols},
411 $expected_constraint->{foreigntable}, $expected_constraint->{foreigncols},
412 );
413 ok( defined($constraint), "FOREIGN KEY constraint matching `$desc' found" );
414 test_fk($expected_constraint, $constraint);
661fc8eb 415 }
637ca936 416}
417
b1edf9f9 418for my $expected_constraints (keys %unique_constraints) {
419 for my $expected_constraint (@{ $unique_constraints{$expected_constraints} }) {
420 my $desc = $expected_constraint->{display};
421 my $constraint = get_constraint(
422 'UNIQUE', $expected_constraint->{table}, $expected_constraint->{cols},
423 );
424 ok( defined($constraint), "UNIQUE constraint matching `$desc' found" );
0da8b7da 425 test_unique($expected_constraint, $constraint);
b1edf9f9 426 }
637ca936 427}
428
17cab2f0 429for my $table_index (keys %indexes) {
430 for my $expected_index ( @{ $indexes{$table_index} } ) {
c385ecea 431 ok ( get_index($table_index, $expected_index), "Got a matching index on $table_index table");
432 }
433}
434
b1edf9f9 435# Returns the Constraint object for the specified constraint type, table and
436# columns from the SQL::Translator schema, or undef if no matching constraint
437# is found.
438#
439# NB: $type is either 'FOREIGN KEY' or 'UNIQUE'. In UNIQUE constraints the last
440# two parameters are not used.
441sub get_constraint {
442 my ($type, $table_name, $cols, $f_table, $f_cols) = @_;
443 $f_table ||= ''; # For UNIQUE constraints, reference_table is ''
444 $f_cols ||= [];
445
446 my $table = $tschema->get_table($table_name);
447
448 my %fields = map { $_ => 1 } @$cols;
449 my %f_fields = map { $_ => 1 } @$f_cols;
450
a7e65bb5 451 die "No $table_name" unless $table;
b1edf9f9 452 CONSTRAINT:
453 for my $constraint ( $table->get_constraints ) {
454 next unless $constraint->type eq $type;
455 next unless $constraint->reference_table eq $f_table;
456
457 my %rev_fields = map { $_ => 1 } $constraint->fields;
458 my %rev_f_fields = map { $_ => 1 } $constraint->reference_fields;
459
460 # Check that the given fields are a subset of the constraint's fields
461 for my $field ($constraint->fields) {
462 next CONSTRAINT unless $fields{$field};
463 }
464 if ($type eq 'FOREIGN KEY') {
465 for my $f_field ($constraint->reference_fields) {
466 next CONSTRAINT unless $f_fields{$f_field};
661fc8eb 467 }
b1edf9f9 468 }
661fc8eb 469
b1edf9f9 470 # Check that the constraint's fields are a subset of the given fields
471 for my $field (@$cols) {
472 next CONSTRAINT unless $rev_fields{$field};
473 }
474 if ($type eq 'FOREIGN KEY') {
475 for my $f_field (@$f_cols) {
476 next CONSTRAINT unless $rev_f_fields{$f_field};
661fc8eb 477 }
478 }
b1edf9f9 479
480 return $constraint; # everything passes, found the constraint
661fc8eb 481 }
b1edf9f9 482 return undef; # didn't find a matching constraint
7b90bb13 483}
484
c385ecea 485sub get_index {
486 my ($table_name, $index) = @_;
487
488 my $table = $tschema->get_table($table_name);
489
490 CAND_INDEX:
491 for my $cand_index ( $table->get_indices ) {
8273e845 492
c385ecea 493 next CAND_INDEX if $index->{name} && $cand_index->name ne $index->{name}
494 || $index->{type} && $cand_index->type ne $index->{type};
495
496 my %idx_fields = map { $_ => 1 } $cand_index->fields;
497
498 for my $field ( @{ $index->{fields} } ) {
499 next CAND_INDEX unless $idx_fields{$field};
500 }
501
502 %idx_fields = map { $_ => 1 } @{$index->{fields}};
503 for my $field ( $cand_index->fields) {
504 next CAND_INDEX unless $idx_fields{$field};
505 }
506
507 return $cand_index;
508 }
509
510 return undef; # No matching idx
511}
512
b1edf9f9 513# Test parameters in a FOREIGN KEY constraint other than columns
514sub test_fk {
515 my ($expected, $got) = @_;
516 my $desc = $expected->{display};
0da8b7da 517 is( $got->name, $expected->{name},
827a808f 518 "name parameter correct for '$desc'" );
b1edf9f9 519 is( $got->on_delete, $expected->{on_delete},
827a808f 520 "on_delete parameter correct for '$desc'" );
b1edf9f9 521 is( $got->on_update, $expected->{on_update},
827a808f 522 "on_update parameter correct for '$desc'" );
13de943d 523 is( $got->deferrable, $expected->{deferrable},
827a808f 524 "is_deferrable parameter correct for '$desc'" );
0da8b7da 525
526 my $index = get_index( $got->table, { fields => $expected->{selfcols} } );
9c1f7965 527
528 if ($expected->{noindex}) {
827a808f 529 ok( !defined $index, "index doesn't for '$desc'" );
9c1f7965 530 } else {
827a808f 531 ok( defined $index, "index exists for '$desc'" );
532 is( $index->name, $expected->{index_name}, "index has correct name for '$desc'" );
9c1f7965 533 }
0da8b7da 534}
535
536sub test_unique {
537 my ($expected, $got) = @_;
538 my $desc = $expected->{display};
539 is( $got->name, $expected->{name},
827a808f 540 "name parameter correct for '$desc'" );
637ca936 541}
0fd7e9a3 542
543done_testing;