1use strict; 2use warnings; 3use Test::More; 4use Test::Exception; 5use DBIx::Class::Schema::Loader::Utils 'warnings_exist_silent'; 6use Try::Tiny; 7use File::Path 'rmtree'; 8use DBIx::Class::Schema::Loader 'make_schema_at'; 9use namespace::clean; 10use Scope::Guard (); 11 12# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else 13BEGIN { 14 if (my $lib_dirs = $ENV{DBICTEST_MSSQL_PERL5LIB}) { 15 unshift @INC, $_ for split /:/, $lib_dirs; 16 } 17} 18 19use lib qw(t/lib); 20 21use dbixcsl_common_tests (); 22use dbixcsl_test_dir '$tdir'; 23 24use constant EXTRA_DUMP_DIR => "$tdir/mssql_extra_dump"; 25 26# for extra tests cleanup 27my $schema; 28 29my ($dsns, $common_version); 30 31for (qw/MSSQL MSSQL_ODBC MSSQL_ADO/) { 32 next unless $ENV{"DBICTEST_${_}_DSN"}; 33 34 $dsns->{$_}{dsn} = $ENV{"DBICTEST_${_}_DSN"}; 35 $dsns->{$_}{user} = $ENV{"DBICTEST_${_}_USER"}; 36 $dsns->{$_}{password} = $ENV{"DBICTEST_${_}_PASS"}; 37 38 require DBI; 39 my $dbh = DBI->connect (@{$dsns->{$_}}{qw/dsn user password/}, { RaiseError => 1, PrintError => 0} ); 40 my $srv_ver = eval { 41 $dbh->get_info(18) 42 || 43 $dbh->selectrow_hashref('master.dbo.xp_msver ProductVersion')->{Character_Value} 44 } || 0; 45 46 my ($maj_srv_ver) = $srv_ver =~ /^(\d+)/; 47 48 if (! defined $common_version or $common_version > $maj_srv_ver ) { 49 $common_version = $maj_srv_ver; 50 } 51} 52 53plan skip_all => 'You need to set the DBICTEST_MSSQL_DSN, _USER and _PASS and/or the DBICTEST_MSSQL_ODBC_DSN, _USER and _PASS environment variables' 54 unless $dsns; 55 56my $mssql_2008_new_data_types = { 57 date => { data_type => 'date' }, 58 time => { data_type => 'time' }, 59 'time(0)'=> { data_type => 'time', size => 0 }, 60 'time(1)'=> { data_type => 'time', size => 1 }, 61 'time(2)'=> { data_type => 'time', size => 2 }, 62 'time(3)'=> { data_type => 'time', size => 3 }, 63 'time(4)'=> { data_type => 'time', size => 4 }, 64 'time(5)'=> { data_type => 'time', size => 5 }, 65 'time(6)'=> { data_type => 'time', size => 6 }, 66 'time(7)'=> { data_type => 'time' }, 67 datetimeoffset => { data_type => 'datetimeoffset' }, 68 'datetimeoffset(0)' => { data_type => 'datetimeoffset', size => 0 }, 69 'datetimeoffset(1)' => { data_type => 'datetimeoffset', size => 1 }, 70 'datetimeoffset(2)' => { data_type => 'datetimeoffset', size => 2 }, 71 'datetimeoffset(3)' => { data_type => 'datetimeoffset', size => 3 }, 72 'datetimeoffset(4)' => { data_type => 'datetimeoffset', size => 4 }, 73 'datetimeoffset(5)' => { data_type => 'datetimeoffset', size => 5 }, 74 'datetimeoffset(6)' => { data_type => 'datetimeoffset', size => 6 }, 75 'datetimeoffset(7)' => { data_type => 'datetimeoffset' }, 76 datetime2 => { data_type => 'datetime2' }, 77 'datetime2(0)' => { data_type => 'datetime2', size => 0 }, 78 'datetime2(1)' => { data_type => 'datetime2', size => 1 }, 79 'datetime2(2)' => { data_type => 'datetime2', size => 2 }, 80 'datetime2(3)' => { data_type => 'datetime2', size => 3 }, 81 'datetime2(4)' => { data_type => 'datetime2', size => 4 }, 82 'datetime2(5)' => { data_type => 'datetime2', size => 5 }, 83 'datetime2(6)' => { data_type => 'datetime2', size => 6 }, 84 'datetime2(7)' => { data_type => 'datetime2' }, 85 86 hierarchyid => { data_type => 'hierarchyid' }, 87}; 88 89my $tester = dbixcsl_common_tests->new( 90 vendor => 'mssql', 91 auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY', 92 default_function_def => 'DATETIME DEFAULT getdate()', 93 connect_info => [values %$dsns], 94 preserve_case_mode_is_exclusive => 1, 95 quote_char => [ qw/[ ]/ ], 96 basic_date_datatype => ($common_version >= 10) ? 'DATE' : 'SMALLDATETIME', 97 default_on_clause => 'NO ACTION', 98 data_types => { 99 # http://msdn.microsoft.com/en-us/library/ms187752.aspx 100 101 # numeric types 102 'int identity' => { data_type => 'integer', is_auto_increment => 1 }, 103 bigint => { data_type => 'bigint' }, 104 int => { data_type => 'integer' }, 105 integer => { data_type => 'integer' }, 106 smallint => { data_type => 'smallint' }, 107 tinyint => { data_type => 'tinyint' }, 108 money => { data_type => 'money' }, 109 smallmoney => { data_type => 'smallmoney' }, 110 bit => { data_type => 'bit' }, 111 real => { data_type => 'real' }, 112 'float(14)' => { data_type => 'real' }, 113 'float(24)' => { data_type => 'real' }, 114 'float(25)' => { data_type => 'double precision' }, 115 'float(53)' => { data_type => 'double precision' }, 116 float => { data_type => 'double precision' }, 117 'double precision' 118 => { data_type => 'double precision' }, 119 'numeric(6)' => { data_type => 'numeric', size => [6,0] }, 120 'numeric(6,3)' => { data_type => 'numeric', size => [6,3] }, 121 'decimal(6)' => { data_type => 'decimal', size => [6,0] }, 122 'decimal(6,3)' => { data_type => 'decimal', size => [6,3] }, 123 'dec(6,3)' => { data_type => 'decimal', size => [6,3] }, 124 numeric => { data_type => 'numeric' }, 125 decimal => { data_type => 'decimal' }, 126 dec => { data_type => 'decimal' }, 127 128 # datetime types 129 datetime => { data_type => 'datetime' }, 130 # test rewriting getdate() to current_timestamp 131 'datetime default getdate()' 132 => { data_type => 'datetime', default_value => \'current_timestamp', 133 original => { default_value => \'getdate()' } }, 134 smalldatetime => { data_type => 'smalldatetime' }, 135 136 ($common_version >= 10) ? %$mssql_2008_new_data_types : (), 137 138 # string types 139 char => { data_type => 'char', size => 1 }, 140 'char(2)' => { data_type => 'char', size => 2 }, 141 character => { data_type => 'char', size => 1 }, 142 'character(2)' => { data_type => 'char', size => 2 }, 143 'varchar(2)' => { data_type => 'varchar', size => 2 }, 144 145 nchar => { data_type => 'nchar', size => 1 }, 146 'nchar(2)' => { data_type => 'nchar', size => 2 }, 147 'nvarchar(2)' => { data_type => 'nvarchar', size => 2 }, 148 149 # binary types 150 'binary' => { data_type => 'binary', size => 1 }, 151 'binary(2)' => { data_type => 'binary', size => 2 }, 152 'varbinary(2)' => { data_type => 'varbinary', size => 2 }, 153 154 # blob types 155 'varchar(max)' => { data_type => 'text' }, 156 text => { data_type => 'text' }, 157 158 'nvarchar(max)' => { data_type => 'ntext' }, 159 ntext => { data_type => 'ntext' }, 160 161 'varbinary(max)' => { data_type => 'image' }, 162 image => { data_type => 'image' }, 163 164 # other types 165 timestamp => { data_type => 'timestamp', inflate_datetime => 0 }, 166 rowversion => { data_type => 'rowversion' }, 167 uniqueidentifier => { data_type => 'uniqueidentifier' }, 168 sql_variant => { data_type => 'sql_variant' }, 169 xml => { data_type => 'xml' }, 170 }, 171 extra => { 172 create => [ 173 q{ 174 CREATE TABLE [mssql_loader_test1.dot] ( 175 id INT IDENTITY NOT NULL PRIMARY KEY, 176 dat VARCHAR(8) 177 ) 178 }, 179 q{ 180 CREATE TABLE mssql_loader_test3 ( 181 id INT IDENTITY NOT NULL PRIMARY KEY 182 ) 183 }, 184 q{ 185 CREATE VIEW mssql_loader_test4 AS 186 SELECT * FROM mssql_loader_test3 187 }, 188 # test capitalization of cols in unique constraints and rels 189 q{ SET QUOTED_IDENTIFIER ON }, 190 q{ SET ANSI_NULLS ON }, 191 q{ 192 CREATE TABLE [MSSQL_Loader_Test5] ( 193 [Id] INT IDENTITY NOT NULL PRIMARY KEY, 194 [FooCol] INT NOT NULL, 195 [BarCol] INT NOT NULL, 196 UNIQUE ([FooCol], [BarCol]) 197 ) 198 }, 199 q{ 200 CREATE TABLE [MSSQL_Loader_Test6] ( 201 [Five_Id] INT REFERENCES [MSSQL_Loader_Test5] ([Id]) 202 ) 203 }, 204 # 8 through 12 are used for the multi-schema tests and 13 through 16 are used for multi-db tests 205 q{ 206 create table mssql_loader_test17 ( 207 id int identity primary key 208 ) 209 }, 210 q{ 211 create table mssql_loader_test18 ( 212 id int identity primary key, 213 seventeen_id int, 214 foreign key (seventeen_id) references mssql_loader_test17(id) 215 on delete set default on update set null 216 ) 217 }, 218 ], 219 pre_drop_ddl => [ 220 'CREATE TABLE mssql_loader_test3 (id INT IDENTITY NOT NULL PRIMARY KEY)', 221 'DROP VIEW mssql_loader_test4', 222 ], 223 drop => [ 224 '[mssql_loader_test1.dot]', 225 'mssql_loader_test3', 226 'MSSQL_Loader_Test6', 227 'MSSQL_Loader_Test5', 228 'mssql_loader_test17', 229 'mssql_loader_test18', 230 ], 231 count => 14 + 30 * 2 + 26 * 2, # extra + multi-schema + mutli-db 232 run => sub { 233 my ($monikers, $classes, $self); 234 ($schema, $monikers, $classes, $self) = @_; 235 236 my $connect_info = [@$self{qw/dsn user password/}]; 237 238# Test that the table above (with '.' in name) gets loaded correctly. 239 ok((my $rs = eval { 240 $schema->resultset('MssqlLoaderTest1Dot') }), 241 'got a resultset for table with dot in name'); 242 243 ok((my $from = eval { $rs->result_source->from }), 244 'got an $rsrc->from for table with dot in name'); 245 246 is ref($from), 'SCALAR', '->table with dot in name is a scalar ref'; 247 248 is eval { $$from }, "[mssql_loader_test1.dot]", 249 '->table with dot in name has correct name'; 250 251# Test capitalization of columns and unique constraints 252 ok ((my $rsrc = $schema->resultset($monikers->{mssql_loader_test5})->result_source), 253 'got result_source'); 254 255 if ($schema->loader->preserve_case) { 256 is_deeply [ $rsrc->columns ], [qw/Id FooCol BarCol/], 257 'column name case is preserved with case-sensitive collation'; 258 259 my %uniqs = $rsrc->unique_constraints; 260 delete $uniqs{primary}; 261 262 is_deeply ((values %uniqs)[0], [qw/FooCol BarCol/], 263 'column name case is preserved in unique constraint with case-sensitive collation'); 264 } 265 else { 266 is_deeply [ $rsrc->columns ], [qw/id foocol barcol/], 267 'column names are lowercased for case-insensitive collation'; 268 269 my %uniqs = $rsrc->unique_constraints; 270 delete $uniqs{primary}; 271 272 is_deeply ((values %uniqs)[0], [qw/foocol barcol/], 273 'columns in unique constraint lowercased for case-insensitive collation'); 274 } 275 276 lives_and { 277 my $five_row = $schema->resultset($monikers->{mssql_loader_test5})->new_result({}); 278 279 if ($schema->loader->preserve_case) { 280 $five_row->foo_col(1); 281 $five_row->bar_col(2); 282 } 283 else { 284 $five_row->foocol(1); 285 $five_row->barcol(2); 286 } 287 $five_row->insert; 288 289 my $six_row = $five_row->create_related('mssql_loader_test6s', {}); 290 291 is $six_row->five->id, 1; 292 } 'relationships for mixed-case tables/columns detected'; 293 294# Test that a bad view (where underlying table is gone) is ignored. 295 my $dbh = $schema->storage->dbh; 296 $dbh->do("DROP TABLE mssql_loader_test3"); 297 298 warnings_exist_silent { $schema->rescan } 299 qr/^Bad table or view 'mssql_loader_test4'/, 'bad view ignored'; 300 301 throws_ok { 302 $schema->resultset($monikers->{mssql_loader_test4}) 303 } qr/Can't find source/, 304 'no source registered for bad view'; 305 306 # test on delete/update fk clause introspection 307 ok ((my $rel_info = $schema->source('MssqlLoaderTest18')->relationship_info('seventeen')), 308 'got rel info'); 309 310 is $rel_info->{attrs}{on_delete}, 'SET DEFAULT', 311 'ON DELETE clause introspected correctly'; 312 313 is $rel_info->{attrs}{on_update}, 'SET NULL', 314 'ON UPDATE clause introspected correctly'; 315 316 is $rel_info->{attrs}{is_deferrable}, 1, 317 'is_deferrable defaults to 1'; 318 319 SKIP: { 320 my $dbh = $schema->storage->dbh; 321 322 try { 323 $dbh->do('CREATE SCHEMA [dbicsl-test]'); 324 } 325 catch { 326 skip "no CREATE SCHEMA privileges", 30 * 2; 327 }; 328 329 $dbh->do(<<"EOF"); 330 CREATE TABLE [dbicsl-test].mssql_loader_test8 ( 331 id INT IDENTITY PRIMARY KEY, 332 value VARCHAR(100) 333 ) 334EOF 335 $dbh->do(<<"EOF"); 336 CREATE TABLE [dbicsl-test].mssql_loader_test9 ( 337 id INT IDENTITY PRIMARY KEY, 338 value VARCHAR(100), 339 eight_id INTEGER NOT NULL, 340 CONSTRAINT loader_test9_uniq UNIQUE (eight_id), 341 FOREIGN KEY (eight_id) REFERENCES [dbicsl-test].mssql_loader_test8 (id) 342 ) 343EOF 344 $dbh->do('CREATE SCHEMA [dbicsl.test]'); 345 $dbh->do(<<"EOF"); 346 CREATE TABLE [dbicsl.test].mssql_loader_test9 ( 347 pk INT IDENTITY PRIMARY KEY, 348 value VARCHAR(100), 349 eight_id INTEGER NOT NULL, 350 CONSTRAINT loader_test9_uniq UNIQUE (eight_id), 351 FOREIGN KEY (eight_id) REFERENCES [dbicsl-test].mssql_loader_test8 (id) 352 ) 353EOF 354 $dbh->do(<<"EOF"); 355 CREATE TABLE [dbicsl.test].mssql_loader_test10 ( 356 id INT IDENTITY PRIMARY KEY, 357 value VARCHAR(100), 358 mssql_loader_test8_id INTEGER, 359 FOREIGN KEY (mssql_loader_test8_id) REFERENCES [dbicsl-test].mssql_loader_test8 (id) 360 ) 361EOF 362 $dbh->do(<<"EOF"); 363 CREATE TABLE [dbicsl.test].mssql_loader_test11 ( 364 id INT IDENTITY PRIMARY KEY, 365 value VARCHAR(100), 366 ten_id INTEGER NOT NULL UNIQUE, 367 FOREIGN KEY (ten_id) REFERENCES [dbicsl.test].mssql_loader_test10 (id) 368 ) 369EOF 370 $dbh->do(<<"EOF"); 371 CREATE TABLE [dbicsl-test].mssql_loader_test12 ( 372 id INT IDENTITY PRIMARY KEY, 373 value VARCHAR(100), 374 mssql_loader_test11_id INTEGER, 375 FOREIGN KEY (mssql_loader_test11_id) REFERENCES [dbicsl.test].mssql_loader_test11 (id) 376 ) 377EOF 378 379 my $guard = Scope::Guard->new(\&cleanup_schemas); 380 381 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') { 382 lives_and { 383 rmtree EXTRA_DUMP_DIR; 384 385 my @warns; 386 local $SIG{__WARN__} = sub { 387 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/; 388 }; 389 390 make_schema_at( 391 'MSSQLMultiSchema', 392 { 393 naming => 'current', 394 db_schema => $db_schema, 395 dump_directory => EXTRA_DUMP_DIR, 396 quiet => 1, 397 }, 398 $connect_info, 399 ); 400 401 diag join "\n", @warns if @warns; 402 403 is @warns, 0; 404 } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings'; 405 406 my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info); 407 408 lives_and { 409 ok $test_schema = MSSQLMultiSchema->connect(@$connect_info); 410 } 'connected test schema'; 411 412 lives_and { 413 ok $rsrc = $test_schema->source('MssqlLoaderTest8'); 414 } 'got source for table in schema name with dash'; 415 416 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 417 'column in schema name with dash'; 418 419 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 420 'column in schema name with dash'; 421 422 is try { $rsrc->column_info('value')->{size} }, 100, 423 'column in schema name with dash'; 424 425 lives_and { 426 ok $rs = $test_schema->resultset('MssqlLoaderTest8'); 427 } 'got resultset for table in schema name with dash'; 428 429 lives_and { 430 ok $row = $rs->create({ value => 'foo' }); 431 } 'executed SQL on table in schema name with dash'; 432 433 $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_mssql_loader_test9') }; 434 435 is_deeply $rel_info->{cond}, { 436 'foreign.eight_id' => 'self.id' 437 }, 'relationship in schema name with dash'; 438 439 is $rel_info->{attrs}{accessor}, 'single', 440 'relationship in schema name with dash'; 441 442 is $rel_info->{attrs}{join_type}, 'LEFT', 443 'relationship in schema name with dash'; 444 445 lives_and { 446 ok $rsrc = $test_schema->source('DbicslDashTestMssqlLoaderTest9'); 447 } 'got source for table in schema name with dash'; 448 449 %uniqs = try { $rsrc->unique_constraints }; 450 451 is keys %uniqs, 2, 452 'got unique and primary constraint in schema name with dash'; 453 454 delete $uniqs{primary}; 455 456 is_deeply ((values %uniqs)[0], ['eight_id'], 457 'correct unique constraint in schema name with dash'); 458 459 lives_and { 460 ok $rsrc = $test_schema->source('MssqlLoaderTest10'); 461 } 'got source for table in schema name with dot'; 462 463 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 464 'column in schema name with dot introspected correctly'; 465 466 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 467 'column in schema name with dot introspected correctly'; 468 469 is try { $rsrc->column_info('value')->{size} }, 100, 470 'column in schema name with dot introspected correctly'; 471 472 lives_and { 473 ok $rs = $test_schema->resultset('MssqlLoaderTest10'); 474 } 'got resultset for table in schema name with dot'; 475 476 lives_and { 477 ok $row = $rs->create({ value => 'foo' }); 478 } 'executed SQL on table in schema name with dot'; 479 480 $rel_info = try { $rsrc->relationship_info('mssql_loader_test11') }; 481 482 is_deeply $rel_info->{cond}, { 483 'foreign.ten_id' => 'self.id' 484 }, 'relationship in schema name with dot'; 485 486 is $rel_info->{attrs}{accessor}, 'single', 487 'relationship in schema name with dot'; 488 489 is $rel_info->{attrs}{join_type}, 'LEFT', 490 'relationship in schema name with dot'; 491 492 lives_and { 493 ok $rsrc = $test_schema->source('MssqlLoaderTest11'); 494 } 'got source for table in schema name with dot'; 495 496 %uniqs = try { $rsrc->unique_constraints }; 497 498 is keys %uniqs, 2, 499 'got unique and primary constraint in schema name with dot'; 500 501 delete $uniqs{primary}; 502 503 is_deeply ((values %uniqs)[0], ['ten_id'], 504 'correct unique constraint in schema name with dot'); 505 506 lives_and { 507 ok $test_schema->source('MssqlLoaderTest10') 508 ->has_relationship('mssql_loader_test8'); 509 } 'cross-schema relationship in multi-db_schema'; 510 511 lives_and { 512 ok $test_schema->source('MssqlLoaderTest8') 513 ->has_relationship('mssql_loader_test10s'); 514 } 'cross-schema relationship in multi-db_schema'; 515 516 lives_and { 517 ok $test_schema->source('MssqlLoaderTest12') 518 ->has_relationship('mssql_loader_test11'); 519 } 'cross-schema relationship in multi-db_schema'; 520 521 lives_and { 522 ok $test_schema->source('MssqlLoaderTest11') 523 ->has_relationship('mssql_loader_test12s'); 524 } 'cross-schema relationship in multi-db_schema'; 525 } 526 } 527 528 SKIP: { 529 # for ADO 530 my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; 531 local $SIG{__WARN__} = sub { 532 $warn_handler->(@_) unless $_[0] =~ /Changed database context/; 533 }; 534 535 my $dbh = $schema->storage->dbh; 536 537 try { 538 $dbh->do('USE master'); 539 $dbh->do('CREATE DATABASE dbicsl_test1'); 540 } 541 catch { 542 diag "no CREATE DATABASE privileges: '$_'"; 543 skip "no CREATE DATABASE privileges", 26 * 2; 544 }; 545 546 $dbh->do('CREATE DATABASE dbicsl_test2'); 547 548 $dbh->do('USE dbicsl_test1'); 549 550 $dbh->do(<<'EOF'); 551 CREATE TABLE mssql_loader_test13 ( 552 id INT IDENTITY PRIMARY KEY, 553 value VARCHAR(100) 554 ) 555EOF 556 $dbh->do(<<'EOF'); 557 CREATE TABLE mssql_loader_test14 ( 558 id INT IDENTITY PRIMARY KEY, 559 value VARCHAR(100), 560 thirteen_id INTEGER REFERENCES mssql_loader_test13 (id), 561 CONSTRAINT loader_test14_uniq UNIQUE (thirteen_id) 562 ) 563EOF 564 565 $dbh->do('USE dbicsl_test2'); 566 567 $dbh->do(<<'EOF'); 568 CREATE TABLE mssql_loader_test14 ( 569 pk INT IDENTITY PRIMARY KEY, 570 value VARCHAR(100), 571 thirteen_id INTEGER, 572 CONSTRAINT loader_test14_uniq UNIQUE (thirteen_id) 573 ) 574EOF 575 576 $dbh->do(<<"EOF"); 577 CREATE TABLE mssql_loader_test15 ( 578 id INT IDENTITY PRIMARY KEY, 579 value VARCHAR(100) 580 ) 581EOF 582 $dbh->do(<<"EOF"); 583 CREATE TABLE mssql_loader_test16 ( 584 id INT IDENTITY PRIMARY KEY, 585 value VARCHAR(100), 586 fifteen_id INTEGER UNIQUE REFERENCES mssql_loader_test15 (id) 587 ) 588EOF 589 590 my $guard = Scope::Guard->new(\&cleanup_databases); 591 592 foreach my $db_schema ({ dbicsl_test1 => '%', dbicsl_test2 => '%' }, { '%' => '%' }) { 593 lives_and { 594 my @warns; 595 local $SIG{__WARN__} = sub { 596 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/; 597 }; 598 599 make_schema_at( 600 'MSSQLMultiDatabase', 601 { 602 naming => 'current', 603 db_schema => $db_schema, 604 dump_directory => EXTRA_DUMP_DIR, 605 quiet => 1, 606 }, 607 $connect_info, 608 ); 609 610 diag join "\n", @warns if @warns; 611 612 is @warns, 0; 613 } "dumped schema for databases 'dbicsl_test1' and 'dbicsl_test2' with no warnings"; 614 615 my $test_schema; 616 617 lives_and { 618 ok $test_schema = MSSQLMultiDatabase->connect(@$connect_info); 619 } 'connected test schema'; 620 621 my ($rsrc, $rs, $row, $rel_info, %uniqs); 622 623 lives_and { 624 ok $rsrc = $test_schema->source('MssqlLoaderTest13'); 625 } 'got source for table in database one'; 626 627 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 628 'column in database one'; 629 630 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 631 'column in database one'; 632 633 is try { $rsrc->column_info('value')->{size} }, 100, 634 'column in database one'; 635 636 lives_and { 637 ok $rs = $test_schema->resultset('MssqlLoaderTest13'); 638 } 'got resultset for table in database one'; 639 640 lives_and { 641 ok $row = $rs->create({ value => 'foo' }); 642 } 'executed SQL on table in database one'; 643 644 $rel_info = try { $rsrc->relationship_info('mssql_loader_test14') }; 645 646 is_deeply $rel_info->{cond}, { 647 'foreign.thirteen_id' => 'self.id' 648 }, 'relationship in database one'; 649 650 is $rel_info->{attrs}{accessor}, 'single', 651 'relationship in database one'; 652 653 is $rel_info->{attrs}{join_type}, 'LEFT', 654 'relationship in database one'; 655 656 lives_and { 657 ok $rsrc = $test_schema->source('DbicslTest1MssqlLoaderTest14'); 658 } 'got source for table in database one'; 659 660 %uniqs = try { $rsrc->unique_constraints }; 661 662 is keys %uniqs, 2, 663 'got unique and primary constraint in database one'; 664 665 delete $uniqs{primary}; 666 667 is_deeply ((values %uniqs)[0], ['thirteen_id'], 668 'correct unique constraint in database one'); 669 670 lives_and { 671 ok $rsrc = $test_schema->source('MssqlLoaderTest15'); 672 } 'got source for table in database two'; 673 674 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 675 'column in database two introspected correctly'; 676 677 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 678 'column in database two introspected correctly'; 679 680 is try { $rsrc->column_info('value')->{size} }, 100, 681 'column in database two introspected correctly'; 682 683 lives_and { 684 ok $rs = $test_schema->resultset('MssqlLoaderTest15'); 685 } 'got resultset for table in database two'; 686 687 lives_and { 688 ok $row = $rs->create({ value => 'foo' }); 689 } 'executed SQL on table in database two'; 690 691 $rel_info = try { $rsrc->relationship_info('mssql_loader_test16') }; 692 693 is_deeply $rel_info->{cond}, { 694 'foreign.fifteen_id' => 'self.id' 695 }, 'relationship in database two'; 696 697 is $rel_info->{attrs}{accessor}, 'single', 698 'relationship in database two'; 699 700 is $rel_info->{attrs}{join_type}, 'LEFT', 701 'relationship in database two'; 702 703 lives_and { 704 ok $rsrc = $test_schema->source('MssqlLoaderTest16'); 705 } 'got source for table in database two'; 706 707 %uniqs = try { $rsrc->unique_constraints }; 708 709 is keys %uniqs, 2, 710 'got unique and primary constraint in database two'; 711 712 delete $uniqs{primary}; 713 714 is_deeply ((values %uniqs)[0], ['fifteen_id'], 715 'correct unique constraint in database two'); 716 } 717 } 718 }, 719 }, 720); 721 722$tester->run_tests(); 723 724sub cleanup_schemas { 725 return if $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; 726 727 # switch back to default database 728 $schema->storage->disconnect; 729 my $dbh = $schema->storage->dbh; 730 731 foreach my $table ('[dbicsl-test].mssql_loader_test12', 732 '[dbicsl.test].mssql_loader_test11', 733 '[dbicsl.test].mssql_loader_test10', 734 '[dbicsl.test].mssql_loader_test9', 735 '[dbicsl-test].mssql_loader_test9', 736 '[dbicsl-test].mssql_loader_test8') { 737 try { 738 $dbh->do("DROP TABLE $table"); 739 } 740 catch { 741 diag "Error dropping table: $_"; 742 }; 743 } 744 745 foreach my $db_schema (qw/dbicsl-test dbicsl.test/) { 746 try { 747 $dbh->do(qq{DROP SCHEMA [$db_schema]}); 748 } 749 catch { 750 diag "Error dropping test schema $db_schema: $_"; 751 }; 752 } 753 754 rmtree EXTRA_DUMP_DIR; 755} 756 757sub cleanup_databases { 758 return if $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; 759 760 # for ADO 761 my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; 762 local $SIG{__WARN__} = sub { 763 $warn_handler->(@_) unless $_[0] =~ /Changed database context/; 764 }; 765 766 my $dbh = $schema->storage->dbh; 767 768 $dbh->do('USE dbicsl_test1'); 769 770 foreach my $table ('mssql_loader_test14', 771 'mssql_loader_test13') { 772 try { 773 $dbh->do("DROP TABLE $table"); 774 } 775 catch { 776 diag "Error dropping table: $_"; 777 }; 778 } 779 780 $dbh->do('USE dbicsl_test2'); 781 782 foreach my $table ('mssql_loader_test16', 783 'mssql_loader_test15', 784 'mssql_loader_test14') { 785 try { 786 $dbh->do("DROP TABLE $table"); 787 } 788 catch { 789 diag "Error dropping table: $_"; 790 }; 791 } 792 793 $dbh->do('USE master'); 794 795 foreach my $database (qw/dbicsl_test1 dbicsl_test2/) { 796 try { 797 $dbh->do(qq{DROP DATABASE $database}); 798 } 799 catch { 800 diag "Error dropping test database '$database': $_"; 801 }; 802 } 803 804 rmtree EXTRA_DUMP_DIR; 805} 806# vim:et sts=4 sw=4 tw=0: 807