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