Use sigwarn_silencer() everywhere appropriate
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / 10_06sybase_common.t
1 use strict;
2 use warnings;
3 use Test::More;
4 use Test::Exception;
5 use Try::Tiny;
6 use File::Path 'rmtree';
7 use DBIx::Class::Schema::Loader 'make_schema_at';
8 use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
9 use namespace::clean;
10 use DBI ();
11
12 use lib qw(t/lib);
13
14 use dbixcsl_common_tests ();
15 use dbixcsl_test_dir '$tdir';
16
17 use constant EXTRA_DUMP_DIR => "$tdir/sybase_extra_dump";
18
19 my $dsn      = $ENV{DBICTEST_SYBASE_DSN} || '';
20 my $user     = $ENV{DBICTEST_SYBASE_USER} || '';
21 my $password = $ENV{DBICTEST_SYBASE_PASS} || '';
22
23 BEGIN { $ENV{DBIC_SYBASE_FREETDS_NOWARN} = 1 }
24
25 my ($schema, $databases_created); # for cleanup in END for extra tests
26
27 my $tester = dbixcsl_common_tests->new(
28     vendor      => 'sybase',
29     auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
30     default_function     => 'getdate()',
31     default_function_def => 'AS getdate()',
32     dsn         => $dsn,
33     user        => $user,
34     password    => $password,
35     data_types  => {
36         # http://ispirer.com/wiki/sqlways/sybase/data-types
37         #
38         # Numeric Types
39         'integer identity' => { data_type => 'integer', is_auto_increment => 1 },
40         int      => { data_type => 'integer' },
41         integer  => { data_type => 'integer' },
42         bigint   => { data_type => 'bigint' },
43         smallint => { data_type => 'smallint' },
44         tinyint  => { data_type => 'tinyint' },
45         'double precision' => { data_type => 'double precision' },
46         real           => { data_type => 'real' },
47         float          => { data_type => 'double precision' },
48         'float(14)'    => { data_type => 'real' },
49         'float(15)'    => { data_type => 'real' },
50         'float(16)'    => { data_type => 'double precision' },
51         'float(48)'    => { data_type => 'double precision' },
52         'numeric(6,3)' => { data_type => 'numeric', size => [6,3] },
53         'decimal(6,3)' => { data_type => 'numeric', size => [6,3] },
54         numeric        => { data_type => 'numeric' },
55         decimal        => { data_type => 'numeric' },
56         bit            => { data_type => 'bit' },
57
58         # Money Types
59         money          => { data_type => 'money' },
60         smallmoney     => { data_type => 'smallmoney' },
61
62         # Computed Column
63         'AS getdate()'     => { data_type => undef, inflate_datetime => 1, default_value => \'getdate()' },
64
65         # Blob Types
66         text     => { data_type => 'text' },
67         unitext  => { data_type => 'unitext' },
68         image    => { data_type => 'image' },
69
70         # DateTime Types
71         date     => { data_type => 'date' },
72         time     => { data_type => 'time' },
73         datetime => { data_type => 'datetime' },
74         smalldatetime  => { data_type => 'smalldatetime' },
75
76         # Timestamp column
77         timestamp      => { data_type => 'timestamp', inflate_datetime => 0 },
78
79         # String Types
80         'char'         => { data_type => 'char', size => 1 },
81         'char(2)'      => { data_type => 'char', size => 2 },
82         'nchar'        => { data_type => 'nchar', size => 1 },
83         'nchar(2)'     => { data_type => 'nchar', size => 2 },
84         'unichar(2)'   => { data_type => 'unichar', size => 2 },
85         'varchar(2)'   => { data_type => 'varchar', size => 2 },
86         'nvarchar(2)'  => { data_type => 'nvarchar', size => 2 },
87         'univarchar(2)' => { data_type => 'univarchar', size => 2 },
88
89         # Binary Types
90         'binary'       => { data_type => 'binary', size => 1 },
91         'binary(2)'    => { data_type => 'binary', size => 2 },
92         'varbinary(2)' => { data_type => 'varbinary', size => 2 },
93     },
94     # test that named constraints aren't picked up as tables (I can't reproduce this on my machine)
95     failtrigger_warnings => [ qr/^Bad table or view 'sybase_loader_test2_ref_slt1'/ ],
96     extra => {
97         create => [
98             q{
99                 CREATE TABLE sybase_loader_test1 (
100                     id int identity primary key
101                 )
102             },
103             q{
104                 CREATE TABLE sybase_loader_test2 (
105                     id int identity primary key,
106                     sybase_loader_test1_id int,
107                     CONSTRAINT sybase_loader_test2_ref_slt1 FOREIGN KEY (sybase_loader_test1_id) REFERENCES sybase_loader_test1 (id)
108                 )
109             },
110         ],
111         drop => [ qw/sybase_loader_test1 sybase_loader_test2/ ],
112         count => 30 * 4,
113         run => sub {
114             $schema = shift;
115
116             SKIP: {
117                 my $dbh = $schema->storage->dbh;
118
119                 try {
120                     $dbh->do('USE master');
121                 }
122                 catch {
123                     skip "these tests require the sysadmin role", 30 * 4;
124                 };
125
126                 try {
127                     $dbh->do('CREATE DATABASE [dbicsl_test1]');
128                     $dbh->do('CREATE DATABASE [dbicsl_test2]');
129                 }
130                 catch {
131                     skip "cannot create databases: $_", 30 * 4;
132                 };
133
134                 try {
135                     local $SIG{__WARN__} = sigwarn_silencer(
136                         qr/^Password correctly set\.$|^Account unlocked\.$|^New login created\.$|^New user added\.$/
137                     );
138
139                     $dbh->do("sp_addlogin dbicsl_user1, dbicsl, [dbicsl_test1]");
140                     $dbh->do("sp_addlogin dbicsl_user2, dbicsl, [dbicsl_test2]");
141
142                     $dbh->do("USE [dbicsl_test1]");
143                     $dbh->do("sp_adduser dbicsl_user1");
144                     $dbh->do("sp_adduser dbicsl_user2");
145                     $dbh->do("GRANT ALL TO dbicsl_user1");
146                     $dbh->do("GRANT ALL TO dbicsl_user2");
147
148                     $dbh->do("USE [dbicsl_test2]");
149                     $dbh->do("sp_adduser dbicsl_user2");
150                     $dbh->do("sp_adduser dbicsl_user1");
151                     $dbh->do("GRANT ALL TO dbicsl_user2");
152                     $dbh->do("GRANT ALL TO dbicsl_user1");
153                 }
154                 catch {
155                     skip "cannot add logins: $_", 30 * 4;
156                 };
157
158                 my ($dbh1, $dbh2);
159                 {
160                     local $SIG{__WARN__} = sigwarn_silencer(
161                         qr/can't change context/
162                     );
163                     $dbh1 = DBI->connect($dsn, 'dbicsl_user1', 'dbicsl', {
164                         RaiseError => 1,
165                         PrintError => 0,
166                     });
167                     $dbh1->do('USE [dbicsl_test1]');
168
169                     $dbh2 = DBI->connect($dsn, 'dbicsl_user2', 'dbicsl', {
170                         RaiseError => 1,
171                         PrintError => 0,
172                     });
173                     $dbh2->do('USE [dbicsl_test2]');
174                 }
175
176                 $dbh1->do(<<"EOF");
177                     CREATE TABLE sybase_loader_test4 (
178                         id INT IDENTITY PRIMARY KEY,
179                         value VARCHAR(100) NULL
180                     )
181 EOF
182                 $dbh1->do('GRANT ALL ON sybase_loader_test4 TO dbicsl_user2');
183                 $dbh1->do(<<"EOF");
184                     CREATE TABLE sybase_loader_test5 (
185                         id INT IDENTITY PRIMARY KEY,
186                         value VARCHAR(100) NULL,
187                         four_id INTEGER,
188                         CONSTRAINT loader_test5_uniq UNIQUE (four_id),
189                         FOREIGN KEY (four_id) REFERENCES sybase_loader_test4 (id)
190                     )
191 EOF
192                 $dbh2->do(<<"EOF");
193                     CREATE TABLE sybase_loader_test5 (
194                         pk INT IDENTITY PRIMARY KEY,
195                         value VARCHAR(100) NULL,
196                         four_id INTEGER,
197                         CONSTRAINT loader_test5_uniq UNIQUE (four_id),
198                         FOREIGN KEY (four_id) REFERENCES [dbicsl_test1].dbicsl_user1.sybase_loader_test4 (id)
199                     )
200 EOF
201                 $dbh2->do(<<"EOF");
202                     CREATE TABLE sybase_loader_test6 (
203                         id INT IDENTITY PRIMARY KEY,
204                         value VARCHAR(100) NULL,
205                         sybase_loader_test4_id INTEGER NULL,
206                         FOREIGN KEY (sybase_loader_test4_id) REFERENCES [dbicsl_test1].dbicsl_user1.sybase_loader_test4 (id)
207                     )
208 EOF
209                 $dbh2->do(<<"EOF");
210                     CREATE TABLE sybase_loader_test7 (
211                         id INT IDENTITY PRIMARY KEY,
212                         value VARCHAR(100) NULL,
213                         six_id INTEGER UNIQUE,
214                         FOREIGN KEY (six_id) REFERENCES sybase_loader_test6 (id)
215                     )
216 EOF
217                 $dbh2->do('GRANT ALL ON sybase_loader_test7 TO dbicsl_user1');
218                 $dbh1->do(<<"EOF");
219                     CREATE TABLE sybase_loader_test8 (
220                         id INT IDENTITY PRIMARY KEY,
221                         value VARCHAR(100) NULL,
222                         sybase_loader_test7_id INTEGER,
223                         FOREIGN KEY (sybase_loader_test7_id) REFERENCES [dbicsl_test2].dbicsl_user2.sybase_loader_test7 (id)
224                     )
225 EOF
226
227                 $databases_created = 1;
228
229                 foreach my $databases (['dbicsl_test1', 'dbicsl_test2'], '%') {
230                     foreach my $owners ([qw/dbicsl_user1 dbicsl_user2/], '%') {
231                         lives_and {
232                             rmtree EXTRA_DUMP_DIR;
233
234                             my @warns;
235                             local $SIG{__WARN__} = sub {
236                                 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/
237                                     || $_[0] =~ /can't change context/;
238                             };
239
240                             my $database = $databases;
241
242                             $database = [ $database ] unless ref $database;
243
244                             my $db_schema = {};
245
246                             foreach my $db (@$database) {
247                                 $db_schema->{$db} = $owners;
248                             }
249
250                             make_schema_at(
251                                 'SybaseMultiSchema',
252                                 {
253                                     naming => 'current',
254                                     db_schema => $db_schema,
255                                     dump_directory => EXTRA_DUMP_DIR,
256                                     quiet => 1,
257                                 },
258                                 [ $dsn, $user, $password ],
259                             );
260
261                             SybaseMultiSchema->storage->disconnect;
262
263                             diag join "\n", @warns if @warns;
264
265                             is @warns, 0;
266                         } 'dumped schema for "dbicsl_test1" and "dbicsl_test2" databases with no warnings';
267
268                         my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
269
270                         lives_and {
271                             ok $test_schema = SybaseMultiSchema->connect($dsn, $user, $password);
272                         } 'connected test schema';
273
274                         lives_and {
275                             ok $rsrc = $test_schema->source('SybaseLoaderTest4');
276                         } 'got source for table in database one';
277
278                         is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
279                             'column in database one';
280
281                         is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
282                             'column in database one';
283
284                         is try { $rsrc->column_info('value')->{size} }, 100,
285                             'column in database one';
286
287                         lives_and {
288                             ok $rs = $test_schema->resultset('SybaseLoaderTest4');
289                         } 'got resultset for table in database one';
290
291                         lives_and {
292                             ok $row = $rs->create({ value => 'foo' });
293                         } 'executed SQL on table in database one';
294
295                         $rel_info = try { $rsrc->relationship_info('dbicsl_test1_sybase_loader_test5') };
296
297                         is_deeply $rel_info->{cond}, {
298                             'foreign.four_id' => 'self.id'
299                         }, 'relationship in database one';
300
301                         is $rel_info->{attrs}{accessor}, 'single',
302                             'relationship in database one';
303
304                         is $rel_info->{attrs}{join_type}, 'LEFT',
305                             'relationship in database one';
306
307                         lives_and {
308                             ok $rsrc = $test_schema->source('DbicslTest1SybaseLoaderTest5');
309                         } 'got source for table in database one';
310
311                         %uniqs = try { $rsrc->unique_constraints };
312
313                         is keys %uniqs, 2,
314                             'got unique and primary constraint in database one';
315
316                         delete $uniqs{primary};
317
318                         is_deeply ((values %uniqs)[0], ['four_id'],
319                             'correct unique constraint in database one');
320
321                         lives_and {
322                             ok $rsrc = $test_schema->source('SybaseLoaderTest6');
323                         } 'got source for table in database two';
324
325                         is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
326                             'column in database two introspected correctly';
327
328                         is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
329                             'column in database two introspected correctly';
330
331                         is try { $rsrc->column_info('value')->{size} }, 100,
332                             'column in database two introspected correctly';
333
334                         lives_and {
335                             ok $rs = $test_schema->resultset('SybaseLoaderTest6');
336                         } 'got resultset for table in database two';
337
338                         lives_and {
339                             ok $row = $rs->create({ value => 'foo' });
340                         } 'executed SQL on table in database two';
341
342                         $rel_info = try { $rsrc->relationship_info('sybase_loader_test7') };
343
344                         is_deeply $rel_info->{cond}, {
345                             'foreign.six_id' => 'self.id'
346                         }, 'relationship in database two';
347
348                         is $rel_info->{attrs}{accessor}, 'single',
349                             'relationship in database two';
350
351                         is $rel_info->{attrs}{join_type}, 'LEFT',
352                             'relationship in database two';
353
354                         lives_and {
355                             ok $rsrc = $test_schema->source('SybaseLoaderTest7');
356                         } 'got source for table in database two';
357
358                         %uniqs = try { $rsrc->unique_constraints };
359
360                         is keys %uniqs, 2,
361                             'got unique and primary constraint in database two';
362
363                         delete $uniqs{primary};
364
365                         is_deeply ((values %uniqs)[0], ['six_id'],
366                             'correct unique constraint in database two');
367
368                         lives_and {
369                             ok $test_schema->source('SybaseLoaderTest6')
370                                 ->has_relationship('sybase_loader_test4');
371                         } 'cross-database relationship in multi database schema';
372
373                         lives_and {
374                             ok $test_schema->source('SybaseLoaderTest4')
375                                 ->has_relationship('sybase_loader_test6s');
376                         } 'cross-database relationship in multi database schema';
377
378                         lives_and {
379                             ok $test_schema->source('SybaseLoaderTest8')
380                                 ->has_relationship('sybase_loader_test7');
381                         } 'cross-database relationship in multi database schema';
382
383                         lives_and {
384                             ok $test_schema->source('SybaseLoaderTest7')
385                                 ->has_relationship('sybase_loader_test8s');
386                         } 'cross-database relationship in multi database schema';
387                     }
388                 }
389             }
390         },
391     },
392 );
393
394 if( !$dsn || !$user ) {
395     $tester->skip_tests('You need to set the DBICTEST_SYBASE_DSN, _USER, and _PASS environment variables');
396 }
397 else {
398     $tester->run_tests();
399 }
400
401 END {
402     if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
403         rmtree EXTRA_DUMP_DIR;
404
405         if ($databases_created) {
406             my $dbh = $schema->storage->dbh;
407
408             $dbh->do('USE master');
409
410             local $dbh->{FetchHashKeyName} = 'NAME_lc';
411
412             my $sth = $dbh->prepare('sp_who');
413             $sth->execute;
414
415             while (my $row = $sth->fetchrow_hashref) {
416                 if ($row->{dbname} =~ /^dbicsl_test[12]\z/) {
417                     $dbh->do("kill $row->{spid}");
418                 }
419             }
420
421             foreach my $table ('[dbicsl_test1].dbicsl_user1.sybase_loader_test8',
422                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test7',
423                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test6',
424                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test5',
425                                '[dbicsl_test1].dbicsl_user1.sybase_loader_test5',
426                                '[dbicsl_test1].dbicsl_user1.sybase_loader_test4') {
427                 try {
428                     $dbh->do("DROP TABLE $table");
429                 }
430                 catch {
431                     diag "Error dropping table $table: $_";
432                 };
433             }
434
435             foreach my $db (qw/dbicsl_test1 dbicsl_test2/) {
436                 try {
437                     $dbh->do("DROP DATABASE [$db]");
438                 }
439                 catch {
440                     diag "Error dropping test database $db: $_";
441                 };
442             }
443
444             foreach my $login (qw/dbicsl_user1 dbicsl_user2/) {
445                 try {
446                     local $SIG{__WARN__} = sigwarn_silencer(
447                         qr/^Account locked\.$|^Login dropped\.$/
448                     );
449
450                     $dbh->do("sp_droplogin $login");
451                 }
452                 catch {
453                     diag "Error dropping login $login: $_"
454                         unless /Incorrect syntax/;
455                 };
456             }
457         }
458     }
459 }
460 # vim:et sts=4 sw=4 tw=0: