+use DBIx::Class::Schema::Loader::Optional::Dependencies
+ -skip_all_without => 'test_rdbms_oracle';
+
use strict;
-use lib qw(t/lib);
-use dbixcsl_common_tests;
+use warnings;
use Test::More;
use Test::Exception;
-use File::Slurp ();
+use DBIx::Class::Schema::Loader 'make_schema_at';
+use DBIx::Class::Schema::Loader::Utils qw/slurp_file split_name/;
+use Try::Tiny;
+use File::Path 'rmtree';
+use String::ToIdentifier::EN::Unicode 'to_identifier';
+use namespace::clean;
+
+use lib qw(t/lib);
+use dbixcsl_common_tests ();
+use dbixcsl_test_dir '$tdir';
+
+use constant EXTRA_DUMP_DIR => "$tdir/ora_extra_dump";
my $dsn = $ENV{DBICTEST_ORA_DSN} || '';
my $user = $ENV{DBICTEST_ORA_USER} || '';
my $password = $ENV{DBICTEST_ORA_PASS} || '';
-my $tester = dbixcsl_common_tests->new(
+my ($schema, $extra_schema); # for cleanup in END for extra tests
+
+my $auto_inc_cb = sub {
+ my ($table, $col) = @_;
+ return (
+ qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1},
+ qq{
+ CREATE OR REPLACE TRIGGER ${table}_${col}_trg
+ BEFORE INSERT ON ${table}
+ FOR EACH ROW
+ BEGIN
+ SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual;
+ END;
+ }
+ );
+};
+
+my $auto_inc_drop_cb = sub {
+ my ($table, $col) = @_;
+ return qq{ DROP SEQUENCE ${table}_${col}_seq };
+};
+
+dbixcsl_common_tests->new(
vendor => 'Oracle',
auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
- auto_inc_cb => sub {
- my ($table, $col) = @_;
- return (
- qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1},
- qq{
- CREATE OR REPLACE TRIGGER ${table}_${col}_trigger
- BEFORE INSERT ON ${table}
- FOR EACH ROW
- BEGIN
- SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual;
- END;
- }
- );
- },
- auto_inc_drop_cb => sub {
- my ($table, $col) = @_;
- return qq{ DROP SEQUENCE ${table}_${col}_seq };
- },
+ auto_inc_cb => $auto_inc_cb,
+ auto_inc_drop_cb => $auto_inc_drop_cb,
preserve_case_mode_is_exclusive => 1,
quote_char => '"',
+ default_is_deferrable => 0,
+ default_on_delete_clause => 'NO ACTION',
+ default_on_update_clause => 'NO ACTION',
dsn => $dsn,
user => $user,
password => $password,
'int' => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
'smallint' => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
+ # very long DEFAULT throws an ORA-24345
+ "number(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))" => {
+ data_type => 'numeric', size => [15,0], original => { data_type => 'number' },
+ default_value => \"to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))"
+ },
+
'decimal' => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
'dec' => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
'numeric' => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
},
extra => {
create => [
- q{
+ q{
CREATE TABLE oracle_loader_test1 (
id NUMBER(11),
value VARCHAR2(100)
},
q{ COMMENT ON TABLE oracle_loader_test1 IS 'oracle_loader_test1 table comment' },
q{ COMMENT ON COLUMN oracle_loader_test1.value IS 'oracle_loader_test1.value column comment' },
+ # 4 through 8 are used for the multi-schema tests
+ q{
+ create table oracle_loader_test9 (
+ id int primary key
+ )
+ },
+ q{
+ create table oracle_loader_test10 (
+ id int primary key,
+ nine_id int,
+ foreign key (nine_id) references oracle_loader_test9(id)
+ on delete set null deferrable
+ )
+ },
+ q{
+ create table oracle_loader_test11 (
+ id int primary key disable,
+ ten_id int unique disable,
+ foreign key (ten_id) references oracle_loader_test10(id) disable
+ )
+ },
+ $auto_inc_cb->('oracle_loader_test11', 'id'),
+ 'alter trigger oracle_loader_test11_id_trg disable',
],
- drop => [qw/oracle_loader_test1/],
- count => 3,
+ drop => [qw/oracle_loader_test1 oracle_loader_test9 oracle_loader_test10 oracle_loader_test11/],
+ count => 10 + 31 * 2, # basic + cross-schema * 2
run => sub {
- my ($schema, $monikers, $classes) = @_;
+ my ($monikers, $classes);
+ ($schema, $monikers, $classes) = @_;
SKIP: {
if (my $source = $monikers->{loader_test1s}) {
}
my $class = $classes->{oracle_loader_test1};
- my $filename = $schema->_loader->get_dump_filename($class);
- my $code = File::Slurp::slurp $filename;
+
+ my $filename = $schema->loader->get_dump_filename($class);
+ my $code = slurp_file $filename;
like $code, qr/^=head1 NAME\n\n^$class - oracle_loader_test1 table comment\n\n^=cut\n/m,
'table comment';
like $code, qr/^=head2 value\n\n(.+:.+\n)+\noracle_loader_test1\.value column comment\n\n/m,
'column comment and attrs';
+
+ # test on delete/update fk clause introspection
+ ok ((my $rel_info = $schema->source('OracleLoaderTest10')->relationship_info('nine')),
+ 'got rel info');
+
+ is $rel_info->{attrs}{on_delete}, 'SET NULL',
+ 'ON DELETE clause introspected correctly';
+
+ is $rel_info->{attrs}{on_update}, 'NO ACTION',
+ 'ON UPDATE clause set to NO ACTION by default';
+
+ is $rel_info->{attrs}{is_deferrable}, 1,
+ 'DEFERRABLE clause introspected correctly';
+
+ my $source11 = $schema->source('OracleLoaderTest11');
+
+ # DBD::Oracle < 1.76 doesn't filter out disabled primary keys
+ my $uniqs = eval { DBD::Oracle->VERSION('1.76') } ? [] : ['primary'];
+ is_deeply [keys %{{$source11->unique_constraints}}], $uniqs,
+ 'Disabled unique constraints not loaded';
+
+ ok !$source11->relationship_info('ten'),
+ 'Disabled FK not loaded';
+
+ ok !$source11->column_info('id')->{is_auto_increment},
+ 'Disabled autoinc trigger not loaded';
+
+ SKIP: {
+ skip 'Set the DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS environment variables to run the cross-schema relationship tests', 31 * 2
+ unless $ENV{DBICTEST_ORA_EXTRAUSER_DSN};
+
+ $extra_schema = $schema->clone;
+ $extra_schema->connection(@ENV{map "DBICTEST_ORA_EXTRAUSER_$_",
+ qw/DSN USER PASS/
+ });
+
+ my $dbh1 = $schema->storage->dbh;
+ my $dbh2 = $extra_schema->storage->dbh;
+
+ my ($schema1) = $dbh1->selectrow_array('SELECT USER FROM DUAL');
+ my ($schema2) = $dbh2->selectrow_array('SELECT USER FROM DUAL');
+
+ $dbh1->do(<<'EOF');
+ CREATE TABLE oracle_loader_test4 (
+ id INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100)
+ )
+EOF
+
+ $dbh1->do($_) for $auto_inc_cb->(lc "${schema1}.oracle_loader_test4", 'id');
+
+ $dbh1->do("GRANT ALL ON oracle_loader_test4 TO $schema2");
+ $dbh1->do("GRANT ALL ON oracle_loader_test4_id_seq TO $schema2");
+
+ $dbh1->do(<<"EOF");
+ CREATE TABLE oracle_loader_test5 (
+ id INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100),
+ four_id INT REFERENCES ${schema1}.oracle_loader_test4 (id),
+ CONSTRAINT ora_loader5_uniq UNIQUE (four_id)
+ )
+EOF
+ $dbh1->do($_) for $auto_inc_cb->('oracle_loader_test5', 'id');
+ $dbh1->do("GRANT ALL ON oracle_loader_test5 TO $schema2");
+ $dbh1->do("GRANT ALL ON oracle_loader_test5_id_seq TO $schema2");
+
+ $dbh2->do(<<"EOF");
+ CREATE TABLE oracle_loader_test5 (
+ pk INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100),
+ four_id INT REFERENCES ${schema1}.oracle_loader_test4 (id),
+ CONSTRAINT ora_loader5_uniq UNIQUE (four_id)
+ )
+EOF
+ $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test5', 'pk');
+ $dbh2->do("GRANT ALL ON oracle_loader_test5 TO $schema1");
+ $dbh2->do("GRANT ALL ON oracle_loader_test5_pk_seq TO $schema1");
+
+ $dbh2->do(<<"EOF");
+ CREATE TABLE oracle_loader_test6 (
+ id INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100),
+ oracle_loader_test4_id INT REFERENCES ${schema1}.oracle_loader_test4 (id)
+ )
+EOF
+ $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test6', 'id');
+ $dbh2->do("GRANT ALL ON oracle_loader_test6 to $schema1");
+ $dbh2->do("GRANT ALL ON oracle_loader_test6_id_seq TO $schema1");
+
+ $dbh2->do(<<"EOF");
+ CREATE TABLE oracle_loader_test7 (
+ id INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100),
+ six_id INT UNIQUE REFERENCES ${schema2}.oracle_loader_test6 (id)
+ )
+EOF
+ $dbh2->do($_) for $auto_inc_cb->('oracle_loader_test7', 'id');
+ $dbh2->do("GRANT ALL ON oracle_loader_test7 to $schema1");
+ $dbh2->do("GRANT ALL ON oracle_loader_test7_id_seq TO $schema1");
+
+ $dbh1->do(<<"EOF");
+ CREATE TABLE oracle_loader_test8 (
+ id INT NOT NULL PRIMARY KEY,
+ value VARCHAR(100),
+ oracle_loader_test7_id INT REFERENCES ${schema2}.oracle_loader_test7 (id)
+ )
+EOF
+ $dbh1->do($_) for $auto_inc_cb->('oracle_loader_test8', 'id');
+ $dbh1->do("GRANT ALL ON oracle_loader_test8 to $schema2");
+ $dbh1->do("GRANT ALL ON oracle_loader_test8_id_seq TO $schema2");
+
+ # We add schema to moniker_parts, so make a monikers hash for
+ # the tests, of the form schemanum.tablenum
+ my $schema1_moniker = join '', map ucfirst lc, split_name to_identifier $schema1;
+ my $schema2_moniker = join '', map ucfirst lc, split_name to_identifier $schema2;
+
+ my %monikers;
+ $monikers{'1.5'} = $schema1_moniker . 'OracleLoaderTest5';
+ $monikers{'2.5'} = $schema2_moniker . 'OracleLoaderTest5';
+
+ foreach my $db_schema ([$schema1, $schema2], '%') {
+ lives_and {
+ rmtree EXTRA_DUMP_DIR;
+
+ my @warns;
+ local $SIG{__WARN__} = sub {
+ push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
+ };
+
+ make_schema_at(
+ 'OracleMultiSchema',
+ {
+ naming => 'current',
+ db_schema => $db_schema,
+ dump_directory => EXTRA_DUMP_DIR,
+ quiet => 1,
+ },
+ [ $dsn, $user, $password ],
+ );
+
+ diag join "\n", @warns if @warns;
+
+ is @warns, 0;
+ } qq{dumped schema for "$schema1" and "$schema2" schemas with no warnings};
+
+ my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
+
+ lives_and {
+ ok $test_schema = OracleMultiSchema->connect($dsn, $user, $password);
+ } 'connected test schema';
+
+ lives_and {
+ ok $rsrc = $test_schema->source('OracleLoaderTest4');
+ } 'got source for table in schema1';
+
+ is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
+ 'column in schema1';
+
+ is try { $rsrc->column_info('id')->{sequence} }, lc "${schema1}.oracle_loader_test4_id_seq",
+ 'sequence in schema1';
+
+ is try { $rsrc->column_info('value')->{data_type} }, 'varchar2',
+ 'column in schema1';
+
+ is try { $rsrc->column_info('value')->{size} }, 100,
+ 'column in schema1';
+
+ lives_and {
+ ok $rs = $test_schema->resultset('OracleLoaderTest4');
+ } 'got resultset for table in schema1';
+
+ lives_and {
+ ok $row = $rs->create({ value => 'foo' });
+ } 'executed SQL on table in schema1';
+
+ my $schema1_identifier = join '_', map lc, split_name to_identifier $schema1;
+
+ $rel_info = try { $rsrc->relationship_info(
+ $schema1_identifier . '_oracle_loader_test5'
+ ) };
+
+ is_deeply $rel_info->{cond}, {
+ 'foreign.four_id' => 'self.id'
+ }, 'relationship in schema1';
+
+ is $rel_info->{attrs}{accessor}, 'single',
+ 'relationship in schema1';
+
+ is $rel_info->{attrs}{join_type}, 'LEFT',
+ 'relationship in schema1';
+
+ lives_and {
+ ok $rsrc = $test_schema->source($monikers{'1.5'});
+ } 'got source for table in schema1';
+
+ %uniqs = try { $rsrc->unique_constraints };
+
+ is keys %uniqs, 2,
+ 'got unique and primary constraint in schema1';
+
+ delete $uniqs{primary};
+
+ is_deeply ((values %uniqs)[0], ['four_id'],
+ 'correct unique constraint in schema1');
+
+ lives_and {
+ ok $rsrc = $test_schema->source('OracleLoaderTest6');
+ } 'got source for table in schema2';
+
+ is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
+ 'column in schema2 introspected correctly';
+
+ is try { $rsrc->column_info('value')->{data_type} }, 'varchar2',
+ 'column in schema2 introspected correctly';
+
+ is try { $rsrc->column_info('value')->{size} }, 100,
+ 'column in schema2 introspected correctly';
+
+ lives_and {
+ ok $rs = $test_schema->resultset('OracleLoaderTest6');
+ } 'got resultset for table in schema2';
+
+ lives_and {
+ ok $row = $rs->create({ value => 'foo' });
+ } 'executed SQL on table in schema2';
+
+ $rel_info = try { $rsrc->relationship_info('oracle_loader_test7') };
+
+ is_deeply $rel_info->{cond}, {
+ 'foreign.six_id' => 'self.id'
+ }, 'relationship in schema2';
+
+ is $rel_info->{attrs}{accessor}, 'single',
+ 'relationship in schema2';
+
+ is $rel_info->{attrs}{join_type}, 'LEFT',
+ 'relationship in schema2';
+
+ lives_and {
+ ok $rsrc = $test_schema->source('OracleLoaderTest7');
+ } 'got source for table in schema2';
+
+ %uniqs = try { $rsrc->unique_constraints };
+
+ is keys %uniqs, 2,
+ 'got unique and primary constraint in schema2';
+
+ delete $uniqs{primary};
+
+ is_deeply ((values %uniqs)[0], ['six_id'],
+ 'correct unique constraint in schema2');
+
+ lives_and {
+ ok $test_schema->source('OracleLoaderTest6')
+ ->has_relationship('oracle_loader_test4');
+ } 'cross-schema relationship in multi-db_schema';
+
+ lives_and {
+ ok $test_schema->source('OracleLoaderTest4')
+ ->has_relationship('oracle_loader_test6s');
+ } 'cross-schema relationship in multi-db_schema';
+
+ lives_and {
+ ok $test_schema->source('OracleLoaderTest8')
+ ->has_relationship('oracle_loader_test7');
+ } 'cross-schema relationship in multi-db_schema';
+
+ lives_and {
+ ok $test_schema->source('OracleLoaderTest7')
+ ->has_relationship('oracle_loader_test8s');
+ } 'cross-schema relationship in multi-db_schema';
+ }
+ }
},
},
-);
+)->run_tests();
-if( !$dsn || !$user ) {
- $tester->skip_tests('You need to set the DBICTEST_ORA_DSN, _USER, and _PASS environment variables');
-}
-else {
- $tester->run_tests();
+
+END {
+ if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
+ if (my $dbh1 = try { $schema->storage->dbh }) {
+ $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test11','id');
+
+ if (my $dbh2 = try { $extra_schema->storage->dbh }) {
+
+ try {
+ $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test8', 'id');
+ $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test7', 'id');
+ $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test6', 'id');
+ $dbh2->do($_) for $auto_inc_drop_cb->('oracle_loader_test5', 'pk');
+ $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test5', 'id');
+ $dbh1->do($_) for $auto_inc_drop_cb->('oracle_loader_test4', 'id');
+ }
+ catch {
+ die "Error dropping sequences for cross-schema test tables: $_";
+ };
+
+ try {
+ $dbh1->do('DROP TABLE oracle_loader_test8');
+ $dbh2->do('DROP TABLE oracle_loader_test7');
+ $dbh2->do('DROP TABLE oracle_loader_test6');
+ $dbh2->do('DROP TABLE oracle_loader_test5');
+ $dbh1->do('DROP TABLE oracle_loader_test5');
+ $dbh1->do('DROP TABLE oracle_loader_test4');
+ }
+ catch {
+ die "Error dropping cross-schema test tables: $_";
+ };
+ }
+ }
+ rmtree EXTRA_DUMP_DIR;
+ }
}
# vim:et sw=4 sts=4 tw=0: