use List::MoreUtils 'apply';
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
+use File::Slurp 'slurp';
use namespace::clean;
use dbixcsl_test_dir qw/$tdir/;
use constant RESCAN_WARNINGS => qr/(?i:loader_test|LoaderTest)\d+s? has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/;
+# skip schema-qualified tables in the Pg tests
+use constant SOURCE_DDL => qr/CREATE (?:TABLE|VIEW) (?!"dbicsl[.-]test")/i;
+
sub new {
my $class = shift;
$self = bless $self, $class;
+ $self->{preserve_case_tests_table_names} = [qw/LoaderTest40 LoaderTest41/];
+
+ if (lc($self->{vendor}) eq 'mysql' && $^O =~ /^(?:MSWin32|cygwin)\z/) {
+ $self->{preserve_case_tests_table_names} = [qw/Loader_Test40 Loader_Test41/];
+ }
+
$self->setup_data_type_tests;
return $self;
my $col_accessor_map_tests = 5;
my $num_rescans = 5;
- $num_rescans-- if $self->{vendor} =~ /^(?:sybase|mysql)\z/i;
$num_rescans++ if $self->{vendor} eq 'mssql';
$num_rescans++ if $self->{vendor} eq 'Firebird';
plan tests => @connect_info *
- (199 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+ (203 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0));
foreach my $info_idx (0..$#connect_info) {
my $info = $connect_info[$info_idx];
$self->{_created} = 1;
- my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] };
+ my $file_count = grep $_ =~ SOURCE_DDL, @{ $self->{extra}{create} || [] };
$file_count++; # schema
if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
local $^W = 0; # for ADO
$dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
- $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
+ $self->drop_table($dbh, $_) for @{ $self->{extra}{drop} || [] };
if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) {
- $dbh->do("DROP TABLE $data_type_table");
+ $self->drop_table($dbh, $data_type_table);
}
}
}
my %loader_opts = (
constraint =>
- qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i,
+ qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
relationships => 1,
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
$expected_count++ for @{ $self->{data_type_tests}{table_names} || [] };
}
- $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+ $expected_count += grep $_ =~ SOURCE_DDL,
@{ $self->{extra}{create} || [] };
$expected_count -= grep /CREATE TABLE/, @statements_inline_rels
}
else {
$warn_count++;
- is(scalar(@loader_warnings), $warn_count, "Expected loader warning")
+ is(scalar(@loader_warnings), $warn_count, "Expected loader warnings")
or diag @loader_warnings;
is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1,
"Missing PK warning");
isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
my @columns_lt2 = $class2->columns;
- is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentformap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" );
+ is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" );
is $class2->column_info('can')->{accessor}, 'caught_collision_can',
'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map';
&& (not defined $class2->column_info('dbix_class_testcomponent')->{accessor}),
'accessor for column name that conflicts with a component class method removed');
- ok (exists $class2->column_info('dbix_class_testcomponentformap')->{accessor}
- && (not defined $class2->column_info('dbix_class_testcomponentformap')->{accessor}),
+ ok (exists $class2->column_info('dbix_class_testcomponentmap')->{accessor}
+ && (not defined $class2->column_info('dbix_class_testcomponentmap')->{accessor}),
'accessor for column name that conflicts with a component class method removed');
ok (exists $class2->column_info('testcomponent_fqn')->{accessor}
'Additional Component' );
}
- is try { $class2->dbix_class_testcomponentformap }, 'dbix_class_testcomponentformap works',
+ is try { $class2->dbix_class_testcomponentmap }, 'dbix_class_testcomponentmap works',
'component from result_component_map';
- isnt try { $class1->dbix_class_testcomponentformap }, 'dbix_class_testcomponentformap works',
+ isnt try { $class1->dbix_class_testcomponentmap }, 'dbix_class_testcomponentmap works',
'component from result_component_map not added to not mapped Result';
is try { $class1->testcomponent_fqn }, 'TestComponentFQN works',
}
SKIP: {
- skip $self->{skip_rels}, 120 if $self->{skip_rels};
+ skip $self->{skip_rels}, 132 if $self->{skip_rels};
my $moniker3 = $monikers->{loader_test3};
my $class3 = $classes->{loader_test3};
ok($class6->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected');
ok($class6->column_info('id')->{is_foreign_key}, 'Foreign key detected');
- my $id2_info = eval { $class6->column_info('id2') } ||
+ my $id2_info = try { $class6->column_info('id2') } ||
$class6->column_info('Id2');
ok($id2_info->{is_foreign_key}, 'Foreign key detected');
+ unlike slurp($conn->_loader->get_dump_filename($class6)),
+qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
+ \s+ "(\w+?)"
+ .*?
+ \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
+ \s+ "\1"/xs,
+'did not create two relationships with the same name';
+
+ unlike slurp($conn->_loader->get_dump_filename($class8)),
+qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
+ \s+ "(\w+?)"
+ .*?
+ \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
+ \s+ "\1"/xs,
+'did not create two relationships with the same name';
+
+ # check naming of ambiguous relationships
+ my $rel_info = $class6->relationship_info('lovely_loader_test7') || {};
+
+ ok (($class6->has_relationship('lovely_loader_test7')
+ && $rel_info->{cond}{'foreign.lovely_loader_test6'} eq 'self.id'
+ && $rel_info->{class} eq $class7
+ && $rel_info->{attrs}{accessor} eq 'single'),
+ 'ambiguous relationship named correctly');
+
+ $rel_info = $class8->relationship_info('active_loader_test16') || {};
+
+ ok (($class8->has_relationship('active_loader_test16')
+ && $rel_info->{cond}{'foreign.loader_test8_id'} eq 'self.id'
+ && $rel_info->{class} eq $class16
+ && $rel_info->{attrs}{accessor} eq 'single'),
+ 'ambiguous relationship named correctly');
+
# fk that references a non-pk key (UNIQUE)
my $obj8 = try { $rsobj8->find(1) } || $rsobj8->search({ id => 1 })->first;
isa_ok( try { $obj8->loader_test7 }, $class7);
}
SKIP: {
- skip 'This vendor cannot do inline relationship definitions', 11
+ skip 'This vendor cannot do inline relationship definitions', 9
if $self->{no_inline_rels};
my $moniker12 = $monikers->{loader_test12};
my $obj12 = try { $rsobj12->find(1) } || $rsobj12->search({ id => 1 })->first;
isa_ok( try { $obj12->loader_test13 }, $class13 );
+ }
- # relname is preserved when another fk is added
-
- skip 'Sybase cannot add FKs via ALTER TABLE', 2
- if $self->{vendor} eq 'sybase';
-
- {
- local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
- $conn->storage->disconnect; # for mssql and access
- }
+ # relname is preserved when another fk is added
+ {
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
+ $conn->storage->disconnect; # for mssql and access
+ }
- isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet';
+ isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet';
- $conn->storage->disconnect; # for access
+ $conn->storage->disconnect; # for access
+ if (lc($self->{vendor}) !~ /^(?:sybase|mysql)\z/) {
$conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)');
+ }
+ else {
+ $conn->storage->dbh->do(<<"EOF");
+ ALTER TABLE loader_test4 ADD fkid2 INTEGER $self->{null}
+EOF
+ $conn->storage->dbh->do(<<"EOF");
+ ALTER TABLE loader_test4 ADD CONSTRAINT loader_test4_to_3_fk FOREIGN KEY (fkid2) REFERENCES loader_test3 (id)
+EOF
+ }
- $conn->storage->disconnect; # for firebird
+ $conn->storage->disconnect; # for firebird
- $self->rescan_without_warnings($conn);
+ $self->rescan_without_warnings($conn);
- isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet',
- 'relationship name preserved when another foreign key is added in remote table';
- }
+ isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet',
+ 'relationship name preserved when another foreign key is added in remote table';
SKIP: {
skip 'This vendor cannot do out-of-line implicit rel defs', 4
}
$conn->storage->disconnect; # for Firebird
- $conn->storage->dbh->do("DROP TABLE loader_test30");
+ $self->drop_table($conn->storage->dbh, 'loader_test30');
@new = $self->rescan_without_warnings($conn);
my $dbh = $self->dbconnect;
+ my ($table40_name, $table41_name) = @{ $self->{preserve_case_tests_table_names} };
+
$dbh->do($_) for (
qq|
- CREATE TABLE ${oqt}LoaderTest40${cqt} (
+ CREATE TABLE ${oqt}${table40_name}${cqt} (
${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY,
${oqt}Foo3Bar${cqt} VARCHAR(100) NOT NULL
) $self->{innodb}
|,
qq|
- CREATE TABLE ${oqt}LoaderTest41${cqt} (
+ CREATE TABLE ${oqt}${table41_name}${cqt} (
${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY,
${oqt}LoaderTest40Id${cqt} INTEGER,
- FOREIGN KEY (${oqt}LoaderTest40Id${cqt}) REFERENCES ${oqt}LoaderTest40${cqt} (${oqt}Id${cqt})
+ FOREIGN KEY (${oqt}LoaderTest40Id${cqt}) REFERENCES ${oqt}${table40_name}${cqt} (${oqt}Id${cqt})
) $self->{innodb}
|,
-qq| INSERT INTO ${oqt}LoaderTest40${cqt} VALUES (1, 'foo') |,
-qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |,
+qq| INSERT INTO ${oqt}${table40_name}${cqt} VALUES (1, 'foo') |,
+qq| INSERT INTO ${oqt}${table41_name}${cqt} VALUES (1, 1) |,
);
$conn->storage->disconnect;
set_primary_key INTEGER $self->{null},
can INTEGER $self->{null},
dbix_class_testcomponent INTEGER $self->{null},
- dbix_class_testcomponentformap INTEGER $self->{null},
+ dbix_class_testcomponentmap INTEGER $self->{null},
testcomponent_fqn INTEGER $self->{null},
meta INTEGER $self->{null},
test_role_method INTEGER $self->{null},
(qq| INSERT INTO loader_test6 (id, ${oqt}Id2${cqt},loader_test2_id,dat) | .
q{ VALUES (1, 1,1,'aaa') }),
+ # here we are testing adjective detection
+
qq{
CREATE TABLE loader_test7 (
id INTEGER NOT NULL PRIMARY KEY,
id2 VARCHAR(8) NOT NULL UNIQUE,
- dat VARCHAR(8)
+ dat VARCHAR(8),
+ lovely_loader_test6 INTEGER NOT NULL UNIQUE,
+ FOREIGN KEY (lovely_loader_test6) REFERENCES loader_test6 (id)
) $self->{innodb}
},
- q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') },
+ q{ INSERT INTO loader_test7 (id,id2,dat,lovely_loader_test6) VALUES (1,'aaa','bbb',1) },
+
+ # for some DBs we need a named FK to drop later
+ ($self->{vendor} =~ /^(mssql|sybase|access|mysql)\z/i ? (
+ (q{ ALTER TABLE loader_test6 ADD } .
+ qq{ loader_test7_id INTEGER $self->{null} }),
+ (q{ ALTER TABLE loader_test6 ADD CONSTRAINT loader_test6_to_7_fk } .
+ q{ FOREIGN KEY (loader_test7_id) } .
+ q{ REFERENCES loader_test7 (id) })
+ ) : (
+ (q{ ALTER TABLE loader_test6 ADD } .
+ qq{ loader_test7_id INTEGER $self->{null} REFERENCES loader_test7 (id) }),
+ )),
qq{
CREATE TABLE loader_test8 (
) $self->{innodb}
},
- (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
- q{ VALUES (1,'aaa','bbb') }),
+ (q{ INSERT INTO loader_test8 (id,loader_test7,dat) VALUES (1,'aaa','bbb') }),
+ (q{ INSERT INTO loader_test8 (id,loader_test7,dat) VALUES (2,'aaa','bbb') }),
+ (q{ INSERT INTO loader_test8 (id,loader_test7,dat) VALUES (3,'aaa','bbb') }),
qq{
CREATE TABLE loader_test9 (
qq{
CREATE TABLE loader_test16 (
id INTEGER NOT NULL PRIMARY KEY,
- dat VARCHAR(8)
+ dat VARCHAR(8),
+ loader_test8_id INTEGER NOT NULL UNIQUE,
+ FOREIGN KEY (loader_test8_id) REFERENCES loader_test8 (id)
) $self->{innodb}
},
- qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') },
- qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') },
- qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') },
+ qq{ INSERT INTO loader_test16 (id,dat,loader_test8_id) VALUES (2,'x16',1) },
+ qq{ INSERT INTO loader_test16 (id,dat,loader_test8_id) VALUES (4,'y16',2) },
+ qq{ INSERT INTO loader_test16 (id,dat,loader_test8_id) VALUES (6,'z16',3) },
+
+ # for some DBs we need a named FK to drop later
+ ($self->{vendor} =~ /^(mssql|sybase|access|mysql)\z/i ? (
+ (q{ ALTER TABLE loader_test8 ADD } .
+ qq{ loader_test16_id INTEGER $self->{null} }),
+ (q{ ALTER TABLE loader_test8 ADD CONSTRAINT loader_test8_to_16_fk } .
+ q{ FOREIGN KEY (loader_test16_id) } .
+ q{ REFERENCES loader_test16 (id) })
+ ) : (
+ (q{ ALTER TABLE loader_test8 ADD } .
+ qq{ loader_test16_id INTEGER $self->{null} REFERENCES loader_test16 (id) }),
+ )),
qq{
CREATE TABLE loader_test17 (
$dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
}
- unless($self->{skip_rels}) {
+ unless ($self->{skip_rels}) {
# hack for now, since DB2 doesn't like inline comments, and we need
# to test one for mysql, which works on everyone else...
# this all needs to be refactored anyways.
my @tables_rescan = qw/ loader_test30 /;
- my @tables_preserve_case_tests = qw/ LoaderTest41 LoaderTest40 /;
+ my @tables_preserve_case_tests = @{ $self->{preserve_case_tests_table_names} };
- my $drop_fk_mysql =
- q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk};
+ my %drop_columns = (
+ loader_test6 => 'loader_test7_id',
+ loader_test7 => 'lovely_loader_test6',
+ loader_test8 => 'loader_test16_id',
+ loader_test16 => 'loader_test8_id',
+ );
- my $drop_fk =
- q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk};
+ my %drop_constraints = (
+ loader_test10 => 'loader_test11_fk',
+ loader_test6 => 'loader_test6_to_7_fk',
+ loader_test8 => 'loader_test8_to_16_fk',
+ );
# For some reason some tests do this twice (I guess dependency issues?)
# do it twice for all drops
$dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
- $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
+ $self->drop_table($dbh, $_) for @{ $self->{extra}{drop} || [] };
my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
- unless($self->{skip_rels}) {
- $dbh->do("DROP TABLE $_") for (@tables_reltests);
- $dbh->do("DROP TABLE $_") for (@tables_reltests);
- if($self->{vendor} =~ /mysql/i) {
- $dbh->do($drop_fk_mysql);
+ unless ($self->{skip_rels}) {
+ # drop the circular rel columns if possible, this
+ # doesn't work on all DBs
+ foreach my $table (keys %drop_columns) {
+ $dbh->do("ALTER TABLE $table DROP $drop_columns{$table}");
+ $dbh->do("ALTER TABLE $table DROP COLUMN $drop_columns{$table}");
}
- else {
- $dbh->do($drop_fk);
+
+ foreach my $table (keys %drop_constraints) {
+ # for MSSQL
+ $dbh->do("ALTER TABLE $table DROP $drop_constraints{$table}");
+ # for Sybase and Access
+ $dbh->do("ALTER TABLE $table DROP CONSTRAINT $drop_constraints{$table}");
+ # for MySQL
+ $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $drop_constraints{$table}");
}
+
+ $self->drop_table($dbh, $_) for (@tables_reltests);
+ $self->drop_table($dbh, $_) for (@tables_reltests);
+
$dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
- $dbh->do("DROP TABLE $_") for (@tables_advanced);
+
+ $self->drop_table($dbh, $_) for (@tables_advanced);
unless($self->{no_inline_rels}) {
- $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
+ $self->drop_table($dbh, $_) for (@tables_inline_rels);
}
unless($self->{no_implicit_rels}) {
- $dbh->do("DROP TABLE $_") for (@tables_implicit_rels);
+ $self->drop_table($dbh, $_) for (@tables_implicit_rels);
}
}
$dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
- $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan);
+ $self->drop_table($dbh, $_) for (@tables, @tables_rescan);
if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) {
- $dbh->do("DROP TABLE $data_type_table");
+ $self->drop_table($dbh, $data_type_table);
}
}
- my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1);
-
- $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests;
+ $self->drop_table($dbh, $_) for @tables_preserve_case_tests;
$dbh->disconnect;
}
}
+sub drop_table {
+ my ($self, $dbh, $table) = @_;
+
+ local $^W = 0; # for ADO
+
+ try { $dbh->do("DROP TABLE $table CASCADE CONSTRAINTS") }; # oracle
+ try { $dbh->do("DROP TABLE $table CASCADE") }; # postgres and ?
+ try { $dbh->do("DROP TABLE $table") };
+
+ # if table name is case sensitive
+ my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1);
+
+ try { $dbh->do("DROP TABLE ${oqt}${table}${cqt}") };
+}
+
sub _custom_column_info {
my ( $table_name, $column_name, $column_info ) = @_;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff