1package dbixcsl_common_tests; 2 3use strict; 4use warnings; 5 6use Test::More; 7use DBIx::Class::Schema::Loader; 8use Class::Unload; 9use File::Path; 10use DBI; 11use Digest::MD5; 12use File::Find 'find'; 13 14my $DUMP_DIR = './t/_common_dump'; 15rmtree $DUMP_DIR; 16 17sub new { 18 my $class = shift; 19 20 my $self; 21 22 if( ref($_[0]) eq 'HASH') { 23 my $args = shift; 24 $self = { (%$args) }; 25 } 26 else { 27 $self = { @_ }; 28 } 29 30 # Only MySQL uses this 31 $self->{innodb} ||= ''; 32 33 # DB2 doesn't support this 34 $self->{null} = 'NULL' unless defined $self->{null}; 35 36 $self->{verbose} = $ENV{TEST_VERBOSE} || 0; 37 38 # Optional extra tables and tests 39 $self->{extra} ||= {}; 40 41 # Not all DBS do SQL-standard CURRENT_TIMESTAMP 42 $self->{default_function} ||= "CURRENT_TIMESTAMP"; 43 $self->{default_function_def} ||= "TIMESTAMP DEFAULT $self->{default_function}"; 44 45 return bless $self => $class; 46} 47 48sub skip_tests { 49 my ($self, $why) = @_; 50 51 plan skip_all => $why; 52} 53 54sub _monikerize { 55 my $name = shift; 56 return 'LoaderTest2X' if $name =~ /^loader_test2$/i; 57 return undef; 58} 59 60sub _custom_column_info { 61 my ( $table_name, $column_name, $column_info ) = @_; 62 63 $table_name = lc ( $table_name ); 64 $column_name = lc ( $column_name ); 65 66 if ( $table_name eq 'loader_test11' 67 and $column_name eq 'loader_test10' 68 ){ 69 return { is_numeric => 1 } 70 } 71 # Set inflate_datetime or inflate_date to check 72 # datetime_timezone and datetime_locale 73 if ( $table_name eq 'loader_test36' ){ 74 return { inflate_datetime => 1 } if 75 ( $column_name eq 'b_char_as_data' ); 76 return { inflate_date => 1 } if 77 ( $column_name eq 'c_char_as_data' ); 78 } 79 80 return; 81} 82 83sub run_tests { 84 my $self = shift; 85 86 plan tests => 156 + ($self->{extra}->{count} || 0); 87 88 $self->create(); 89 90 my @connect_info = ( 91 $self->{dsn}, 92 $self->{user}, 93 $self->{password}, 94 $self->{connect_info_opts}, 95 ); 96 97 # First, with in-memory classes 98 my $schema_class = $self->setup_schema(@connect_info); 99 $self->test_schema($schema_class); 100 $self->drop_tables; 101} 102 103# defined in sub create 104my (@statements, @statements_reltests, @statements_advanced, 105 @statements_advanced_sqlite, @statements_inline_rels, 106 @statements_implicit_rels); 107 108sub setup_schema { 109 my $self = shift; 110 my @connect_info = @_; 111 112 my $schema_class = 'DBIXCSL_Test::Schema'; 113 114 my $debug = ($self->{verbose} > 1) ? 1 : 0; 115 116 my %loader_opts = ( 117 constraint => 118 qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_)?loader_test[0-9]+(?!.*_)/i, 119 relationships => 1, 120 additional_classes => 'TestAdditional', 121 additional_base_classes => 'TestAdditionalBase', 122 left_base_classes => [ qw/TestLeftBase/ ], 123 components => [ qw/TestComponent/ ], 124 resultset_components => [ qw/TestRSComponent/ ], 125 inflect_plural => { loader_test4 => 'loader_test4zes' }, 126 inflect_singular => { fkid => 'fkid_singular' }, 127 moniker_map => \&_monikerize, 128 custom_column_info => \&_custom_column_info, 129 debug => $debug, 130 use_namespaces => 0, 131 dump_directory => $DUMP_DIR, 132 datetime_timezone => 'Europe/Berlin', 133 datetime_locale => 'de_DE' 134 ); 135 136 $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; 137 138 { 139 my @loader_warnings; 140 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; 141 eval qq{ 142 package $schema_class; 143 use base qw/DBIx::Class::Schema::Loader/; 144 145 __PACKAGE__->loader_options(\%loader_opts); 146 __PACKAGE__->connection(\@connect_info); 147 }; 148 149 ok(!$@, "Loader initialization") or diag $@; 150 151 my $file_count; 152 find sub { return if -d; $file_count++ }, $DUMP_DIR; 153 154 my $expected_count = 36; 155 156 $expected_count += grep /CREATE (?:TABLE|VIEW)/i, 157 @{ $self->{extra}{create} || [] }; 158 159 $expected_count -= grep /CREATE TABLE/, @statements_inline_rels 160 if $self->{skip_rels} || $self->{no_inline_rels}; 161 162 $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels 163 if $self->{skip_rels} || $self->{no_implicit_rels}; 164 165 $expected_count -= grep /CREATE TABLE/, ($self->{vendor} =~ /sqlite/ ? @statements_advanced_sqlite : @statements_advanced), @statements_reltests 166 if $self->{skip_rels}; 167 168 is $file_count, $expected_count, 'correct number of files generated'; 169 170 exit if $file_count != $expected_count; 171 172 my $warn_count = 2; 173 $warn_count++ if grep /ResultSetManager/, @loader_warnings; 174 175 $warn_count++ for grep /^Bad table or view/, @loader_warnings; 176 177 $warn_count++ for grep /stripping trailing _id/, @loader_warnings; 178 179 my $vendor = $self->{vendor}; 180 $warn_count++ for grep /${vendor}_\S+ has no primary key/, 181 @loader_warnings; 182 183 if($self->{skip_rels}) { 184 SKIP: { 185 is(scalar(@loader_warnings), $warn_count, "No loader warnings") 186 or diag @loader_warnings; 187 skip "No missing PK warnings without rels", 1; 188 } 189 } 190 else { 191 $warn_count++; 192 is(scalar(@loader_warnings), $warn_count, "Expected loader warning") 193 or diag @loader_warnings; 194 is(grep(/loader_test9 has no primary key/, @loader_warnings), 1, 195 "Missing PK warning"); 196 } 197 } 198 199 return $schema_class; 200} 201 202sub test_schema { 203 my $self = shift; 204 my $schema_class = shift; 205 206 my $conn = $schema_class->clone; 207 my $monikers = {}; 208 my $classes = {}; 209 foreach my $source_name ($schema_class->sources) { 210 my $table_name = $schema_class->source($source_name)->from; 211 $monikers->{$table_name} = $source_name; 212 $classes->{$table_name} = $schema_class . q{::} . $source_name; 213 } 214 215 my $moniker1 = $monikers->{loader_test1s}; 216 my $class1 = $classes->{loader_test1s}; 217 my $rsobj1 = $conn->resultset($moniker1); 218 check_no_duplicate_unique_constraints($class1); 219 220 my $moniker2 = $monikers->{loader_test2}; 221 my $class2 = $classes->{loader_test2}; 222 my $rsobj2 = $conn->resultset($moniker2); 223 check_no_duplicate_unique_constraints($class2); 224 225 my $moniker23 = $monikers->{LOADER_TEST23}; 226 my $class23 = $classes->{LOADER_TEST23}; 227 my $rsobj23 = $conn->resultset($moniker1); 228 229 my $moniker24 = $monikers->{LoAdEr_test24}; 230 my $class24 = $classes->{LoAdEr_test24}; 231 my $rsobj24 = $conn->resultset($moniker2); 232 233 my $moniker35 = $monikers->{loader_test35}; 234 my $class35 = $classes->{loader_test35}; 235 my $rsobj35 = $conn->resultset($moniker35); 236 237 isa_ok( $rsobj1, "DBIx::Class::ResultSet" ); 238 isa_ok( $rsobj2, "DBIx::Class::ResultSet" ); 239 isa_ok( $rsobj23, "DBIx::Class::ResultSet" ); 240 isa_ok( $rsobj24, "DBIx::Class::ResultSet" ); 241 isa_ok( $rsobj35, "DBIx::Class::ResultSet" ); 242 243 my @columns_lt2 = $class2->columns; 244 is_deeply( \@columns_lt2, [ qw/id dat dat2/ ], "Column Ordering" ); 245 246 my %uniq1 = $class1->unique_constraints; 247 my $uniq1_test = 0; 248 foreach my $ucname (keys %uniq1) { 249 my $cols_arrayref = $uniq1{$ucname}; 250 if(@$cols_arrayref == 1 && $cols_arrayref->[0] eq 'dat') { 251 $uniq1_test = 1; 252 last; 253 } 254 } 255 ok($uniq1_test, "Unique constraint"); 256 257 is($moniker1, 'LoaderTest1', 'moniker singularisation'); 258 259 my %uniq2 = $class2->unique_constraints; 260 my $uniq2_test = 0; 261 foreach my $ucname (keys %uniq2) { 262 my $cols_arrayref = $uniq2{$ucname}; 263 if(@$cols_arrayref == 2 264 && $cols_arrayref->[0] eq 'dat2' 265 && $cols_arrayref->[1] eq 'dat') { 266 $uniq2_test = 2; 267 last; 268 } 269 } 270 ok($uniq2_test, "Multi-col unique constraint"); 271 272 is($moniker2, 'LoaderTest2X', "moniker_map testing"); 273 274 SKIP: { 275 can_ok( $class1, 'test_additional_base' ) 276 or skip "Pre-requisite test failed", 1; 277 is( $class1->test_additional_base, "test_additional_base", 278 "Additional Base method" ); 279 } 280 281 SKIP: { 282 can_ok( $class1, 'test_additional_base_override' ) 283 or skip "Pre-requisite test failed", 1; 284 is( $class1->test_additional_base_override, 285 "test_left_base_override", 286 "Left Base overrides Additional Base method" ); 287 } 288 289 SKIP: { 290 can_ok( $class1, 'test_additional_base_additional' ) 291 or skip "Pre-requisite test failed", 1; 292 is( $class1->test_additional_base_additional, "test_additional", 293 "Additional Base can use Additional package method" ); 294 } 295 296 SKIP: { 297 can_ok( $class1, 'dbix_class_testcomponent' ) 298 or skip "Pre-requisite test failed", 1; 299 is( $class1->dbix_class_testcomponent, 300 'dbix_class_testcomponent works', 301 'Additional Component' ); 302 } 303 304 SKIP: { 305 can_ok($rsobj1, 'dbix_class_testrscomponent') 306 or skip "Pre-requisite test failed", 1; 307 is( $rsobj1->dbix_class_testrscomponent, 308 'dbix_class_testrscomponent works', 309 'ResultSet component' ); 310 } 311 312 SKIP: { 313 can_ok( $class1, 'loader_test1_classmeth' ) 314 or skip "Pre-requisite test failed", 1; 315 is( $class1->loader_test1_classmeth, 'all is well', 'Class method' ); 316 } 317 318 SKIP: { 319 can_ok( $rsobj1, 'loader_test1_rsmeth' ) 320 or skip "Pre-requisite test failed"; 321 is( $rsobj1->loader_test1_rsmeth, 'all is still well', 'Result set method' ); 322 } 323 324 ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_incrment detection' ); 325 326 my $obj = $rsobj1->find(1); 327 is( $obj->id, 1, "Find got the right row" ); 328 is( $obj->dat, "foo", "Column value" ); 329 is( $rsobj2->count, 4, "Count" ); 330 my $saved_id; 331 eval { 332 my $new_obj1 = $rsobj1->create({ dat => 'newthing' }); 333 $saved_id = $new_obj1->id; 334 }; 335 ok(!$@, "Inserting new record using a PK::Auto key didn't die") or diag $@; 336 ok($saved_id, "Got PK::Auto-generated id"); 337 338 my $new_obj1 = $rsobj1->search({ dat => 'newthing' })->first; 339 ok($new_obj1, "Found newly inserted PK::Auto record"); 340 is($new_obj1->id, $saved_id, "Correct PK::Auto-generated id"); 341 342 my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first; 343 is( $obj2->id, 2 ); 344 345 is( 346 $class35->column_info('a_varchar')->{default_value}, 'foo', 347 'constant character default', 348 ); 349 350 is( 351 $class35->column_info('an_int')->{default_value}, 42, 352 'constant integer default', 353 ); 354 355 is( 356 $class35->column_info('a_double')->{default_value}, 10.555, 357 'constant numeric default', 358 ); 359 360 my $function_default = $class35->column_info('a_function')->{default_value}; 361 362 isa_ok( $function_default, 'SCALAR', 'default_value for function default' ); 363 is_deeply( 364 $function_default, \$self->{default_function}, 365 'default_value for function default is correct' 366 ); 367 368 SKIP: { 369 skip $self->{skip_rels}, 96 if $self->{skip_rels}; 370 371 my $moniker3 = $monikers->{loader_test3}; 372 my $class3 = $classes->{loader_test3}; 373 my $rsobj3 = $conn->resultset($moniker3); 374 375 my $moniker4 = $monikers->{loader_test4}; 376 my $class4 = $classes->{loader_test4}; 377 my $rsobj4 = $conn->resultset($moniker4); 378 379 my $moniker5 = $monikers->{loader_test5}; 380 my $class5 = $classes->{loader_test5}; 381 my $rsobj5 = $conn->resultset($moniker5); 382 383 my $moniker6 = $monikers->{loader_test6}; 384 my $class6 = $classes->{loader_test6}; 385 my $rsobj6 = $conn->resultset($moniker6); 386 387 my $moniker7 = $monikers->{loader_test7}; 388 my $class7 = $classes->{loader_test7}; 389 my $rsobj7 = $conn->resultset($moniker7); 390 391 my $moniker8 = $monikers->{loader_test8}; 392 my $class8 = $classes->{loader_test8}; 393 my $rsobj8 = $conn->resultset($moniker8); 394 395 my $moniker9 = $monikers->{loader_test9}; 396 my $class9 = $classes->{loader_test9}; 397 my $rsobj9 = $conn->resultset($moniker9); 398 399 my $moniker16 = $monikers->{loader_test16}; 400 my $class16 = $classes->{loader_test16}; 401 my $rsobj16 = $conn->resultset($moniker16); 402 403 my $moniker17 = $monikers->{loader_test17}; 404 my $class17 = $classes->{loader_test17}; 405 my $rsobj17 = $conn->resultset($moniker17); 406 407 my $moniker18 = $monikers->{loader_test18}; 408 my $class18 = $classes->{loader_test18}; 409 my $rsobj18 = $conn->resultset($moniker18); 410 411 my $moniker19 = $monikers->{loader_test19}; 412 my $class19 = $classes->{loader_test19}; 413 my $rsobj19 = $conn->resultset($moniker19); 414 415 my $moniker20 = $monikers->{loader_test20}; 416 my $class20 = $classes->{loader_test20}; 417 my $rsobj20 = $conn->resultset($moniker20); 418 419 my $moniker21 = $monikers->{loader_test21}; 420 my $class21 = $classes->{loader_test21}; 421 my $rsobj21 = $conn->resultset($moniker21); 422 423 my $moniker22 = $monikers->{loader_test22}; 424 my $class22 = $classes->{loader_test22}; 425 my $rsobj22 = $conn->resultset($moniker22); 426 427 my $moniker25 = $monikers->{loader_test25}; 428 my $class25 = $classes->{loader_test25}; 429 my $rsobj25 = $conn->resultset($moniker25); 430 431 my $moniker26 = $monikers->{loader_test26}; 432 my $class26 = $classes->{loader_test26}; 433 my $rsobj26 = $conn->resultset($moniker26); 434 435 my $moniker27 = $monikers->{loader_test27}; 436 my $class27 = $classes->{loader_test27}; 437 my $rsobj27 = $conn->resultset($moniker27); 438 439 my $moniker28 = $monikers->{loader_test28}; 440 my $class28 = $classes->{loader_test28}; 441 my $rsobj28 = $conn->resultset($moniker28); 442 443 my $moniker29 = $monikers->{loader_test29}; 444 my $class29 = $classes->{loader_test29}; 445 my $rsobj29 = $conn->resultset($moniker29); 446 447 my $moniker31 = $monikers->{loader_test31}; 448 my $class31 = $classes->{loader_test31}; 449 my $rsobj31 = $conn->resultset($moniker31); 450 451 my $moniker32 = $monikers->{loader_test32}; 452 my $class32 = $classes->{loader_test32}; 453 my $rsobj32 = $conn->resultset($moniker32); 454 455 my $moniker33 = $monikers->{loader_test33}; 456 my $class33 = $classes->{loader_test33}; 457 my $rsobj33 = $conn->resultset($moniker33); 458 459 my $moniker34 = $monikers->{loader_test34}; 460 my $class34 = $classes->{loader_test34}; 461 my $rsobj34 = $conn->resultset($moniker34); 462 463 my $moniker36 = $monikers->{loader_test36}; 464 my $class36 = $classes->{loader_test36}; 465 my $rsobj36 = $conn->resultset($moniker36); 466 467 isa_ok( $rsobj3, "DBIx::Class::ResultSet" ); 468 isa_ok( $rsobj4, "DBIx::Class::ResultSet" ); 469 isa_ok( $rsobj5, "DBIx::Class::ResultSet" ); 470 isa_ok( $rsobj6, "DBIx::Class::ResultSet" ); 471 isa_ok( $rsobj7, "DBIx::Class::ResultSet" ); 472 isa_ok( $rsobj8, "DBIx::Class::ResultSet" ); 473 isa_ok( $rsobj9, "DBIx::Class::ResultSet" ); 474 isa_ok( $rsobj16, "DBIx::Class::ResultSet" ); 475 isa_ok( $rsobj17, "DBIx::Class::ResultSet" ); 476 isa_ok( $rsobj18, "DBIx::Class::ResultSet" ); 477 isa_ok( $rsobj19, "DBIx::Class::ResultSet" ); 478 isa_ok( $rsobj20, "DBIx::Class::ResultSet" ); 479 isa_ok( $rsobj21, "DBIx::Class::ResultSet" ); 480 isa_ok( $rsobj22, "DBIx::Class::ResultSet" ); 481 isa_ok( $rsobj25, "DBIx::Class::ResultSet" ); 482 isa_ok( $rsobj26, "DBIx::Class::ResultSet" ); 483 isa_ok( $rsobj27, "DBIx::Class::ResultSet" ); 484 isa_ok( $rsobj28, "DBIx::Class::ResultSet" ); 485 isa_ok( $rsobj29, "DBIx::Class::ResultSet" ); 486 isa_ok( $rsobj31, "DBIx::Class::ResultSet" ); 487 isa_ok( $rsobj32, "DBIx::Class::ResultSet" ); 488 isa_ok( $rsobj33, "DBIx::Class::ResultSet" ); 489 isa_ok( $rsobj34, "DBIx::Class::ResultSet" ); 490 isa_ok( $rsobj36, "DBIx::Class::ResultSet" ); 491 492 # basic rel test 493 my $obj4 = $rsobj4->find(123); 494 isa_ok( $obj4->fkid_singular, $class3); 495 496 ok($class4->column_info('fkid')->{is_foreign_key}, 'Foreign key detected'); 497 498 my $obj3 = $rsobj3->find(1); 499 my $rs_rel4 = $obj3->search_related('loader_test4zes'); 500 isa_ok( $rs_rel4->first, $class4); 501 502 # find on multi-col pk 503 my $obj5 = 504 eval { $rsobj5->find({id1 => 1, iD2 => 1}) } || 505 eval { $rsobj5->find({id1 => 1, id2 => 1}) }; 506 die $@ if $@; 507 508 is( $obj5->id2, 1, "Find on multi-col PK" ); 509 510 # mulit-col fk def 511 my $obj6 = $rsobj6->find(1); 512 isa_ok( $obj6->loader_test2, $class2); 513 isa_ok( $obj6->loader_test5, $class5); 514 515 ok($class6->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected'); 516 ok($class6->column_info('id')->{is_foreign_key}, 'Foreign key detected'); 517 518 my $id2_info = eval { $class6->column_info('id2') } || 519 $class6->column_info('Id2'); 520 ok($id2_info->{is_foreign_key}, 'Foreign key detected'); 521 522 # fk that references a non-pk key (UNIQUE) 523 my $obj8 = $rsobj8->find(1); 524 isa_ok( $obj8->loader_test7, $class7); 525 526 ok($class8->column_info('loader_test7')->{is_foreign_key}, 'Foreign key detected'); 527 528 # test double-fk 17 ->-> 16 529 my $obj17 = $rsobj17->find(33); 530 531 my $rs_rel16_one = $obj17->loader16_one; 532 isa_ok($rs_rel16_one, $class16); 533 is($rs_rel16_one->dat, 'y16', "Multiple FKs to same table"); 534 535 ok($class17->column_info('loader16_one')->{is_foreign_key}, 'Foreign key detected'); 536 537 my $rs_rel16_two = $obj17->loader16_two; 538 isa_ok($rs_rel16_two, $class16); 539 is($rs_rel16_two->dat, 'z16', "Multiple FKs to same table"); 540 541 ok($class17->column_info('loader16_two')->{is_foreign_key}, 'Foreign key detected'); 542 543 my $obj16 = $rsobj16->find(2); 544 my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones'); 545 isa_ok($rs_rel17->first, $class17); 546 is($rs_rel17->first->id, 3, "search_related with multiple FKs from same table"); 547 548 # XXX test m:m 18 <- 20 -> 19 549 ok($class20->column_info('parent')->{is_foreign_key}, 'Foreign key detected'); 550 ok($class20->column_info('child')->{is_foreign_key}, 'Foreign key detected'); 551 552 # XXX test double-fk m:m 21 <- 22 -> 21 553 ok($class22->column_info('parent')->{is_foreign_key}, 'Foreign key detected'); 554 ok($class22->column_info('child')->{is_foreign_key}, 'Foreign key detected'); 555 556 # test double multi-col fk 26 -> 25 557 my $obj26 = $rsobj26->find(33); 558 559 my $rs_rel25_one = $obj26->loader_test25_id_rel1; 560 isa_ok($rs_rel25_one, $class25); 561 is($rs_rel25_one->dat, 'x25', "Multiple multi-col FKs to same table"); 562 563 ok($class26->column_info('id')->{is_foreign_key}, 'Foreign key detected'); 564 ok($class26->column_info('rel1')->{is_foreign_key}, 'Foreign key detected'); 565 ok($class26->column_info('rel2')->{is_foreign_key}, 'Foreign key detected'); 566 567 my $rs_rel25_two = $obj26->loader_test25_id_rel2; 568 isa_ok($rs_rel25_two, $class25); 569 is($rs_rel25_two->dat, 'y25', "Multiple multi-col FKs to same table"); 570 571 my $obj25 = $rsobj25->find(3,42); 572 my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s'); 573 isa_ok($rs_rel26->first, $class26); 574 is($rs_rel26->first->id, 3, "search_related with multiple multi-col FKs from same table"); 575 576 # test one-to-one rels 577 my $obj27 = $rsobj27->find(1); 578 my $obj28 = $obj27->loader_test28; 579 isa_ok($obj28, $class28); 580 is($obj28->get_column('id'), 1, "One-to-one relationship with PRIMARY FK"); 581 582 ok($class28->column_info('id')->{is_foreign_key}, 'Foreign key detected'); 583 584 my $obj29 = $obj27->loader_test29; 585 isa_ok($obj29, $class29); 586 is($obj29->id, 1, "One-to-one relationship with UNIQUE FK"); 587 588 ok($class29->column_info('fk')->{is_foreign_key}, 'Foreign key detected'); 589 590 $obj27 = $rsobj27->find(2); 591 is($obj27->loader_test28, undef, "Undef for missing one-to-one row"); 592 is($obj27->loader_test29, undef, "Undef for missing one-to-one row"); 593 594 # test outer join for nullable referring columns: 595 SKIP: { 596 skip "unreliable column info from db driver",11 unless 597 ($class32->column_info('rel2')->{is_nullable}); 598 599 ok($class32->column_info('rel1')->{is_foreign_key}, 'Foreign key detected'); 600 ok($class32->column_info('rel2')->{is_foreign_key}, 'Foreign key detected'); 601 602 my $obj32 = $rsobj32->find(1,{prefetch=>[qw/rel1 rel2/]}); 603 my $obj34 = $rsobj34->find( 604 1,{prefetch=>[qw/loader_test33_id_rel1 loader_test33_id_rel2/]} 605 ); 606 my $skip_outerjoin; 607 isa_ok($obj32,$class32) or $skip_outerjoin = 1; 608 isa_ok($obj34,$class34) or $skip_outerjoin = 1; 609 610 ok($class34->column_info('id')->{is_foreign_key}, 'Foreign key detected'); 611 ok($class34->column_info('rel1')->{is_foreign_key}, 'Foreign key detected'); 612 ok($class34->column_info('rel2')->{is_foreign_key}, 'Foreign key detected'); 613 614 SKIP: { 615 skip "Pre-requisite test failed", 4 if $skip_outerjoin; 616 my $rs_rel31_one = $obj32->rel1; 617 my $rs_rel31_two = $obj32->rel2; 618 isa_ok($rs_rel31_one, $class31); 619 is($rs_rel31_two, undef); 620 621 my $rs_rel33_one = $obj34->loader_test33_id_rel1; 622 my $rs_rel33_two = $obj34->loader_test33_id_rel2; 623 624 isa_ok($rs_rel33_one,$class33); 625 is($rs_rel33_two, undef); 626 627 } 628 } 629 630 # from Chisel's tests... 631 my $moniker10 = $monikers->{loader_test10}; 632 my $class10 = $classes->{loader_test10}; 633 my $rsobj10 = $conn->resultset($moniker10); 634 635 my $moniker11 = $monikers->{loader_test11}; 636 my $class11 = $classes->{loader_test11}; 637 my $rsobj11 = $conn->resultset($moniker11); 638 639 isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); 640 isa_ok( $rsobj11, "DBIx::Class::ResultSet" ); 641 642 ok($class10->column_info('loader_test11')->{is_foreign_key}, 'Foreign key detected'); 643 ok($class11->column_info('loader_test10')->{is_foreign_key}, 'Foreign key detected'); 644 645 # Added by custom_column_info 646 ok($class11->column_info('loader_test10')->{is_numeric}, 'custom_column_info'); 647 648 is($class36->column_info('a_date')->{locale},'de_DE','datetime_locale'); 649 is($class36->column_info('a_date')->{timezone},'Europe/Berlin','datetime_timezone'); 650 651 ok($class36->column_info('b_char_as_data')->{inflate_datetime},'custom_column_info'); 652 is($class36->column_info('b_char_as_data')->{locale},'de_DE','datetime_locale'); 653 is($class36->column_info('b_char_as_data')->{timezone},'Europe/Berlin','datetime_timezone'); 654 655 ok($class36->column_info('c_char_as_data')->{inflate_date},'custom_column_info'); 656 is($class36->column_info('c_char_as_data')->{locale},'de_DE','datetime_locale'); 657 is($class36->column_info('c_char_as_data')->{timezone},'Europe/Berlin','datetime_timezone'); 658 659 my $obj10 = $rsobj10->create({ subject => 'xyzzy' }); 660 661 $obj10->update(); 662 ok( defined $obj10, 'Create row' ); 663 664 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() }); 665 $obj11->update(); 666 ok( defined $obj11, 'Create related row' ); 667 668 eval { 669 my $obj10_2 = $obj11->loader_test10; 670 $obj10_2->loader_test11( $obj11->id11() ); 671 $obj10_2->update(); 672 }; 673 ok(!$@, "Setting up circular relationship"); 674 675 SKIP: { 676 skip 'Previous eval block failed', 3 if $@; 677 678 my $results = $rsobj10->search({ subject => 'xyzzy' }); 679 is( $results->count(), 1, 'No duplicate row created' ); 680 681 my $obj10_3 = $results->first(); 682 isa_ok( $obj10_3, $class10 ); 683 is( $obj10_3->loader_test11()->id(), $obj11->id(), 684 'Circular rel leads back to same row' ); 685 } 686 687 SKIP: { 688 skip 'This vendor cannot do inline relationship definitions', 9 689 if $self->{no_inline_rels}; 690 691 my $moniker12 = $monikers->{loader_test12}; 692 my $class12 = $classes->{loader_test12}; 693 my $rsobj12 = $conn->resultset($moniker12); 694 695 my $moniker13 = $monikers->{loader_test13}; 696 my $class13 = $classes->{loader_test13}; 697 my $rsobj13 = $conn->resultset($moniker13); 698 699 isa_ok( $rsobj12, "DBIx::Class::ResultSet" ); 700 isa_ok( $rsobj13, "DBIx::Class::ResultSet" ); 701 702 ok($class13->column_info('id')->{is_foreign_key}, 'Foreign key detected'); 703 ok($class13->column_info('loader_test12')->{is_foreign_key}, 'Foreign key detected'); 704 ok($class13->column_info('dat')->{is_foreign_key}, 'Foreign key detected'); 705 706 my $obj13 = $rsobj13->find(1); 707 isa_ok( $obj13->id, $class12 ); 708 isa_ok( $obj13->loader_test12, $class12); 709 isa_ok( $obj13->dat, $class12); 710 711 my $obj12 = $rsobj12->find(1); 712 isa_ok( $obj12->loader_test13, $class13 ); 713 } 714 715 SKIP: { 716 skip 'This vendor cannot do out-of-line implicit rel defs', 4 717 if $self->{no_implicit_rels}; 718 my $moniker14 = $monikers->{loader_test14}; 719 my $class14 = $classes->{loader_test14}; 720 my $rsobj14 = $conn->resultset($moniker14); 721 722 my $moniker15 = $monikers->{loader_test15}; 723 my $class15 = $classes->{loader_test15}; 724 my $rsobj15 = $conn->resultset($moniker15); 725 726 isa_ok( $rsobj14, "DBIx::Class::ResultSet" ); 727 isa_ok( $rsobj15, "DBIx::Class::ResultSet" ); 728 729 ok($class15->column_info('loader_test14')->{is_foreign_key}, 'Foreign key detected'); 730 731 my $obj15 = $rsobj15->find(1); 732 isa_ok( $obj15->loader_test14, $class14 ); 733 } 734 } 735 736 # rescan and norewrite test 737 SKIP: { 738 my @statements_rescan = ( 739 qq{ 740 CREATE TABLE loader_test30 ( 741 id INTEGER NOT NULL PRIMARY KEY, 742 loader_test2 INTEGER NOT NULL, 743 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id) 744 ) $self->{innodb} 745 }, 746 q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(123, 1) }, 747 q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) }, 748 ); 749 750 # get md5 751 my $digest = Digest::MD5->new; 752 753 my $find_cb = sub { 754 return if -d; 755 return if $_ eq 'LoaderTest30.pm'; 756 757 open my $fh, '<', $_ or die "Could not open $_ for reading: $!"; 758 binmode $fh; 759 $digest->addfile($fh); 760 }; 761 762 find $find_cb, $DUMP_DIR; 763 764 my $before_digest = $digest->digest; 765 766 my $dbh = $self->dbconnect(1); 767 768 { 769 # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." 770 local $SIG{__WARN__} = sub { 771 my $msg = shift; 772 print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; 773 }; 774 775 $dbh->do($_) for @statements_rescan; 776 } 777 778 $dbh->disconnect; 779 780 sleep 1; 781 782 my @new = do { 783 # kill the 'Dumping manual schema' warnings 784 local $SIG{__WARN__} = sub {}; 785 $conn->rescan; 786 }; 787 is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan"); 788 789 $digest = Digest::MD5->new; 790 find $find_cb, $DUMP_DIR; 791 my $after_digest = $digest->digest; 792 793 is $before_digest, $after_digest, 794 'dumped files are not rewritten when there is no modification'; 795 796 my $rsobj30 = $conn->resultset('LoaderTest30'); 797 isa_ok($rsobj30, 'DBIx::Class::ResultSet'); 798 799 skip 'no rels', 2 if $self->{skip_rels}; 800 801 my $obj30 = $rsobj30->find(123); 802 isa_ok( $obj30->loader_test2, $class2); 803 804 ok($rsobj30->result_source->column_info('loader_test2')->{is_foreign_key}, 805 'Foreign key detected'); 806 } 807 808 $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run}; 809} 810 811sub check_no_duplicate_unique_constraints { 812 my ($class) = @_; 813 814 # unique_constraints() automatically includes the PK, if any 815 my %uc_cols; 816 ++$uc_cols{ join ", ", @$_ } 817 for values %{ { $class->unique_constraints } }; 818 my $dup_uc = grep { $_ > 1 } values %uc_cols; 819 820 is($dup_uc, 0, "duplicate unique constraints ($class)") 821 or diag "uc_cols: @{[ %uc_cols ]}"; 822} 823 824sub dbconnect { 825 my ($self, $complain) = @_; 826 827 my $dbh = DBI->connect( 828 $self->{dsn}, $self->{user}, 829 $self->{password}, 830 { 831 RaiseError => $complain, 832 PrintError => $complain, 833 AutoCommit => 1, 834 } 835 ); 836 837 die "Failed to connect to database: $DBI::errstr" if !$dbh; 838 839 return $dbh; 840} 841 842sub create { 843 my $self = shift; 844 845 $self->{_created} = 1; 846 847 my $make_auto_inc = $self->{auto_inc_cb} || sub {}; 848 @statements = ( 849 qq{ 850 CREATE TABLE loader_test1s ( 851 id $self->{auto_inc_pk}, 852 dat VARCHAR(32) NOT NULL UNIQUE 853 ) $self->{innodb} 854 }, 855 $make_auto_inc->(qw/loader_test1s id/), 856 857 q{ INSERT INTO loader_test1s (dat) VALUES('foo') }, 858 q{ INSERT INTO loader_test1s (dat) VALUES('bar') }, 859 q{ INSERT INTO loader_test1s (dat) VALUES('baz') }, 860 861 qq{ 862 CREATE TABLE loader_test2 ( 863 id $self->{auto_inc_pk}, 864 dat VARCHAR(32) NOT NULL, 865 dat2 VARCHAR(32) NOT NULL, 866 UNIQUE (dat2, dat) 867 ) $self->{innodb} 868 }, 869 $make_auto_inc->(qw/loader_test2 id/), 870 871 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') }, 872 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') }, 873 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') }, 874 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') }, 875 876 qq{ 877 CREATE TABLE LOADER_TEST23 ( 878 ID INTEGER NOT NULL PRIMARY KEY, 879 DAT VARCHAR(32) NOT NULL UNIQUE 880 ) $self->{innodb} 881 }, 882 883 qq{ 884 CREATE TABLE LoAdEr_test24 ( 885 iD INTEGER NOT NULL PRIMARY KEY, 886 DaT VARCHAR(32) NOT NULL UNIQUE 887 ) $self->{innodb} 888 }, 889 890 qq{ 891 CREATE TABLE loader_test35 ( 892 id INTEGER NOT NULL PRIMARY KEY, 893 a_varchar VARCHAR(100) DEFAULT 'foo', 894 an_int INTEGER DEFAULT 42, 895 a_double DOUBLE PRECISION DEFAULT 10.555, 896 a_function $self->{default_function_def} 897 ) $self->{innodb} 898 }, 899 900 qq{ 901 CREATE TABLE loader_test36 ( 902 id INTEGER NOT NULL PRIMARY KEY, 903 a_date DATE, 904 b_char_as_data VARCHAR(100), 905 c_char_as_data VARCHAR(100) 906 ) $self->{innodb} 907 }, 908 ); 909 910 @statements_reltests = ( 911 qq{ 912 CREATE TABLE loader_test3 ( 913 id INTEGER NOT NULL PRIMARY KEY, 914 dat VARCHAR(32) 915 ) $self->{innodb} 916 }, 917 918 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') }, 919 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') }, 920 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') }, 921 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') }, 922 923 qq{ 924 CREATE TABLE loader_test4 ( 925 id INTEGER NOT NULL PRIMARY KEY, 926 fkid INTEGER NOT NULL, 927 dat VARCHAR(32), 928 FOREIGN KEY( fkid ) REFERENCES loader_test3 (id) 929 ) $self->{innodb} 930 }, 931 932 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') }, 933 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') }, 934 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') }, 935 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') }, 936 937 qq{ 938 CREATE TABLE loader_test5 ( 939 id1 INTEGER NOT NULL, 940 iD2 INTEGER NOT NULL, 941 dat VARCHAR(8), 942 PRIMARY KEY (id1,iD2) 943 ) $self->{innodb} 944 }, 945 946 q{ INSERT INTO loader_test5 (id1,iD2,dat) VALUES (1,1,'aaa') }, 947 948 qq{ 949 CREATE TABLE loader_test6 ( 950 id INTEGER NOT NULL PRIMARY KEY, 951 Id2 INTEGER, 952 loader_test2_id INTEGER, 953 dat VARCHAR(8), 954 FOREIGN KEY (loader_test2_id) REFERENCES loader_test2 (id), 955 FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2) 956 ) $self->{innodb} 957 }, 958 959 (q{ INSERT INTO loader_test6 (id, Id2,loader_test2_id,dat) } . 960 q{ VALUES (1, 1,1,'aaa') }), 961 962 qq{ 963 CREATE TABLE loader_test7 ( 964 id INTEGER NOT NULL PRIMARY KEY, 965 id2 VARCHAR(8) NOT NULL UNIQUE, 966 dat VARCHAR(8) 967 ) $self->{innodb} 968 }, 969 970 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') }, 971 972 qq{ 973 CREATE TABLE loader_test8 ( 974 id INTEGER NOT NULL PRIMARY KEY, 975 loader_test7 VARCHAR(8) NOT NULL, 976 dat VARCHAR(8), 977 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2) 978 ) $self->{innodb} 979 }, 980 981 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } . 982 q{ VALUES (1,'aaa','bbb') }), 983 984 qq{ 985 CREATE TABLE loader_test9 ( 986 loader_test9 VARCHAR(8) NOT NULL 987 ) $self->{innodb} 988 }, 989 990 qq{ 991 CREATE TABLE loader_test16 ( 992 id INTEGER NOT NULL PRIMARY KEY, 993 dat VARCHAR(8) 994 ) $self->{innodb} 995 }, 996 997 qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') }, 998 qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') }, 999 qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') }, 1000 1001 qq{ 1002 CREATE TABLE loader_test17 ( 1003 id INTEGER NOT NULL PRIMARY KEY, 1004 loader16_one INTEGER, 1005 loader16_two INTEGER, 1006 FOREIGN KEY (loader16_one) REFERENCES loader_test16 (id), 1007 FOREIGN KEY (loader16_two) REFERENCES loader_test16 (id) 1008 ) $self->{innodb} 1009 }, 1010 1011 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (3, 2, 4) }, 1012 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (33, 4, 6) }, 1013 1014 qq{ 1015 CREATE TABLE loader_test18 ( 1016 id INTEGER NOT NULL PRIMARY KEY, 1017 dat VARCHAR(8) 1018 ) $self->{innodb} 1019 }, 1020 1021 qq{ INSERT INTO loader_test18 (id,dat) VALUES (1,'x18') }, 1022 qq{ INSERT INTO loader_test18 (id,dat) VALUES (2,'y18') }, 1023 qq{ INSERT INTO loader_test18 (id,dat) VALUES (3,'z18') }, 1024 1025 qq{ 1026 CREATE TABLE loader_test19 ( 1027 id INTEGER NOT NULL PRIMARY KEY, 1028 dat VARCHAR(8) 1029 ) $self->{innodb} 1030 }, 1031 1032 qq{ INSERT INTO loader_test19 (id,dat) VALUES (4,'x19') }, 1033 qq{ INSERT INTO loader_test19 (id,dat) VALUES (5,'y19') }, 1034 qq{ INSERT INTO loader_test19 (id,dat) VALUES (6,'z19') }, 1035 1036 qq{ 1037 CREATE TABLE loader_test20 ( 1038 parent INTEGER NOT NULL, 1039 child INTEGER NOT NULL, 1040 PRIMARY KEY (parent, child), 1041 FOREIGN KEY (parent) REFERENCES loader_test18 (id), 1042 FOREIGN KEY (child) REFERENCES loader_test19 (id) 1043 ) $self->{innodb} 1044 }, 1045 1046 q{ INSERT INTO loader_test20 (parent, child) VALUES (1,4) }, 1047 q{ INSERT INTO loader_test20 (parent, child) VALUES (2,5) }, 1048 q{ INSERT INTO loader_test20 (parent, child) VALUES (3,6) }, 1049 1050 qq{ 1051 CREATE TABLE loader_test21 ( 1052 id INTEGER NOT NULL PRIMARY KEY, 1053 dat VARCHAR(8) 1054 ) $self->{innodb} 1055 }, 1056 1057 q{ INSERT INTO loader_test21 (id,dat) VALUES (7,'a21')}, 1058 q{ INSERT INTO loader_test21 (id,dat) VALUES (11,'b21')}, 1059 q{ INSERT INTO loader_test21 (id,dat) VALUES (13,'c21')}, 1060 q{ INSERT INTO loader_test21 (id,dat) VALUES (17,'d21')}, 1061 1062 qq{ 1063 CREATE TABLE loader_test22 ( 1064 parent INTEGER NOT NULL, 1065 child INTEGER NOT NULL, 1066 PRIMARY KEY (parent, child), 1067 FOREIGN KEY (parent) REFERENCES loader_test21 (id), 1068 FOREIGN KEY (child) REFERENCES loader_test21 (id) 1069 ) $self->{innodb} 1070 }, 1071 1072 q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)}, 1073 q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)}, 1074 q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)}, 1075 1076 qq{ 1077 CREATE TABLE loader_test25 ( 1078 id1 INTEGER NOT NULL, 1079 id2 INTEGER NOT NULL, 1080 dat VARCHAR(8), 1081 PRIMARY KEY (id1,id2) 1082 ) $self->{innodb} 1083 }, 1084 1085 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,5,'x25') }, 1086 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,7,'y25') }, 1087 q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (3,42,'z25') }, 1088 1089 qq{ 1090 CREATE TABLE loader_test26 ( 1091 id INTEGER NOT NULL PRIMARY KEY, 1092 rel1 INTEGER NOT NULL, 1093 rel2 INTEGER NOT NULL, 1094 FOREIGN KEY (id, rel1) REFERENCES loader_test25 (id1, id2), 1095 FOREIGN KEY (id, rel2) REFERENCES loader_test25 (id1, id2) 1096 ) $self->{innodb} 1097 }, 1098 1099 q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) }, 1100 q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) }, 1101 1102 qq{ 1103 CREATE TABLE loader_test27 ( 1104 id INTEGER NOT NULL PRIMARY KEY 1105 ) $self->{innodb} 1106 }, 1107 1108 q{ INSERT INTO loader_test27 (id) VALUES (1) }, 1109 q{ INSERT INTO loader_test27 (id) VALUES (2) }, 1110 1111 qq{ 1112 CREATE TABLE loader_test28 ( 1113 id INTEGER NOT NULL PRIMARY KEY, 1114 FOREIGN KEY (id) REFERENCES loader_test27 (id) 1115 ) $self->{innodb} 1116 }, 1117 1118 q{ INSERT INTO loader_test28 (id) VALUES (1) }, 1119 1120 qq{ 1121 CREATE TABLE loader_test29 ( 1122 id INTEGER NOT NULL PRIMARY KEY, 1123 fk INTEGER NOT NULL UNIQUE, 1124 FOREIGN KEY (fk) REFERENCES loader_test27 (id) 1125 ) $self->{innodb} 1126 }, 1127 1128 q{ INSERT INTO loader_test29 (id,fk) VALUES (1,1) }, 1129 1130 qq{ 1131 CREATE TABLE loader_test31 ( 1132 id INTEGER NOT NULL PRIMARY KEY 1133 ) $self->{innodb} 1134 }, 1135 q{ INSERT INTO loader_test31 (id) VALUES (1) }, 1136 1137 qq{ 1138 CREATE TABLE loader_test32 ( 1139 id INTEGER NOT NULL PRIMARY KEY, 1140 rel1 INTEGER NOT NULL, 1141 rel2 INTEGER $self->{null}, 1142 FOREIGN KEY (rel1) REFERENCES loader_test31(id), 1143 FOREIGN KEY (rel2) REFERENCES loader_test31(id) 1144 ) $self->{innodb} 1145 }, 1146 q{ INSERT INTO loader_test32 (id,rel1) VALUES (1,1) }, 1147 1148 qq{ 1149 CREATE TABLE loader_test33 ( 1150 id1 INTEGER NOT NULL, 1151 id2 INTEGER NOT NULL, 1152 PRIMARY KEY (id1,id2) 1153 ) $self->{innodb} 1154 }, 1155 q{ INSERT INTO loader_test33 (id1,id2) VALUES (1,2) }, 1156 1157 qq{ 1158 CREATE TABLE loader_test34 ( 1159 id INTEGER NOT NULL PRIMARY KEY, 1160 rel1 INTEGER NOT NULL, 1161 rel2 INTEGER $self->{null}, 1162 FOREIGN KEY (id,rel1) REFERENCES loader_test33(id1,id2), 1163 FOREIGN KEY (id,rel2) REFERENCES loader_test33(id1,id2) 1164 ) $self->{innodb} 1165 }, 1166 q{ INSERT INTO loader_test34 (id,rel1) VALUES (1,2) }, 1167 ); 1168 1169 @statements_advanced = ( 1170 qq{ 1171 CREATE TABLE loader_test10 ( 1172 id10 $self->{auto_inc_pk}, 1173 subject VARCHAR(8), 1174 loader_test11 INTEGER $self->{null} 1175 ) $self->{innodb} 1176 }, 1177 $make_auto_inc->(qw/loader_test10 id10/), 1178 1179 qq{ 1180 CREATE TABLE loader_test11 ( 1181 id11 $self->{auto_inc_pk}, 1182 a_message VARCHAR(8) DEFAULT 'foo', 1183 loader_test10 INTEGER $self->{null}, 1184 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10) 1185 ) $self->{innodb} 1186 }, 1187 $make_auto_inc->(qw/loader_test11 id11/), 1188 1189 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } . 1190 q{ loader_test11_fk FOREIGN KEY (loader_test11) } . 1191 q{ REFERENCES loader_test11 (id11) }), 1192 ); 1193 1194 @statements_advanced_sqlite = ( 1195 qq{ 1196 CREATE TABLE loader_test10 ( 1197 id10 $self->{auto_inc_pk}, 1198 subject VARCHAR(8) 1199 ) $self->{innodb} 1200 }, 1201 $make_auto_inc->(qw/loader_test10 id10/), 1202 1203 qq{ 1204 CREATE TABLE loader_test11 ( 1205 id11 $self->{auto_inc_pk}, 1206 a_message VARCHAR(8) DEFAULT 'foo', 1207 loader_test10 INTEGER $self->{null}, 1208 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10) 1209 ) $self->{innodb} 1210 }, 1211 $make_auto_inc->(qw/loader_test11 id11/), 1212 1213 (q{ ALTER TABLE loader_test10 ADD COLUMN } . 1214 q{ loader_test11 INTEGER REFERENCES loader_test11 (id11) }), 1215 ); 1216 1217 @statements_inline_rels = ( 1218 qq{ 1219 CREATE TABLE loader_test12 ( 1220 id INTEGER NOT NULL PRIMARY KEY, 1221 id2 VARCHAR(8) NOT NULL UNIQUE, 1222 dat VARCHAR(8) NOT NULL UNIQUE 1223 ) $self->{innodb} 1224 }, 1225 1226 q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') }, 1227 1228 qq{ 1229 CREATE TABLE loader_test13 ( 1230 id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12, 1231 loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2), 1232 dat VARCHAR(8) REFERENCES loader_test12 (dat) 1233 ) $self->{innodb} 1234 }, 1235 1236 (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } . 1237 q{ VALUES (1,'aaa','bbb') }), 1238 ); 1239 1240 1241 @statements_implicit_rels = ( 1242 qq{ 1243 CREATE TABLE loader_test14 ( 1244 id INTEGER NOT NULL PRIMARY KEY, 1245 dat VARCHAR(8) 1246 ) $self->{innodb} 1247 }, 1248 1249 q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') }, 1250 1251 qq{ 1252 CREATE TABLE loader_test15 ( 1253 id INTEGER NOT NULL PRIMARY KEY, 1254 loader_test14 INTEGER NOT NULL, 1255 FOREIGN KEY (loader_test14) REFERENCES loader_test14 1256 ) $self->{innodb} 1257 }, 1258 1259 q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) }, 1260 ); 1261 1262 $self->drop_tables; 1263 1264 my $dbh = $self->dbconnect(1); 1265 1266 # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." 1267 local $SIG{__WARN__} = sub { 1268 my $msg = shift; 1269 print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; 1270 }; 1271 1272 $dbh->do($_) for (@statements); 1273 unless($self->{skip_rels}) { 1274 # hack for now, since DB2 doesn't like inline comments, and we need 1275 # to test one for mysql, which works on everyone else... 1276 # this all needs to be refactored anyways. 1277 $dbh->do($_) for (@statements_reltests); 1278 if($self->{vendor} =~ /sqlite/i) { 1279 $dbh->do($_) for (@statements_advanced_sqlite); 1280 } 1281 else { 1282 $dbh->do($_) for (@statements_advanced); 1283 } 1284 unless($self->{no_inline_rels}) { 1285 $dbh->do($_) for (@statements_inline_rels); 1286 } 1287 unless($self->{no_implicit_rels}) { 1288 $dbh->do($_) for (@statements_implicit_rels); 1289 } 1290 } 1291 1292 $dbh->do($_) for @{ $self->{extra}->{create} || [] }; 1293 $dbh->disconnect(); 1294} 1295 1296sub drop_tables { 1297 my $self = shift; 1298 1299 my @tables = qw/ 1300 loader_test1s 1301 loader_test2 1302 LOADER_TEST23 1303 LoAdEr_test24 1304 loader_test35 1305 loader_test36 1306 /; 1307 1308 my @tables_auto_inc = ( 1309 [ qw/loader_test1s id/ ], 1310 [ qw/loader_test2 id/ ], 1311 ); 1312 1313 my @tables_reltests = qw/ 1314 loader_test4 1315 loader_test3 1316 loader_test6 1317 loader_test5 1318 loader_test8 1319 loader_test7 1320 loader_test9 1321 loader_test17 1322 loader_test16 1323 loader_test20 1324 loader_test19 1325 loader_test18 1326 loader_test22 1327 loader_test21 1328 loader_test26 1329 loader_test25 1330 loader_test28 1331 loader_test29 1332 loader_test27 1333 loader_test32 1334 loader_test31 1335 loader_test34 1336 loader_test33 1337 /; 1338 1339 my @tables_advanced = qw/ 1340 loader_test11 1341 loader_test10 1342 /; 1343 1344 my @tables_advanced_auto_inc = ( 1345 [ qw/loader_test10 id10/ ], 1346 [ qw/loader_test11 id11/ ], 1347 ); 1348 1349 my @tables_inline_rels = qw/ 1350 loader_test13 1351 loader_test12 1352 /; 1353 1354 my @tables_implicit_rels = qw/ 1355 loader_test15 1356 loader_test14 1357 /; 1358 1359 my @tables_rescan = qw/ loader_test30 /; 1360 1361 my $drop_fk_mysql = 1362 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk}; 1363 1364 my $drop_fk = 1365 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk}; 1366 1367 my $dbh = $self->dbconnect(0); 1368 1369 $dbh->do("DROP TABLE $_") for @{ $self->{extra}->{drop} || [] }; 1370 1371 my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; 1372 1373 unless($self->{skip_rels}) { 1374 $dbh->do("DROP TABLE $_") for (@tables_reltests); 1375 if($self->{vendor} =~ /mysql/i) { 1376 $dbh->do($drop_fk_mysql); 1377 } 1378 else { 1379 $dbh->do($drop_fk); 1380 } 1381 $dbh->do("DROP TABLE $_") for (@tables_advanced); 1382 $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc; 1383 1384 unless($self->{no_inline_rels}) { 1385 $dbh->do("DROP TABLE $_") for (@tables_inline_rels); 1386 } 1387 unless($self->{no_implicit_rels}) { 1388 $dbh->do("DROP TABLE $_") for (@tables_implicit_rels); 1389 } 1390 } 1391 $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan); 1392 $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc; 1393 $dbh->disconnect; 1394} 1395 1396sub DESTROY { 1397 my $self = shift; 1398 unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) { 1399 $self->drop_tables if $self->{_created}; 1400 rmtree $DUMP_DIR 1401 } 1402} 1403 14041; 1405