t/10_07mssql_common.t

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