1use strict;
2use warnings;
3use Test::More;
4use Test::Exception;
5use Try::Tiny;
6use File::Path 'rmtree';
7use DBIx::Class::Schema::Loader 'make_schema_at';
8use Scope::Guard ();
9
10use lib qw(t/lib);
11
12use dbixcsl_common_tests;
13use dbixcsl_test_dir '$tdir';
14
15use constant EXTRA_DUMP_DIR => "$tdir/sqlanywhere_extra_dump";
16
17# The default max_cursor_count and max_statement_count settings of 50 are too
18# low to run this test.
19#
20# Setting them to zero is preferred.
21
22my $dbd_sqlanywhere_dsn      = $ENV{DBICTEST_SQLANYWHERE_DSN} || '';
23my $dbd_sqlanywhere_user     = $ENV{DBICTEST_SQLANYWHERE_USER} || '';
24my $dbd_sqlanywhere_password = $ENV{DBICTEST_SQLANYWHERE_PASS} || '';
25
26my $odbc_dsn      = $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN} || '';
27my $odbc_user     = $ENV{DBICTEST_SQLANYWHERE_ODBC_USER} || '';
28my $odbc_password = $ENV{DBICTEST_SQLANYWHERE_ODBC_PASS} || '';
29
30my ($schema, $schemas_created); # for cleanup in END for extra tests
31
32my $tester = dbixcsl_common_tests->new(
33    vendor      => 'SQLAnywhere',
34    auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
35    connect_info => [ ($dbd_sqlanywhere_dsn ? {
36            dsn         => $dbd_sqlanywhere_dsn,
37            user        => $dbd_sqlanywhere_user,
38            password    => $dbd_sqlanywhere_password,
39        } : ()),
40        ($odbc_dsn ? {
41            dsn         => $odbc_dsn,
42            user        => $odbc_user,
43            password    => $odbc_password,
44        } : ()),
45    ],
46    loader_options => { preserve_case => 1 },
47    data_types  => {
48        # http://infocenter.sybase.com/help/topic/com.sybase.help.sqlanywhere.11.0.1/dbreference_en11/rf-datatypes.html
49        #
50        # Numeric types
51        'bit'         => { data_type => 'bit' },
52        'tinyint'     => { data_type => 'tinyint' },
53        'smallint'    => { data_type => 'smallint' },
54        'int'         => { data_type => 'integer' },
55        'integer'     => { data_type => 'integer' },
56        'bigint'      => { data_type => 'bigint' },
57        'float'       => { data_type => 'real' },
58        'real'        => { data_type => 'real' },
59        'double'      => { data_type => 'double precision' },
60        'double precision' =>
61                         { data_type => 'double precision' },
62
63        'float(2)'    => { data_type => 'real' },
64        'float(24)'   => { data_type => 'real' },
65        'float(25)'   => { data_type => 'double precision' },
66        'float(53)'   => { data_type => 'double precision' },
67
68        # This test only works with the default precision and scale options.
69        #
70        # They are preserved even for the default values, because the defaults
71        # can be changed.
72        'decimal'     => { data_type => 'decimal', size => [30,6] },
73        'dec'         => { data_type => 'decimal', size => [30,6] },
74        'numeric'     => { data_type => 'numeric', size => [30,6] },
75
76        'decimal(3)'   => { data_type => 'decimal', size => [3,0] },
77        'dec(3)'       => { data_type => 'decimal', size => [3,0] },
78        'numeric(3)'   => { data_type => 'numeric', size => [3,0] },
79
80        'decimal(3,3)' => { data_type => 'decimal', size => [3,3] },
81        'dec(3,3)'     => { data_type => 'decimal', size => [3,3] },
82        'numeric(3,3)' => { data_type => 'numeric', size => [3,3] },
83
84        'decimal(18,18)' => { data_type => 'decimal', size => [18,18] },
85        'dec(18,18)'     => { data_type => 'decimal', size => [18,18] },
86        'numeric(18,18)' => { data_type => 'numeric', size => [18,18] },
87
88        # money types
89        'money'        => { data_type => 'money' },
90        'smallmoney'   => { data_type => 'smallmoney' },
91
92        # bit arrays
93        'long varbit'  => { data_type => 'long varbit' },
94        'long bit varying'
95                       => { data_type => 'long varbit' },
96        'varbit'       => { data_type => 'varbit', size => 1 },
97        'varbit(20)'   => { data_type => 'varbit', size => 20 },
98        'bit varying'  => { data_type => 'varbit', size => 1 },
99        'bit varying(20)'
100                       => { data_type => 'varbit', size => 20 },
101
102        # Date and Time Types
103        'date'        => { data_type => 'date' },
104        'datetime'    => { data_type => 'datetime' },
105        'smalldatetime'
106                      => { data_type => 'smalldatetime' },
107        'timestamp'   => { data_type => 'timestamp' },
108        # rewrite 'current timestamp' as 'current_timestamp'
109        'timestamp default current timestamp'
110                      => { data_type => 'timestamp', default_value => \'current_timestamp',
111                           original => { default_value => \'current timestamp' } },
112        'time'        => { data_type => 'time' },
113
114        # String Types
115        'char'         => { data_type => 'char',      size => 1  },
116        'char(11)'     => { data_type => 'char',      size => 11 },
117        'nchar'        => { data_type => 'nchar',     size => 1  },
118        'nchar(11)'    => { data_type => 'nchar',     size => 11 },
119        'varchar'      => { data_type => 'varchar',   size => 1  },
120        'varchar(20)'  => { data_type => 'varchar',   size => 20 },
121        'char varying(20)'
122                       => { data_type => 'varchar',   size => 20 },
123        'character varying(20)'
124                       => { data_type => 'varchar',   size => 20 },
125        'nvarchar(20)' => { data_type => 'nvarchar',  size => 20 },
126        'xml'          => { data_type => 'xml' },
127        'uniqueidentifierstr'
128                       => { data_type => 'uniqueidentifierstr' },
129
130        # Binary types
131        'binary'       => { data_type => 'binary', size => 1 },
132        'binary(20)'   => { data_type => 'binary', size => 20 },
133        'varbinary'    => { data_type => 'varbinary', size => 1 },
134        'varbinary(20)'=> { data_type => 'varbinary', size => 20 },
135        'uniqueidentifier'
136                       => { data_type => 'uniqueidentifier' },
137
138        # Blob types
139        'long binary'  => { data_type => 'long binary' },
140        'image'        => { data_type => 'image' },
141        'long varchar' => { data_type => 'long varchar' },
142        'text'         => { data_type => 'text' },
143        'long nvarchar'=> { data_type => 'long nvarchar' },
144        'ntext'        => { data_type => 'ntext' },
145    },
146    extra => {
147        count => 30 * 2,
148        run => sub {
149            SKIP: {
150                $schema  = $_[0];
151                my $self = $_[3];
152
153                my $connect_info = [@$self{qw/dsn user password/}];
154
155                my $dbh = $schema->storage->dbh;
156
157                try {
158                    $dbh->do("CREATE USER dbicsl_test1 identified by 'dbicsl'");
159                }
160                catch {
161                    $schemas_created = 0;
162                    skip "no CREATE USER privileges", 30 * 2;
163                };
164
165                $dbh->do(<<"EOF");
166                    CREATE TABLE dbicsl_test1.sqlanywhere_loader_test4 (
167                        id INT IDENTITY NOT NULL PRIMARY KEY,
168                        value VARCHAR(100)
169                    )
170EOF
171                $dbh->do(<<"EOF");
172                    CREATE TABLE dbicsl_test1.sqlanywhere_loader_test5 (
173                        id INT IDENTITY NOT NULL PRIMARY KEY,
174                        value VARCHAR(100),
175                        four_id INTEGER NOT NULL,
176                        CONSTRAINT loader_test5_uniq UNIQUE (four_id),
177                        FOREIGN KEY (four_id) REFERENCES dbicsl_test1.sqlanywhere_loader_test4 (id)
178                    )
179EOF
180                $dbh->do("CREATE USER dbicsl_test2 identified by 'dbicsl'");
181                $dbh->do(<<"EOF");
182                    CREATE TABLE dbicsl_test2.sqlanywhere_loader_test5 (
183                        pk INT IDENTITY NOT NULL PRIMARY KEY,
184                        value VARCHAR(100),
185                        four_id INTEGER NOT NULL,
186                        CONSTRAINT loader_test5_uniq UNIQUE (four_id),
187                        FOREIGN KEY (four_id) REFERENCES dbicsl_test1.sqlanywhere_loader_test4 (id)
188                    )
189EOF
190                $dbh->do(<<"EOF");
191                    CREATE TABLE dbicsl_test2.sqlanywhere_loader_test6 (
192                        id INT IDENTITY NOT NULL PRIMARY KEY,
193                        value VARCHAR(100),
194                        sqlanywhere_loader_test4_id INTEGER,
195                        FOREIGN KEY (sqlanywhere_loader_test4_id) REFERENCES dbicsl_test1.sqlanywhere_loader_test4 (id)
196                    )
197EOF
198                $dbh->do(<<"EOF");
199                    CREATE TABLE dbicsl_test2.sqlanywhere_loader_test7 (
200                        id INT IDENTITY NOT NULL PRIMARY KEY,
201                        value VARCHAR(100),
202                        six_id INTEGER NOT NULL UNIQUE,
203                        FOREIGN KEY (six_id) REFERENCES dbicsl_test2.sqlanywhere_loader_test6 (id)
204                    )
205EOF
206                $dbh->do(<<"EOF");
207                    CREATE TABLE dbicsl_test1.sqlanywhere_loader_test8 (
208                        id INT IDENTITY NOT NULL PRIMARY KEY,
209                        value VARCHAR(100),
210                        sqlanywhere_loader_test7_id INTEGER,
211                        FOREIGN KEY (sqlanywhere_loader_test7_id) REFERENCES dbicsl_test2.sqlanywhere_loader_test7 (id)
212                    )
213EOF
214
215                $schemas_created = 1;
216
217                my $guard = Scope::Guard->new(\&extra_cleanup);
218
219                foreach my $db_schema (['dbicsl_test1', 'dbicsl_test2'], '%') {
220                    lives_and {
221                        rmtree EXTRA_DUMP_DIR;
222
223                        my @warns;
224                        local $SIG{__WARN__} = sub {
225                            push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
226                        };
227
228                        make_schema_at(
229                            'SQLAnywhereMultiSchema',
230                            {
231                                naming => 'current',
232                                db_schema => $db_schema,
233                                dump_directory => EXTRA_DUMP_DIR,
234                                quiet => 1,
235                            },
236                            $connect_info,
237                        );
238
239                        diag join "\n", @warns if @warns;
240
241                        is @warns, 0;
242                    } 'dumped schema for dbicsl_test1 and dbicsl_test2 schemas with no warnings';
243
244                    my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
245
246                    lives_and {
247                        ok $test_schema = SQLAnywhereMultiSchema->connect(@$connect_info);
248                    } 'connected test schema';
249
250                    lives_and {
251                        ok $rsrc = $test_schema->source('SqlanywhereLoaderTest4');
252                    } 'got source for table in schema one';
253
254                    is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
255                        'column in schema one';
256
257                    is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
258                        'column in schema one';
259
260                    is try { $rsrc->column_info('value')->{size} }, 100,
261                        'column in schema one';
262
263                    lives_and {
264                        ok $rs = $test_schema->resultset('SqlanywhereLoaderTest4');
265                    } 'got resultset for table in schema one';
266
267                    lives_and {
268                        ok $row = $rs->create({ value => 'foo' });
269                    } 'executed SQL on table in schema one';
270
271                    $rel_info = try { $rsrc->relationship_info('dbicsl_test1_sqlanywhere_loader_test5') };
272
273                    is_deeply $rel_info->{cond}, {
274                        'foreign.four_id' => 'self.id'
275                    }, 'relationship in schema one';
276
277                    is $rel_info->{attrs}{accessor}, 'single',
278                        'relationship in schema one';
279
280                    is $rel_info->{attrs}{join_type}, 'LEFT',
281                        'relationship in schema one';
282
283                    lives_and {
284                        ok $rsrc = $test_schema->source('DbicslTest1SqlanywhereLoaderTest5');
285                    } 'got source for table in schema one';
286
287                    %uniqs = try { $rsrc->unique_constraints };
288
289                    is keys %uniqs, 2,
290                        'got unique and primary constraint in schema one';
291
292                    delete $uniqs{primary};
293
294                    is_deeply ((values %uniqs)[0], ['four_id'],
295                        'correct unique constraint in schema one');
296
297                    lives_and {
298                        ok $rsrc = $test_schema->source('SqlanywhereLoaderTest6');
299                    } 'got source for table in schema two';
300
301                    is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
302                        'column in schema two introspected correctly';
303
304                    is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
305                        'column in schema two introspected correctly';
306
307                    is try { $rsrc->column_info('value')->{size} }, 100,
308                        'column in schema two introspected correctly';
309
310                    lives_and {
311                        ok $rs = $test_schema->resultset('SqlanywhereLoaderTest6');
312                    } 'got resultset for table in schema two';
313
314                    lives_and {
315                        ok $row = $rs->create({ value => 'foo' });
316                    } 'executed SQL on table in schema two';
317
318                    $rel_info = try { $rsrc->relationship_info('sqlanywhere_loader_test7') };
319
320                    is_deeply $rel_info->{cond}, {
321                        'foreign.six_id' => 'self.id'
322                    }, 'relationship in schema two';
323
324                    is $rel_info->{attrs}{accessor}, 'single',
325                        'relationship in schema two';
326
327                    is $rel_info->{attrs}{join_type}, 'LEFT',
328                        'relationship in schema two';
329
330                    lives_and {
331                        ok $rsrc = $test_schema->source('SqlanywhereLoaderTest7');
332                    } 'got source for table in schema two';
333
334                    %uniqs = try { $rsrc->unique_constraints };
335
336                    is keys %uniqs, 2,
337                        'got unique and primary constraint in schema two';
338
339                    delete $uniqs{primary};
340
341                    is_deeply ((values %uniqs)[0], ['six_id'],
342                        'correct unique constraint in schema two');
343
344                    lives_and {
345                        ok $test_schema->source('SqlanywhereLoaderTest6')
346                            ->has_relationship('sqlanywhere_loader_test4');
347                    } 'cross-schema relationship in multi-db_schema';
348
349                    lives_and {
350                        ok $test_schema->source('SqlanywhereLoaderTest4')
351                            ->has_relationship('sqlanywhere_loader_test6s');
352                    } 'cross-schema relationship in multi-db_schema';
353
354                    lives_and {
355                        ok $test_schema->source('SqlanywhereLoaderTest8')
356                            ->has_relationship('sqlanywhere_loader_test7');
357                    } 'cross-schema relationship in multi-db_schema';
358
359                    lives_and {
360                        ok $test_schema->source('SqlanywhereLoaderTest7')
361                            ->has_relationship('sqlanywhere_loader_test8s');
362                    } 'cross-schema relationship in multi-db_schema';
363                }
364            }
365        },
366    },
367);
368
369if (not ($dbd_sqlanywhere_dsn || $odbc_dsn)) {
370    $tester->skip_tests('You need to set the DBICTEST_SQLANYWHERE_DSN, _USER and _PASS and/or the DBICTEST_SQLANYWHERE_ODBC_DSN, _USER and _PASS environment variables');
371}
372else {
373    $tester->run_tests();
374}
375
376sub extra_cleanup {
377    if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
378        if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
379            foreach my $table ('dbicsl_test1.sqlanywhere_loader_test8',
380                               'dbicsl_test2.sqlanywhere_loader_test7',
381                               'dbicsl_test2.sqlanywhere_loader_test6',
382                               'dbicsl_test2.sqlanywhere_loader_test5',
383                               'dbicsl_test1.sqlanywhere_loader_test5',
384                               'dbicsl_test1.sqlanywhere_loader_test4') {
385                try {
386                    $dbh->do("DROP TABLE $table");
387                }
388                catch {
389                    diag "Error dropping table: $_";
390                };
391            }
392
393            foreach my $db_schema (qw/dbicsl_test1 dbicsl_test2/) {
394                try {
395                    $dbh->do("DROP USER $db_schema");
396                }
397                catch {
398                    diag "Error dropping test user $db_schema: $_";
399                };
400            }
401        }
402        rmtree EXTRA_DUMP_DIR;
403    }
404}
405# vim:et sts=4 sw=4 tw=0:
406