1package dbixcsl_common_tests; 2 3use strict; 4use warnings; 5 6use Test::More; 7use DBIx::Class::Schema::Loader; 8use DBI; 9 10sub new { 11 my $class = shift; 12 13 my $self; 14 15 if( ref($_[0]) eq 'HASH') { 16 my $args = shift; 17 $self = { (%$args) }; 18 } 19 else { 20 $self = { @_ }; 21 } 22 23 # Only MySQL uses this 24 $self->{innodb} ||= ''; 25 26 $self->{verbose} = $ENV{TEST_VERBOSE} || 0; 27 28 return bless $self => $class; 29} 30 31sub skip_tests { 32 my ($self, $why) = @_; 33 34 plan skip_all => $why; 35} 36 37sub _monikerize { 38 my $name = shift; 39 return 'LoaderTest2X' if $name =~ /^loader_test2$/i; 40 return undef; 41} 42 43sub run_tests { 44 my $self = shift; 45 46 plan tests => 97; 47 48 $self->create(); 49 50 my $schema_class = 'DBIXCSL_Test::Schema'; 51 52 my $debug = ($self->{verbose} > 1) ? 1 : 0; 53 54 my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} ); 55 my %loader_opts = ( 56 constraint => qr/^(?:\S+\.)?loader_test[0-9]+$/i, 57 relationships => 1, 58 additional_classes => 'TestAdditional', 59 additional_base_classes => 'TestAdditionalBase', 60 left_base_classes => [ qw/TestLeftBase/ ], 61 components => [ qw/TestComponent/ ], 62 inflect_plural => { loader_test4 => 'loader_test4zes' }, 63 inflect_singular => { fkid => 'fkid_singular' }, 64 moniker_map => \&_monikerize, 65 debug => $debug, 66 ); 67 68 $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; 69 70 { 71 my @loader_warnings; 72 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; 73 eval qq{ 74 package $schema_class; 75 use base qw/DBIx::Class::Schema::Loader/; 76 77 __PACKAGE__->loader_options(\%loader_opts); 78 __PACKAGE__->connection(\@connect_info); 79 }; 80 ok(!$@, "Loader initialization") or diag $@; 81 82 my $warn_count = 0; 83 $warn_count++ if grep /ResultSetManager/, @loader_warnings; 84 $warn_count++ if grep /Dynamic schema detected/, @loader_warnings; 85 $warn_count++ for grep /^Bad table or view/, @loader_warnings; 86 87 is(scalar(@loader_warnings), $warn_count) 88 or diag "Did not get the expected 0 warnings. Warnings are: " 89 . join('',@loader_warnings); 90 } 91 92 my $conn = $schema_class->clone; 93 my $monikers = {}; 94 my $classes = {}; 95 foreach my $source_name ($schema_class->sources) { 96 my $table_name = $schema_class->loader->moniker_to_table->{$source_name}; 97 98 my $result_class = $schema_class->source($source_name)->result_class; 99 100 $monikers->{$table_name} = $source_name; 101 $classes->{$table_name} = $result_class; 102 103 # some DBs (Firebird, Oracle) uppercase everything 104 $monikers->{lc $table_name} = $source_name; 105 $classes->{lc $table_name} = $result_class; 106 } 107 108# for debugging... 109# { 110# mkdir '/tmp/HLAGH'; 111# $conn->_loader->{dump_directory} = '/tmp/HLAGH'; 112# $conn->_loader->_dump_to_dir(values %$classes); 113# } 114 115 my $moniker1 = $monikers->{loader_test1}; 116 my $class1 = $classes->{loader_test1}; 117 my $rsobj1 = $conn->resultset($moniker1); 118 119 my $moniker2 = $monikers->{loader_test2}; 120 my $class2 = $classes->{loader_test2}; 121 my $rsobj2 = $conn->resultset($moniker2); 122 123 my $moniker23 = $monikers->{LOADER_TEST23}; 124 my $class23 = $classes->{LOADER_TEST23}; 125 my $rsobj23 = $conn->resultset($moniker1); 126 127 my $moniker24 = $monikers->{LoAdEr_test24}; 128 my $class24 = $classes->{LoAdEr_test24}; 129 my $rsobj24 = $conn->resultset($moniker2); 130 131 isa_ok( $rsobj1, "DBIx::Class::ResultSet" ); 132 isa_ok( $rsobj2, "DBIx::Class::ResultSet" ); 133 isa_ok( $rsobj23, "DBIx::Class::ResultSet" ); 134 isa_ok( $rsobj24, "DBIx::Class::ResultSet" ); 135 136 my @columns_lt2 = $class2->columns; 137 is($columns_lt2[0], 'id', "Column Ordering 0"); 138 is($columns_lt2[1], 'dat', "Column Ordering 1"); 139 is($columns_lt2[2], 'dat2', "Column Ordering 2"); 140 141 my %uniq1 = $class1->unique_constraints; 142 my $uniq1_test = 0; 143 foreach my $ucname (keys %uniq1) { 144 my $cols_arrayref = $uniq1{$ucname}; 145 if(@$cols_arrayref == 1 && $cols_arrayref->[0] eq 'dat') { 146 $uniq1_test = 1; 147 last; 148 } 149 } 150 ok($uniq1_test) or diag "Unique constraints not working"; 151 152 my %uniq2 = $class2->unique_constraints; 153 my $uniq2_test = 0; 154 foreach my $ucname (keys %uniq2) { 155 my $cols_arrayref = $uniq2{$ucname}; 156 if(@$cols_arrayref == 2 157 && $cols_arrayref->[0] eq 'dat2' 158 && $cols_arrayref->[1] eq 'dat') { 159 $uniq2_test = 2; 160 last; 161 } 162 } 163 ok($uniq2_test) or diag "Multi-col unique constraints not working"; 164 165 is($moniker2, 'LoaderTest2X', "moniker_map testing"); 166 167 { 168 my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth, 169 $skip_tcomp, $skip_trscomp); 170 171 can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1; 172 can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1; 173 can_ok( $class1, 'test_additional_base_additional' ) or $skip_taba = 1; 174 can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1; 175 can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1; 176 177 SKIP: { 178 skip "Pre-requisite test failed", 1 if $skip_tab; 179 is( $class1->test_additional_base, "test_additional_base", 180 "Additional Base method" ); 181 } 182 183 SKIP: { 184 skip "Pre-requisite test failed", 1 if $skip_tabo; 185 is( $class1->test_additional_base_override, 186 "test_left_base_override", 187 "Left Base overrides Additional Base method" ); 188 } 189 190 SKIP: { 191 skip "Pre-requisite test failed", 1 if $skip_taba; 192 is( $class1->test_additional_base_additional, "test_additional", 193 "Additional Base can use Additional package method" ); 194 } 195 196 SKIP: { 197 skip "Pre-requisite test failed", 1 if $skip_tcomp; 198 is( $class1->dbix_class_testcomponent, 199 'dbix_class_testcomponent works' ); 200 } 201 202 SKIP: { 203 skip "Pre-requisite test failed", 1 if $skip_cmeth; 204 is( $class1->loader_test1_classmeth, 'all is well' ); 205 } 206 } 207 208 209 my $obj = $rsobj1->find(1); 210 is( $obj->id, 1 ); 211 is( $obj->dat, "foo" ); 212 is( $rsobj2->count, 4 ); 213 my $saved_id; 214 eval { 215 my $new_obj1 = $rsobj1->create({ dat => 'newthing' }); 216 $saved_id = $new_obj1->id; 217 }; 218 ok(!$@) or diag "Died during create new record using a PK::Auto key: $@"; 219 ok($saved_id) or diag "Failed to get PK::Auto-generated id"; 220 221 my $new_obj1 = $rsobj1->search({ dat => 'newthing' })->first; 222 ok($new_obj1) or diag "Cannot find newly inserted PK::Auto record"; 223 is($new_obj1->id, $saved_id); 224 225 my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first; 226 is( $obj2->id, 2 ); 227 228 SKIP: { 229 skip $self->{skip_rels}, 63 if $self->{skip_rels}; 230 231 my $moniker3 = $monikers->{loader_test3}; 232 my $class3 = $classes->{loader_test3}; 233 my $rsobj3 = $conn->resultset($moniker3); 234 235 my $moniker4 = $monikers->{loader_test4}; 236 my $class4 = $classes->{loader_test4}; 237 my $rsobj4 = $conn->resultset($moniker4); 238 239 my $moniker5 = $monikers->{loader_test5}; 240 my $class5 = $classes->{loader_test5}; 241 my $rsobj5 = $conn->resultset($moniker5); 242 243 my $moniker6 = $monikers->{loader_test6}; 244 my $class6 = $classes->{loader_test6}; 245 my $rsobj6 = $conn->resultset($moniker6); 246 247 my $moniker7 = $monikers->{loader_test7}; 248 my $class7 = $classes->{loader_test7}; 249 my $rsobj7 = $conn->resultset($moniker7); 250 251 my $moniker8 = $monikers->{loader_test8}; 252 my $class8 = $classes->{loader_test8}; 253 my $rsobj8 = $conn->resultset($moniker8); 254 255 my $moniker9 = $monikers->{loader_test9}; 256 my $class9 = $classes->{loader_test9}; 257 my $rsobj9 = $conn->resultset($moniker9); 258 259 my $moniker16 = $monikers->{loader_test16}; 260 my $class16 = $classes->{loader_test16}; 261 my $rsobj16 = $conn->resultset($moniker16); 262 263 my $moniker17 = $monikers->{loader_test17}; 264 my $class17 = $classes->{loader_test17}; 265 my $rsobj17 = $conn->resultset($moniker17); 266 267 my $moniker18 = $monikers->{loader_test18}; 268 my $class18 = $classes->{loader_test18}; 269 my $rsobj18 = $conn->resultset($moniker18); 270 271 my $moniker19 = $monikers->{loader_test19}; 272 my $class19 = $classes->{loader_test19}; 273 my $rsobj19 = $conn->resultset($moniker19); 274 275 my $moniker20 = $monikers->{loader_test20}; 276 my $class20 = $classes->{loader_test20}; 277 my $rsobj20 = $conn->resultset($moniker20); 278 279 my $moniker21 = $monikers->{loader_test21}; 280 my $class21 = $classes->{loader_test21}; 281 my $rsobj21 = $conn->resultset($moniker21); 282 283 my $moniker22 = $monikers->{loader_test22}; 284 my $class22 = $classes->{loader_test22}; 285 my $rsobj22 = $conn->resultset($moniker22); 286 287 my $moniker25 = $monikers->{loader_test25}; 288 my $class25 = $classes->{loader_test25}; 289 my $rsobj25 = $conn->resultset($moniker25); 290 291 my $moniker26 = $monikers->{loader_test26}; 292 my $class26 = $classes->{loader_test26}; 293 my $rsobj26 = $conn->resultset($moniker26); 294 295 isa_ok( $rsobj3, "DBIx::Class::ResultSet" ); 296 isa_ok( $rsobj4, "DBIx::Class::ResultSet" ); 297 isa_ok( $rsobj5, "DBIx::Class::ResultSet" ); 298 isa_ok( $rsobj6, "DBIx::Class::ResultSet" ); 299 isa_ok( $rsobj7, "DBIx::Class::ResultSet" ); 300 isa_ok( $rsobj8, "DBIx::Class::ResultSet" ); 301 isa_ok( $rsobj9, "DBIx::Class::ResultSet" ); 302 isa_ok( $rsobj16, "DBIx::Class::ResultSet" ); 303 isa_ok( $rsobj17, "DBIx::Class::ResultSet" ); 304 isa_ok( $rsobj18, "DBIx::Class::ResultSet" ); 305 isa_ok( $rsobj19, "DBIx::Class::ResultSet" ); 306 isa_ok( $rsobj20, "DBIx::Class::ResultSet" ); 307 isa_ok( $rsobj21, "DBIx::Class::ResultSet" ); 308 isa_ok( $rsobj22, "DBIx::Class::ResultSet" ); 309 isa_ok( $rsobj25, "DBIx::Class::ResultSet" ); 310 isa_ok( $rsobj26, "DBIx::Class::ResultSet" ); 311 312 # basic rel test 313 my $obj4 = $rsobj4->find(123); 314 isa_ok( $obj4->fkid_singular, $class3); 315 316 my $obj3 = $rsobj3->find(1); 317 my $rs_rel4 = $obj3->search_related('loader_test4zes'); 318 isa_ok( $rs_rel4->first, $class4); 319 320 # test that _id is not stripped and prepositions in rel names are 321 # ignored 322 ok ($rsobj4->result_source->has_relationship('loader_test5_to_ids'), 323 "rel with preposition 'to' and _id pluralized backward-compatibly"); 324 325 ok ($rsobj4->result_source->has_relationship('loader_test5_from_ids'), 326 "rel with preposition 'from' and _id pluralized backward-compatibly"); 327 328 # check that default relationship attributes are not applied in 0.04006 mode 329 is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 1, 330 'cascade_delete => 1 on has_many by default'; 331 332 is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 1, 333 'cascade_copy => 1 on has_many by default'; 334 335 ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_delete}), 336 'has_many does not have on_delete'); 337 338 ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_update}), 339 'has_many does not have on_update'); 340 341 ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{is_deferrable}), 342 'has_many does not have is_deferrable'); 343 344 isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE', 345 "on_delete => 'CASCADE' not on belongs_to by default"; 346 347 isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE', 348 "on_update => 'CASCADE' not on belongs_to by default"; 349 350 isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1, 351 "is_deferrable => 1 not on belongs_to by default"; 352 353 ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_delete}), 354 'belongs_to does not have cascade_delete'); 355 356 ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}), 357 'belongs_to does not have cascade_copy'); 358 359 # find on multi-col pk 360 my $obj5 = $rsobj5->find({id1 => 1, id2 => 1}); 361 is( $obj5->id2, 1 ); 362 363 # mulit-col fk def 364 my $obj6 = $rsobj6->find(1); 365 isa_ok( $obj6->loader_test2, $class2); 366 isa_ok( $obj6->loader_test5, $class5); 367 368 # fk that references a non-pk key (UNIQUE) 369 my $obj8 = $rsobj8->find(1); 370 isa_ok( $obj8->loader_test7, $class7); 371 372 # test double-fk 17 ->-> 16 373 my $obj17 = $rsobj17->find(33); 374 375 my $rs_rel16_one = $obj17->loader16_one; 376 isa_ok($rs_rel16_one, $class16); 377 is($rs_rel16_one->dat, 'y16'); 378 379 my $rs_rel16_two = $obj17->loader16_two; 380 isa_ok($rs_rel16_two, $class16); 381 is($rs_rel16_two->dat, 'z16'); 382 383 my $obj16 = $rsobj16->find(2); 384 my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones'); 385 isa_ok($rs_rel17->first, $class17); 386 is($rs_rel17->first->id, 3); 387 388 # XXX test m:m 18 <- 20 -> 19 389 390 # XXX test double-fk m:m 21 <- 22 -> 21 391 392 # test double multi-col fk 26 -> 25 393 my $obj26 = $rsobj26->find(33); 394 395 my $rs_rel25_one = $obj26->loader_test25_id_rel1; 396 isa_ok($rs_rel25_one, $class25); 397 is($rs_rel25_one->dat, 'x25'); 398 399 my $rs_rel25_two = $obj26->loader_test25_id_rel2; 400 isa_ok($rs_rel25_two, $class25); 401 is($rs_rel25_two->dat, 'y25'); 402 403 my $obj25 = $rsobj25->find(3,42); 404 my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s'); 405 isa_ok($rs_rel26->first, $class26); 406 is($rs_rel26->first->id, 3); 407 408 # from Chisel's tests... 409 SKIP: { 410 if($self->{vendor} =~ /sqlite/i) { 411 skip 'SQLite cannot do the advanced tests', 8; 412 } 413 414 my $moniker10 = $monikers->{loader_test10}; 415 my $class10 = $classes->{loader_test10}; 416 my $rsobj10 = $conn->resultset($moniker10); 417 418 my $moniker11 = $monikers->{loader_test11}; 419 my $class11 = $classes->{loader_test11}; 420 my $rsobj11 = $conn->resultset($moniker11); 421 422 isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); 423 isa_ok( $rsobj11, "DBIx::Class::ResultSet" ); 424 425 my $obj10 = $rsobj10->create({ subject => 'xyzzy' }); 426 427 $obj10->update(); 428 ok( defined $obj10, '$obj10 is defined' ); 429 430 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() }); 431 $obj11->update(); 432 ok( defined $obj11, '$obj11 is defined' ); 433 434 eval { 435 my $obj10_2 = $obj11->loader_test10; 436 $obj10_2->loader_test11( $obj11->id11() ); 437 $obj10_2->update(); 438 }; 439 is($@, '', 'No errors after eval{}') 440 or do { 441 diag explain $rsobj10->result_source->relationship_info('loader_test11'); 442 diag explain $rsobj11->result_source->relationship_info('loader_test10'); 443 }; 444 445 SKIP: { 446 skip 'Previous eval block failed', 3 447 unless ($@ eq ''); 448 449 my $results = $rsobj10->search({ subject => 'xyzzy' }); 450 is( $results->count(), 1, 451 'One $rsobj10 returned from search' ); 452 453 my $obj10_3 = $results->first(); 454 isa_ok( $obj10_3, $class10 ); 455 is( $obj10_3->loader_test11()->id(), $obj11->id(), 456 'found same $rsobj11 object we expected' ); 457 } 458 } 459 460 SKIP: { 461 skip 'This vendor cannot do inline relationship definitions', 6 462 if $self->{no_inline_rels}; 463 464 my $moniker12 = $monikers->{loader_test12}; 465 my $class12 = $classes->{loader_test12}; 466 my $rsobj12 = $conn->resultset($moniker12); 467 468 my $moniker13 = $monikers->{loader_test13}; 469 my $class13 = $classes->{loader_test13}; 470 my $rsobj13 = $conn->resultset($moniker13); 471 472 isa_ok( $rsobj12, "DBIx::Class::ResultSet" ); 473 isa_ok( $rsobj13, "DBIx::Class::ResultSet" ); 474 475 my $obj13 = $rsobj13->find(1); 476 isa_ok( $obj13->id, $class12 ); 477 isa_ok( $obj13->loader_test12, $class12); 478 isa_ok( $obj13->dat, $class12); 479 480 my $obj12 = $rsobj12->find(1); 481 isa_ok( $obj12->loader_test13_ids, "DBIx::Class::ResultSet" ); 482 } 483 484 SKIP: { 485 skip 'This vendor cannot do out-of-line implicit rel defs', 3 486 if $self->{no_implicit_rels}; 487 my $moniker14 = $monikers->{loader_test14}; 488 my $class14 = $classes->{loader_test14}; 489 my $rsobj14 = $conn->resultset($moniker14); 490 491 my $moniker15 = $monikers->{loader_test15}; 492 my $class15 = $classes->{loader_test15}; 493 my $rsobj15 = $conn->resultset($moniker15); 494 495 isa_ok( $rsobj14, "DBIx::Class::ResultSet" ); 496 isa_ok( $rsobj15, "DBIx::Class::ResultSet" ); 497 498 my $obj15 = $rsobj15->find(1); 499 isa_ok( $obj15->loader_test14, $class14 ); 500 } 501 } 502 503 # rescan test 504 SKIP: { 505 skip $self->{skip_rels}, 4 if $self->{skip_rels}; 506 507 my @statements_rescan = ( 508 qq{ 509 CREATE TABLE loader_test30 ( 510 id INTEGER NOT NULL PRIMARY KEY, 511 loader_test2 INTEGER NOT NULL, 512 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id) 513 ) $self->{innodb} 514 }, 515 q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(123, 1) }, 516 q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) }, 517 ); 518 519 { 520 my $dbh = $self->dbconnect(1); 521 $dbh->do($_) for @statements_rescan; 522 $dbh->disconnect; 523 } 524 525 my @new = do { 526 local $SIG{__WARN__} = sub {}; 527 $conn->rescan; 528 }; 529 is(scalar(@new), 1); 530 is($new[0], 'LoaderTest30'); 531 532 my $rsobj30 = $conn->resultset('LoaderTest30'); 533 isa_ok($rsobj30, 'DBIx::Class::ResultSet'); 534 my $obj30 = $rsobj30->find(123); 535 isa_ok( $obj30->loader_test2, $class2); 536 } 537} 538 539sub dbconnect { 540 my ($self, $complain) = @_; 541 542 my $dbh = DBI->connect( 543 $self->{dsn}, $self->{user}, 544 $self->{password}, 545 { 546 RaiseError => $complain, 547 PrintError => $complain, 548 AutoCommit => 1, 549 } 550 ); 551 if ($self->{dsn} =~ /^[^:]+:SQLite:/) { 552 $dbh->do ('PRAGMA synchronous = OFF'); 553 } 554 elsif ($self->{dsn} =~ /^[^:]+:Pg:/) { 555 $dbh->do ('SET client_min_messages=WARNING'); 556 } 557 558 die "Failed to connect to database: $DBI::errstr" if !$dbh; 559 560 return $dbh; 561} 562 563sub create { 564 my $self = shift; 565 566 $self->{_created} = 1; 567 568 my $make_auto_inc = $self->{auto_inc_cb} || sub {}; 569 my @statements = ( 570 qq{ 571 CREATE TABLE loader_test1 ( 572 id $self->{auto_inc_pk}, 573 dat VARCHAR(32) NOT NULL UNIQUE 574 ) $self->{innodb} 575 }, 576 $make_auto_inc->(qw/loader_test1 id/), 577 578 q{ INSERT INTO loader_test1 (dat) VALUES('foo') }, 579 q{ INSERT INTO loader_test1 (dat) VALUES('bar') }, 580 q{ INSERT INTO loader_test1 (dat) VALUES('baz') }, 581 582 qq{ 583 CREATE TABLE loader_test2 ( 584 id $self->{auto_inc_pk}, 585 dat VARCHAR(32) NOT NULL, 586 dat2 VARCHAR(32) NOT NULL, 587 UNIQUE (dat2, dat) 588 ) $self->{innodb} 589 }, 590 $make_auto_inc->(qw/loader_test2 id/), 591 592 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') }, 593 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') }, 594 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') }, 595 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') }, 596 597 qq{ 598 CREATE TABLE LOADER_TEST23 ( 599 ID INTEGER NOT NULL PRIMARY KEY, 600 DAT VARCHAR(32) NOT NULL UNIQUE 601 ) $self->{innodb} 602 }, 603 604 qq{ 605 CREATE TABLE LoAdEr_test24 ( 606 iD INTEGER NOT NULL PRIMARY KEY, 607 DaT VARCHAR(32) NOT NULL UNIQUE 608 ) $self->{innodb} 609 }, 610 ); 611 612 my @statements_reltests = ( 613 qq{ 614 CREATE TABLE loader_test3 ( 615 id INTEGER NOT NULL PRIMARY KEY, 616 dat VARCHAR(32) 617 ) $self->{innodb} 618 }, 619 620 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') }, 621 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') }, 622 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') }, 623 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') }, 624 625 qq{ 626 CREATE TABLE loader_test4 ( 627 id INTEGER NOT NULL PRIMARY KEY, 628 fkid INTEGER NOT NULL, 629 dat VARCHAR(32), 630 FOREIGN KEY( fkid ) REFERENCES loader_test3 (id) 631 ) $self->{innodb} 632 }, 633 634 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') }, 635 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') }, 636 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') }, 637 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') }, 638 639 qq{ 640 CREATE TABLE loader_test5 ( 641 id1 INTEGER NOT NULL, 642 iD2 INTEGER NOT NULL, 643 dat VARCHAR(8), 644 from_id INTEGER, 645 to_id INTEGER, 646 PRIMARY KEY (id1,id2), 647 FOREIGN KEY (from_id) REFERENCES loader_test4 (id), 648 FOREIGN KEY (to_id) REFERENCES loader_test4 (id) 649 ) $self->{innodb} 650 }, 651 652 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') }, 653 654 qq{ 655 CREATE TABLE loader_test6 ( 656 id INTEGER NOT NULL PRIMARY KEY, 657 Id2 INTEGER, 658 loader_test2 INTEGER, 659 dat VARCHAR(8), 660 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id), 661 FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2) 662 ) $self->{innodb} 663 }, 664 665 (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } . 666 q{ VALUES (1, 1,1,'aaa') }), 667 668 qq{ 669 CREATE TABLE loader_test7 ( 670 id INTEGER NOT NULL PRIMARY KEY, 671 id2 VARCHAR(8) NOT NULL UNIQUE, 672 dat VARCHAR(8) 673 ) $self->{innodb} 674 }, 675 676 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') }, 677 678 qq{ 679 CREATE TABLE loader_test8 ( 680 id INTEGER NOT NULL PRIMARY KEY, 681 loader_test7 VARCHAR(8) NOT NULL, 682 dat VARCHAR(8), 683 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2) 684 ) $self->{innodb} 685 }, 686 687 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } . 688 q{ VALUES (1,'aaa','bbb') }), 689 690 qq{ 691 CREATE TABLE loader_test9 ( 692 loader_test9 VARCHAR(8) NOT NULL 693 ) $self->{innodb} 694 }, 695 696 qq{ 697 CREATE TABLE loader_test16 ( 698 id INTEGER NOT NULL PRIMARY KEY, 699 dat VARCHAR(8) 700 ) $self->{innodb} 701 }, 702 703 qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') }, 704 qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') }, 705 qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') }, 706 707 qq{ 708 CREATE TABLE loader_test17 ( 709 id INTEGER NOT NULL PRIMARY KEY, 710 loader16_one INTEGER, 711 loader16_two INTEGER, 712 FOREIGN KEY (loader16_one) REFERENCES loader_test16 (id), 713 FOREIGN KEY (loader16_two) REFERENCES loader_test16 (id) 714 ) $self->{innodb} 715 }, 716 717 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (3, 2, 4) }, 718 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (33, 4, 6) }, 719 720 qq{ 721 CREATE TABLE loader_test18 ( 722 id INTEGER NOT NULL PRIMARY KEY, 723 dat VARCHAR(8) 724 ) $self->{innodb} 725 }, 726 727 qq{ INSERT INTO loader_test18 (id,dat) VALUES (1,'x18') }, 728 qq{ INSERT INTO loader_test18 (id,dat) VALUES (2,'y18') }, 729 qq{ INSERT INTO loader_test18 (id,dat) VALUES (3,'z18') }, 730 731 qq{ 732 CREATE TABLE loader_test19 ( 733 id INTEGER NOT NULL PRIMARY KEY, 734 dat VARCHAR(8) 735 ) $self->{innodb} 736 }, 737 738 qq{ INSERT INTO loader_test19 (id,dat) VALUES (4,'x19') }, 739 qq{ INSERT INTO loader_test19 (id,dat) VALUES (5,'y19') }, 740 qq{ INSERT INTO loader_test19 (id,dat) VALUES (6,'z19') }, 741 742 qq{ 743 CREATE TABLE loader_test20 ( 744 parent INTEGER NOT NULL, 745 child INTEGER NOT NULL, 746 PRIMARY KEY (parent, child), 747 FOREIGN KEY (parent) REFERENCES loader_test18 (id), 748 FOREIGN KEY (child) REFERENCES loader_test19 (id) 749 ) $self->{innodb} 750 }, 751 752 q{ INSERT INTO loader_test20 (parent, child) VALUES (1,4) }, 753 q{ INSERT INTO loader_test20 (parent, child) VALUES (2,5) }, 754 q{ INSERT INTO loader_test20 (parent, child) VALUES (3,6) }, 755 756 qq{ 757 CREATE TABLE loader_test21 ( 758 id INTEGER NOT NULL PRIMARY KEY, 759 dat VARCHAR(8) 760 ) $self->{innodb} 761 }, 762 763 q{ INSERT INTO loader_test21 (id,dat) VALUES (7,'a21')}, 764 q{ INSERT INTO loader_test21 (id,dat) VALUES (11,'b21')}, 765 q{ INSERT INTO loader_test21 (id,dat) VALUES (13,'c21')}, 766 q{ INSERT INTO loader_test21 (id,dat) VALUES (17,'d21')}, 767 768 qq{ 769 CREATE TABLE loader_test22 ( 770 parent INTEGER NOT NULL, 771 child INTEGER NOT NULL, 772 PRIMARY KEY (parent, child), 773 FOREIGN KEY (parent) REFERENCES loader_test21 (id), 774 FOREIGN KEY (child) REFERENCES loader_test21 (id) 775 ) $self->{innodb} 776 }, 777 778 q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)}, 779 q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)}, 780 q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)}, 781 782 qq{ 783 CREATE TABLE loader_test25 ( 784 id1 INTEGER NOT NULL, 785 id2 INTEGER NOT NULL, 786 dat VARCHAR(8), 787 PRIMARY KEY (id1,id2) 788 ) $self->{innodb} 789 }, 790 791 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,5,'x25') }, 792 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,7,'y25') }, 793 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (3,42,'z25') }, 794 795 qq{ 796 CREATE TABLE loader_test26 ( 797 id INTEGER NOT NULL PRIMARY KEY, 798 rel1 INTEGER NOT NULL, 799 rel2 INTEGER NOT NULL, 800 FOREIGN KEY (id, rel1) REFERENCES loader_test25 (id1, id2), 801 FOREIGN KEY (id, rel2) REFERENCES loader_test25 (id1, id2) 802 ) $self->{innodb} 803 }, 804 805 q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) }, 806 q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) }, 807 ); 808 809 my @statements_advanced = ( 810 qq{ 811 CREATE TABLE loader_test10 ( 812 id10 $self->{auto_inc_pk}, 813 subject VARCHAR(8), 814 loader_test11 INTEGER 815 ) $self->{innodb} 816 }, 817 $make_auto_inc->(qw/loader_test10 id10/), 818 819 qq{ 820 CREATE TABLE loader_test11 ( 821 id11 $self->{auto_inc_pk}, 822 message VARCHAR(8) DEFAULT 'foo', 823 loader_test10 INTEGER, 824 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10) 825 ) $self->{innodb} 826 }, 827 $make_auto_inc->(qw/loader_test11 id11/), 828 829 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } . 830 q{ loader_test11_fk FOREIGN KEY (loader_test11) } . 831 q{ REFERENCES loader_test11 (id11) }), 832 ); 833 834 my @statements_inline_rels = ( 835 qq{ 836 CREATE TABLE loader_test12 ( 837 id INTEGER NOT NULL PRIMARY KEY, 838 id2 VARCHAR(8) NOT NULL UNIQUE, 839 dat VARCHAR(8) NOT NULL UNIQUE 840 ) $self->{innodb} 841 }, 842 843 q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') }, 844 845 qq{ 846 CREATE TABLE loader_test13 ( 847 id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12, 848 loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2), 849 dat VARCHAR(8) REFERENCES loader_test12 (dat) 850 ) $self->{innodb} 851 }, 852 853 (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } . 854 q{ VALUES (1,'aaa','bbb') }), 855 ); 856 857 858 my @statements_implicit_rels = ( 859 qq{ 860 CREATE TABLE loader_test14 ( 861 id INTEGER NOT NULL PRIMARY KEY, 862 dat VARCHAR(8) 863 ) $self->{innodb} 864 }, 865 866 q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') }, 867 868 qq{ 869 CREATE TABLE loader_test15 ( 870 id INTEGER NOT NULL PRIMARY KEY, 871 loader_test14 INTEGER NOT NULL, 872 FOREIGN KEY (loader_test14) REFERENCES loader_test14 873 ) $self->{innodb} 874 }, 875 876 q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) }, 877 ); 878 879 $self->drop_tables; 880 881 my $dbh = $self->dbconnect(1); 882 883 $dbh->do($_) for (@statements); 884 unless($self->{skip_rels}) { 885 # hack for now, since DB2 doesn't like inline comments, and we need 886 # to test one for mysql, which works on everyone else... 887 # this all needs to be refactored anyways. 888 $dbh->do($_) for (@statements_reltests); 889 unless($self->{vendor} =~ /sqlite/i) { 890 $dbh->do($_) for (@statements_advanced); 891 } 892 unless($self->{no_inline_rels}) { 893 $dbh->do($_) for (@statements_inline_rels); 894 } 895 unless($self->{no_implicit_rels}) { 896 $dbh->do($_) for (@statements_implicit_rels); 897 } 898 } 899 $dbh->disconnect(); 900} 901 902sub drop_tables { 903 my $self = shift; 904 905 my @tables = qw/ 906 loader_test1 907 loader_test2 908 LOADER_TEST23 909 LoAdEr_test24 910 /; 911 912 my @tables_auto_inc = ( 913 [ qw/loader_test1 id/ ], 914 [ qw/loader_test2 id/ ], 915 ); 916 917 my @tables_reltests = qw/ 918 loader_test4 919 loader_test3 920 loader_test6 921 loader_test5 922 loader_test8 923 loader_test7 924 loader_test9 925 loader_test17 926 loader_test16 927 loader_test20 928 loader_test19 929 loader_test18 930 loader_test22 931 loader_test21 932 loader_test26 933 loader_test25 934 /; 935 936 my @tables_advanced = qw/ 937 loader_test11 938 loader_test10 939 /; 940 941 my @tables_advanced_auto_inc = ( 942 [ qw/loader_test10 id10/ ], 943 [ qw/loader_test11 id11/ ], 944 ); 945 946 my @tables_inline_rels = qw/ 947 loader_test13 948 loader_test12 949 /; 950 951 my @tables_implicit_rels = qw/ 952 loader_test15 953 loader_test14 954 /; 955 956 my @tables_rescan = qw/ loader_test30 /; 957 958 my $drop_fk_mysql = 959 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk}; 960 961 my $drop_fk = 962 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk}; 963 964 my $dbh = $self->dbconnect(0); 965 966 my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; 967 968 unless($self->{skip_rels}) { 969 $dbh->do("DROP TABLE $_") for (@tables_reltests); 970 unless($self->{vendor} =~ /sqlite/i) { 971 if($self->{vendor} =~ /mysql/i) { 972 $dbh->do($drop_fk_mysql); 973 } 974 else { 975 $dbh->do($drop_fk); 976 } 977 $dbh->do("DROP TABLE $_") for (@tables_advanced); 978 $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc; 979 } 980 unless($self->{no_inline_rels}) { 981 $dbh->do("DROP TABLE $_") for (@tables_inline_rels); 982 } 983 unless($self->{no_implicit_rels}) { 984 $dbh->do("DROP TABLE $_") for (@tables_implicit_rels); 985 } 986 $dbh->do("DROP TABLE $_") for (@tables_rescan); 987 } 988 $dbh->do("DROP TABLE $_") for (@tables); 989 $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc; 990 $dbh->disconnect; 991} 992 993sub DESTROY { 994 my $self = shift; 995 $self->drop_tables if $self->{_created}; 996} 997 9981; 999