Attempt to fix 'Attempt to free unreferenced scalar' on 5.8
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / 10_05ora_common.t
1 use DBIx::Class::Schema::Loader::Optional::Dependencies
2     -skip_all_without => 'test_rdbms_oracle';
3
4 use strict;
5 use warnings;
6 use Test::More;
7 use Test::Exception;
8 use DBIx::Class::Schema::Loader 'make_schema_at';
9 use DBIx::Class::Schema::Loader::Utils qw/slurp_file split_name/;
10 use Try::Tiny;
11 use File::Path 'rmtree';
12 use String::ToIdentifier::EN::Unicode 'to_identifier';
13
14 use lib qw(t/lib);
15 use dbixcsl_common_tests ();
16 use dbixcsl_test_dir '$tdir';
17
18 use constant EXTRA_DUMP_DIR => "$tdir/ora_extra_dump";
19
20 my $dsn      = $ENV{DBICTEST_ORA_DSN} || '';
21 my $user     = $ENV{DBICTEST_ORA_USER} || '';
22 my $password = $ENV{DBICTEST_ORA_PASS} || '';
23
24 my ($schema, $extra_schema); # for cleanup in END for extra tests
25
26 my $auto_inc_cb = sub {
27     my ($table, $col) = @_;
28     return (
29         qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1},
30         qq{
31             CREATE OR REPLACE TRIGGER ${table}_${col}_trg
32             BEFORE INSERT ON ${table}
33             FOR EACH ROW
34             BEGIN
35                 SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual;
36             END;
37         }
38     );
39 };
40
41 my $auto_inc_drop_cb = sub {
42     my ($table, $col) = @_;
43     return qq{ DROP SEQUENCE ${table}_${col}_seq };
44 };
45
46 dbixcsl_common_tests->new(
47     vendor      => 'Oracle',
48     auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
49     auto_inc_cb => $auto_inc_cb,
50     auto_inc_drop_cb => $auto_inc_drop_cb,
51     preserve_case_mode_is_exclusive => 1,
52     quote_char                      => '"',
53     default_is_deferrable => 0,
54     default_on_delete_clause => 'NO ACTION',
55     default_on_update_clause => 'NO ACTION',
56     dsn         => $dsn,
57     user        => $user,
58     password    => $password,
59     data_types  => {
60         # From:
61         # http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/sql_elements001.htm#i54330
62         #
63         # These tests require at least Oracle 9.2, because of the VARCHAR to
64         # VARCHAR2 casting.
65         #
66         # Character Types
67         'char'         => { data_type => 'char',      size => 1  },
68         'char(11)'     => { data_type => 'char',      size => 11 },
69         'nchar'        => { data_type => 'nchar',     size => 1  },
70         'national character'
71                        => { data_type => 'nchar',     size => 1  },
72         'nchar(11)'    => { data_type => 'nchar',     size => 11 },
73         'national character(11)'
74                        => { data_type => 'nchar',     size => 11 },
75         'varchar(20)'  => { data_type => 'varchar2',  size => 20 },
76         'varchar2(20)' => { data_type => 'varchar2',  size => 20 },
77         'nvarchar2(20)'=> { data_type => 'nvarchar2', size => 20 },
78         'national character varying(20)'
79                        => { data_type => 'nvarchar2', size => 20 },
80
81         # Numeric Types
82         #
83         # integer/decimal/numeric is alised to NUMBER
84         #
85         'integer'      => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
86         'int'          => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
87         'smallint'     => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
88
89         # very long DEFAULT throws an ORA-24345
90         "number(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))" => {
91             data_type => 'numeric', size => [15,0], original => { data_type => 'number' },
92             default_value => \"to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))"
93         },
94
95         'decimal'      => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
96         'dec'          => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
97         'numeric'      => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
98
99         'decimal(3)'   => { data_type => 'numeric', size => [3,0], original => { data_type => 'number' } },
100         'dec(3)'       => { data_type => 'numeric', size => [3,0], original => { data_type => 'number' } },
101         'numeric(3)'   => { data_type => 'numeric', size => [3,0], original => { data_type => 'number' } },
102
103         'decimal(3,3)' => { data_type => 'numeric', size => [3,3], original => { data_type => 'number' } },
104         'dec(3,3)'     => { data_type => 'numeric', size => [3,3], original => { data_type => 'number' } },
105         'numeric(3,3)' => { data_type => 'numeric', size => [3,3], original => { data_type => 'number' } },
106
107         'binary_float'  => { data_type => 'real',             original => { data_type => 'binary_float'  } },
108         'binary_double' => { data_type => 'double precision', original => { data_type => 'binary_double' } },
109
110         # these are not mentioned in the summary chart, must be aliased
111         real            => { data_type => 'real',             original => { data_type => 'float', size => 63  } },
112         'float(63)'     => { data_type => 'real',             original => { data_type => 'float', size => 63  } },
113         'float(64)'     => { data_type => 'double precision', original => { data_type => 'float', size => 64  } },
114         'float(126)'    => { data_type => 'double precision', original => { data_type => 'float', size => 126 } },
115         float           => { data_type => 'double precision', original => { data_type => 'float', size => 126 } },
116
117         # Blob Types
118         'raw(50)'      => { data_type => 'raw', size => 50 },
119         'clob'         => { data_type => 'clob' },
120         'nclob'        => { data_type => 'nclob' },
121         'blob'         => { data_type => 'blob' },
122         'bfile'        => { data_type => 'bfile' },
123         'long'         => { data_type => 'long' },
124         'long raw'     => { data_type => 'long raw' },
125
126         # Datetime Types
127         'date'         => { data_type => 'datetime', original => { data_type => 'date' } },
128         'date default sysdate'
129                        => { data_type => 'datetime', default_value => \'current_timestamp',
130                             original  => { data_type => 'date', default_value => \'sysdate' } },
131         'timestamp'    => { data_type => 'timestamp' },
132         'timestamp default current_timestamp'
133                        => { data_type => 'timestamp', default_value => \'current_timestamp' },
134         'timestamp(3)' => { data_type => 'timestamp', size => 3 },
135         'timestamp with time zone'
136                        => { data_type => 'timestamp with time zone' },
137         'timestamp(3) with time zone'
138                        => { data_type => 'timestamp with time zone', size => 3 },
139         'timestamp with local time zone'
140                        => { data_type => 'timestamp with local time zone' },
141         'timestamp(3) with local time zone'
142                        => { data_type => 'timestamp with local time zone', size => 3 },
143         'interval year to month'
144                        => { data_type => 'interval year to month' },
145         'interval year(3) to month'
146                        => { data_type => 'interval year to month', size => 3 },
147         'interval day to second'
148                        => { data_type => 'interval day to second' },
149         'interval day(3) to second'
150                        => { data_type => 'interval day to second', size => [3,6] },
151         'interval day to second(3)'
152                        => { data_type => 'interval day to second', size => [2,3] },
153         'interval day(3) to second(3)'
154                        => { data_type => 'interval day to second', size => [3,3] },
155
156         # Other Types
157         'rowid'        => { data_type => 'rowid' },
158         'urowid'       => { data_type => 'urowid' },
159         'urowid(3333)' => { data_type => 'urowid', size => 3333 },
160     },
161     extra => {
162         create => [
163             q{
164                 CREATE TABLE oracle_loader_test1 (
165                     id NUMBER(11),
166                     value VARCHAR2(100)
167                 )
168             },
169             q{ COMMENT ON TABLE oracle_loader_test1 IS 'oracle_loader_test1 table comment' },
170             q{ COMMENT ON COLUMN oracle_loader_test1.value IS 'oracle_loader_test1.value column comment' },
171             # 4 through 8 are used for the multi-schema tests
172             q{
173                 create table oracle_loader_test9 (
174                     id int primary key
175                 )
176             },
177             q{
178                 create table oracle_loader_test10 (
179                     id int primary key,
180                     nine_id int,
181                     foreign key (nine_id) references oracle_loader_test9(id)
182                         on delete set null deferrable
183                 )
184             },
185             q{
186                 create table oracle_loader_test11 (
187                     id int primary key disable,
188                     ten_id int unique disable,
189                     foreign key (ten_id) references oracle_loader_test10(id) disable
190                 )
191             },
192             $auto_inc_cb->('oracle_loader_test11', 'id'),
193             'alter trigger oracle_loader_test11_id_trg disable',
194             'CREATE VIEW oracle_loader_test12 AS SELECT * FROM oracle_loader_test1',
195         ],
196         pre_drop_ddl => [
197             'DROP VIEW oracle_loader_test12',
198         ],
199         drop  => [qw/oracle_loader_test1 oracle_loader_test9 oracle_loader_test10 oracle_loader_test11/],
200         count => 12 + 31 * 2,  # basic + cross-schema * 2
201         run   => sub {
202             my ($monikers, $classes);
203             ($schema, $monikers, $classes) = @_;
204
205             SKIP: {
206                 if (my $source = $monikers->{loader_test1s}) {
207                     is $schema->source($source)->column_info('id')->{sequence},
208                         'loader_test1s_id_seq',
209                         'Oracle sequence detection';
210                 }
211                 else {
212                     skip 'not running common tests', 1;
213                 }
214             }
215
216             my $class = $classes->{oracle_loader_test1};
217
218             my $filename = $schema->loader->get_dump_filename($class);
219             my $code = slurp_file $filename;
220
221             like $code, qr/^=head1 NAME\n\n^$class - oracle_loader_test1 table comment\n\n^=cut\n/m,
222                 'table comment';
223
224             like $code, qr/^=head2 value\n\n(.+:.+\n)+\noracle_loader_test1\.value column comment\n\n/m,
225                 'column comment and attrs';
226
227             # test on delete/update fk clause introspection
228             ok ((my $rel_info = $schema->source('OracleLoaderTest10')->relationship_info('nine')),
229                 'got rel info');
230
231             is $rel_info->{attrs}{on_delete}, 'SET NULL',
232                 'ON DELETE clause introspected correctly';
233
234             is $rel_info->{attrs}{on_update}, 'NO ACTION',
235                 'ON UPDATE clause set to NO ACTION by default';
236
237             is $rel_info->{attrs}{is_deferrable}, 1,
238                 'DEFERRABLE clause introspected correctly';
239
240             my $source11 = $schema->source('OracleLoaderTest11');
241
242             # DBD::Oracle < 1.76 doesn't filter out disabled primary keys
243             my $uniqs = eval { DBD::Oracle->VERSION('1.76') } ? [] : ['primary'];
244             is_deeply [keys %{{$source11->unique_constraints}}], $uniqs,
245                 'Disabled unique constraints not loaded';
246
247             ok !$source11->relationship_info('ten'),
248                 'Disabled FK not loaded';
249
250             ok !$source11->column_info('id')->{is_auto_increment},
251                 'Disabled autoinc trigger not loaded';
252
253             my $view_source = $schema->resultset($monikers->{oracle_loader_test12})->result_source;
254             isa_ok $view_source, 'DBIx::Class::ResultSource::View',
255                 'view result source';
256
257             like $view_source->view_definition,
258                 qr/\A \s* select\b .* \bfrom \s+ oracle_loader_test1 \s* \z/imsx,
259                 'view definition';
260
261             SKIP: {
262                 skip 'Set the DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS environment variables to run the cross-schema relationship tests', 31 * 2
263                     unless $ENV{DBICTEST_ORA_EXTRAUSER_DSN};
264
265                 $extra_schema = $schema->clone;
266                 $extra_schema->connection(@ENV{map "DBICTEST_ORA_EXTRAUSER_$_",
267                     qw/DSN USER PASS/
268                 });
269
270                 my $dbh1 = $schema->storage->dbh;
271                 my $dbh2 = $extra_schema->storage->dbh;
272
273                 my ($schema1) = $dbh1->selectrow_array('SELECT USER FROM DUAL');
274                 my ($schema2) = $dbh2->selectrow_array('SELECT USER FROM DUAL');
275
276                 $dbh1->do(<<'EOF');
277                     CREATE TABLE oracle_loader_test4 (
278                         id INT NOT NULL PRIMARY KEY,
279                         value VARCHAR(100)
280                     )
281 EOF
282
283                 $dbh1->do($_) for $auto_inc_cb->(lc "${schema1}.oracle_loader_test4", 'id');
284
285                 $dbh1->do("GRANT ALL ON oracle_loader_test4 TO $schema2");
286                 $dbh1->do("GRANT ALL ON oracle_loader_test4_id_seq TO $schema2");
287
288                 $dbh1->do(<<"EOF");
289                     CREATE TABLE oracle_loader_test5 (
290                         id INT NOT NULL PRIMARY KEY,
291                         value VARCHAR(100),
292                         four_id INT REFERENCES ${schema1}.oracle_loader_test4 (id),
293                         CONSTRAINT ora_loader5_uniq UNIQUE (four_id)
294                     )
295 EOF
296                 $dbh1->do($_) for $auto_inc_cb->('oracle_loader_test5', 'id');
297                 $dbh1->do("GRANT ALL ON oracle_loader_test5 TO $schema2");
298                 $dbh1->do("GRANT ALL ON oracle_loader_test5_id_seq TO $schema2");
299
300                 $dbh2->do(<<"EOF");
301                     CREATE TABLE oracle_loader_test5 (
302                         pk INT NOT NULL PRIMARY KEY,
303                         value VARCHAR(100),
304                         four_id INT REFERENCES ${schema1}.oracle_loader_test4 (id),
305                         CONSTRAINT ora_loader5_uniq UNIQUE (four_id)
306                     )
307 EOF
308                 $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test5', 'pk');
309                 $dbh2->do("GRANT ALL ON oracle_loader_test5 TO $schema1");
310                 $dbh2->do("GRANT ALL ON oracle_loader_test5_pk_seq TO $schema1");
311
312                 $dbh2->do(<<"EOF");
313                     CREATE TABLE oracle_loader_test6 (
314                         id INT NOT NULL PRIMARY KEY,
315                         value VARCHAR(100),
316                         oracle_loader_test4_id INT REFERENCES ${schema1}.oracle_loader_test4 (id)
317                     )
318 EOF
319                 $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test6', 'id');
320                 $dbh2->do("GRANT ALL ON oracle_loader_test6 to $schema1");
321                 $dbh2->do("GRANT ALL ON oracle_loader_test6_id_seq TO $schema1");
322
323                 $dbh2->do(<<"EOF");
324                     CREATE TABLE oracle_loader_test7 (
325                         id INT NOT NULL PRIMARY KEY,
326                         value VARCHAR(100),
327                         six_id INT UNIQUE REFERENCES ${schema2}.oracle_loader_test6 (id)
328                     )
329 EOF
330                 $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test7', 'id');
331                 $dbh2->do("GRANT ALL ON oracle_loader_test7 to $schema1");
332                 $dbh2->do("GRANT ALL ON oracle_loader_test7_id_seq TO $schema1");
333
334                 $dbh1->do(<<"EOF");
335                     CREATE TABLE oracle_loader_test8 (
336                         id INT NOT NULL PRIMARY KEY,
337                         value VARCHAR(100),
338                         oracle_loader_test7_id INT REFERENCES ${schema2}.oracle_loader_test7 (id)
339                     )
340 EOF
341                 $dbh1->do($_) for $auto_inc_cb->('oracle_loader_test8', 'id');
342                 $dbh1->do("GRANT ALL ON oracle_loader_test8 to $schema2");
343                 $dbh1->do("GRANT ALL ON oracle_loader_test8_id_seq TO $schema2");
344
345                 # We add schema to moniker_parts, so make a monikers hash for
346                 # the tests, of the form schemanum.tablenum
347                 my $schema1_moniker = join '', map ucfirst lc, split_name to_identifier $schema1;
348                 my $schema2_moniker = join '', map ucfirst lc, split_name to_identifier $schema2;
349
350                 my %monikers;
351                 $monikers{'1.5'} = $schema1_moniker . 'OracleLoaderTest5';
352                 $monikers{'2.5'} = $schema2_moniker . 'OracleLoaderTest5';
353
354                 foreach my $db_schema ([$schema1, $schema2], '%') {
355                     lives_and {
356                         rmtree EXTRA_DUMP_DIR;
357
358                         my @warns;
359                         local $SIG{__WARN__} = sub {
360                             push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
361                         };
362
363                         make_schema_at(
364                             'OracleMultiSchema',
365                             {
366                                 naming => 'current',
367                                 db_schema => $db_schema,
368                                 dump_directory => EXTRA_DUMP_DIR,
369                                 quiet => 1,
370                             },
371                             [ $dsn, $user, $password ],
372                         );
373
374                         diag join "\n", @warns if @warns;
375
376                         is @warns, 0;
377                     } qq{dumped schema for "$schema1" and "$schema2" schemas with no warnings};
378
379                     my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
380
381                     lives_and {
382                         ok $test_schema = OracleMultiSchema->connect($dsn, $user, $password);
383                     } 'connected test schema';
384
385                     lives_and {
386                         ok $rsrc = $test_schema->source('OracleLoaderTest4');
387                     } 'got source for table in schema1';
388
389                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
390                         'column in schema1';
391
392                     is try { $rsrc->column_info('id')->{sequence} }, lc "${schema1}.oracle_loader_test4_id_seq",
393                         'sequence in schema1';
394
395                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar2',
396                         'column in schema1';
397
398                     is try { $rsrc->column_info('value')->{size} }, 100,
399                         'column in schema1';
400
401                     lives_and {
402                         ok $rs = $test_schema->resultset('OracleLoaderTest4');
403                     } 'got resultset for table in schema1';
404
405                     lives_and {
406                         ok $row = $rs->create({ value => 'foo' });
407                     } 'executed SQL on table in schema1';
408
409                     my $schema1_identifier = join '_', map lc, split_name to_identifier $schema1;
410
411                     $rel_info = try { $rsrc->relationship_info(
412                         $schema1_identifier . '_oracle_loader_test5'
413                     ) };
414
415                     is_deeply $rel_info->{cond}, {
416                         'foreign.four_id' => 'self.id'
417                     }, 'relationship in schema1';
418
419                     is $rel_info->{attrs}{accessor}, 'single',
420                         'relationship in schema1';
421
422                     is $rel_info->{attrs}{join_type}, 'LEFT',
423                         'relationship in schema1';
424
425                     lives_and {
426                         ok $rsrc = $test_schema->source($monikers{'1.5'});
427                     } 'got source for table in schema1';
428
429                     %uniqs = try { $rsrc->unique_constraints };
430
431                     is keys %uniqs, 2,
432                         'got unique and primary constraint in schema1';
433
434                     delete $uniqs{primary};
435
436                     is_deeply ((values %uniqs)[0], ['four_id'],
437                         'correct unique constraint in schema1');
438
439                     lives_and {
440                         ok $rsrc = $test_schema->source('OracleLoaderTest6');
441                     } 'got source for table in schema2';
442
443                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
444                         'column in schema2 introspected correctly';
445
446                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar2',
447                         'column in schema2 introspected correctly';
448
449                     is try { $rsrc->column_info('value')->{size} }, 100,
450                         'column in schema2 introspected correctly';
451
452                     lives_and {
453                         ok $rs = $test_schema->resultset('OracleLoaderTest6');
454                     } 'got resultset for table in schema2';
455
456                     lives_and {
457                         ok $row = $rs->create({ value => 'foo' });
458                     } 'executed SQL on table in schema2';
459
460                     $rel_info = try { $rsrc->relationship_info('oracle_loader_test7') };
461
462                     is_deeply $rel_info->{cond}, {
463                         'foreign.six_id' => 'self.id'
464                     }, 'relationship in schema2';
465
466                     is $rel_info->{attrs}{accessor}, 'single',
467                         'relationship in schema2';
468
469                     is $rel_info->{attrs}{join_type}, 'LEFT',
470                         'relationship in schema2';
471
472                     lives_and {
473                         ok $rsrc = $test_schema->source('OracleLoaderTest7');
474                     } 'got source for table in schema2';
475
476                     %uniqs = try { $rsrc->unique_constraints };
477
478                     is keys %uniqs, 2,
479                         'got unique and primary constraint in schema2';
480
481                     delete $uniqs{primary};
482
483                     is_deeply ((values %uniqs)[0], ['six_id'],
484                         'correct unique constraint in schema2');
485
486                     lives_and {
487                         ok $test_schema->source('OracleLoaderTest6')
488                             ->has_relationship('oracle_loader_test4');
489                     } 'cross-schema relationship in multi-db_schema';
490
491                     lives_and {
492                         ok $test_schema->source('OracleLoaderTest4')
493                             ->has_relationship('oracle_loader_test6s');
494                     } 'cross-schema relationship in multi-db_schema';
495
496                     lives_and {
497                         ok $test_schema->source('OracleLoaderTest8')
498                             ->has_relationship('oracle_loader_test7');
499                     } 'cross-schema relationship in multi-db_schema';
500
501                     lives_and {
502                         ok $test_schema->source('OracleLoaderTest7')
503                             ->has_relationship('oracle_loader_test8s');
504                     } 'cross-schema relationship in multi-db_schema';
505                 }
506             }
507         },
508     },
509 )->run_tests();
510
511
512 END {
513     if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
514         if (my $dbh1 = try { $schema->storage->dbh }) {
515             $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test11','id');
516
517             if (my $dbh2 = try { $extra_schema->storage->dbh }) {
518
519                 try {
520                     $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test8', 'id');
521                     $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test7', 'id');
522                     $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test6', 'id');
523                     $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test5', 'pk');
524                     $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test5', 'id');
525                     $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test4', 'id');
526                 }
527                 catch {
528                     die "Error dropping sequences for cross-schema test tables: $_";
529                 };
530
531                 try {
532                     $dbh1->do('DROP TABLE oracle_loader_test8');
533                     $dbh2->do('DROP TABLE oracle_loader_test7');
534                     $dbh2->do('DROP TABLE oracle_loader_test6');
535                     $dbh2->do('DROP TABLE oracle_loader_test5');
536                     $dbh1->do('DROP TABLE oracle_loader_test5');
537                     $dbh1->do('DROP TABLE oracle_loader_test4');
538                 }
539                 catch {
540                     die "Error dropping cross-schema test tables: $_";
541                 };
542             }
543         }
544         rmtree EXTRA_DUMP_DIR;
545     }
546 }
547 # vim:et sw=4 sts=4 tw=0: