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