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