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