Revision history for Perl extension DBIx::Class::Schema::Loader
+ - handle duplicate relationship names (RT#64041)
+ - fix a bug in Sybase ASE foreign key detection
- generate POD for result_base_class, additional_classes,
additional_base_classes, left_base_classes, components,
result_components_map, result_roles and result_roles_map
requires 'Scalar::Util' => 0;
requires 'Data::Dump' => '1.06';
requires 'Lingua::EN::Inflect::Number' => '1.1';
+requires 'Lingua::EN::Tagger' => 0;
requires 'Lingua::EN::Inflect::Phrase' => '0.02';
requires 'Digest::MD5' => '2.36';
requires 'Class::Accessor::Grouped' => '0.10002';
datetime_undef_if_invalid
_result_class_methods
naming_set
+ tables
/);
=head1 NAME
}
$self->{monikers} = {};
- $self->{classes} = {};
+ $self->{tables} = {};
+ $self->{classes} = {};
$self->{_upgrading_classes} = {};
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
$self->_reload_classes(\@tables);
- $self->_load_relationships($_) for @tables;
- $self->_relbuilder->cleanup;
+ $self->_load_relationships(\@tables);
$self->{quiet} = 0;
# Remove that temp dir from INC so it doesn't get reloaded
$self->classes->{$table} = $table_class;
$self->monikers->{$table} = $table_moniker;
+ $self->tables->{$table_moniker} = $table;
$self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
sub _is_result_class_method {
my ($self, $name, $table_name) = @_;
- my $table_moniker = $table_name ? $self->_table2moniker($table_name) : '';
+ my $table_moniker = $table_name ? $self->monikers->{$table_name} : '';
$self->_result_class_methods({})
if not defined $self->_result_class_methods;
$info->{accessor} = $self->_make_column_accessor_name( $col, $context );
}
- $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
+ $self->_resolve_col_accessor_collisions($table, $col_info);
# prune any redundant accessor names
while (my ($col, $info) = each %$col_info) {
}
sub _load_relationships {
- my ($self, $table) = @_;
+ my ($self, $tables) = @_;
+
+ my @tables;
+
+ foreach my $table (@$tables) {
+ my $tbl_fk_info = $self->_table_fk_info($table);
+ foreach my $fkdef (@$tbl_fk_info) {
+ $fkdef->{remote_source} =
+ $self->monikers->{delete $fkdef->{remote_table}};
+ }
+ my $tbl_uniq_info = $self->_table_uniq_info($table);
+
+ my $local_moniker = $self->monikers->{$table};
- my $tbl_fk_info = $self->_table_fk_info($table);
- foreach my $fkdef (@$tbl_fk_info) {
- $fkdef->{remote_source} =
- $self->monikers->{delete $fkdef->{remote_table}};
+ push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
}
- my $tbl_uniq_info = $self->_table_uniq_info($table);
- my $local_moniker = $self->monikers->{$table};
- my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+ my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
}
$sth->finish;
- return $self->_table_fk_info_builder($table);
+ return $self->_table_fk_info_by_sp_helpconstraint($table);
}
sub _table_fk_info_by_name {
return \@rels;
}
-sub _table_fk_info_builder {
+sub _table_fk_info_by_sp_helpconstraint {
my ($self, $table) = @_;
+ my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+ local $SIG{__WARN__} = sub {
+ $warn_handler->(@_) unless $_[0] =~
+ /^\s*$|^Total Number of|^Details|^(?:--?|=|\+) Number|^Formula for/;
+ };
+
my $dbh = $self->schema->storage->dbh;
- local $dbh->{FetchHashKeyName} = 'NAME_lc';
- # hide "Object does not exist in this database." when trying to fetch fkeys
- local $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; };
- my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
- $sth->execute;
- my @fk_info;
- while (my $row = $sth->fetchrow_hashref) {
- (my $ksq = $row->{key_seq}) =~ s/\s+//g;
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
- my @keys = qw/pktable_name pkcolumn_name fktable_name fkcolumn_name/;
- my %ds;
- @ds{@keys} = @{$row}{@keys};
- $ds{key_seq} = $ksq;
+ my $sth = $dbh->prepare("sp_helpconstraint $table");
+ $sth->execute;
- push @{ $fk_info[$ksq] }, \%ds;
- }
+ my $constraints = $sth->fetchall_arrayref({});
- my $max_keys = $#fk_info;
my @rels;
- for my $level (reverse 1 .. $max_keys) {
- my @level_rels;
- $level_rels[$level] = splice @fk_info, $level, 1;
- my $count = @{ $level_rels[$level] };
- for my $sub_level (reverse 1 .. $level-1) {
- my $total = @{ $fk_info[$sub_level] };
-
- $level_rels[$sub_level] = [
- splice @{ $fk_info[$sub_level] }, $total-$count, $count
- ];
- }
+ foreach my $constraint (map $_->{definition}, @$constraints) {
+ my ($local_cols, $remote_table, $remote_cols) = $constraint =~
+/^$table FOREIGN KEY \(([^)]+)\) REFERENCES ([^(]+)\(([^)]+)\)/;
- while (1) {
- my @rel = map shift @$_, @level_rels[1..$level];
+ next unless $local_cols;
- last unless defined $rel[0];
+ my @local_cols = split /,\s*/, $local_cols;
+ my @remote_cols = split /,\s*/, $remote_cols;
- my @local_columns = map $_->{fkcolumn_name}, @rel;
- my @remote_columns = map $_->{pkcolumn_name}, @rel;
- my $remote_table = $rel[0]->{pktable_name};
-
- push @rels, {
- local_columns => \@local_columns,
- remote_columns => \@remote_columns,
- remote_table => $remote_table
- };
- }
+ push @rels, {
+ local_columns => \@local_cols,
+ remote_columns => \@remote_cols,
+ remote_table => $remote_table,
+ };
}
return \@rels;
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util 'weaken';
use Lingua::EN::Inflect::Phrase ();
+use Lingua::EN::Tagger ();
use DBIx::Class::Schema::Loader::Utils 'split_name';
use File::Slurp 'slurp';
use Try::Tiny;
=head2 generate_code
-Arguments: local_moniker (scalar), fk_info (arrayref)
+Arguments:
+
+ {
+ local_moniker (scalar) => [ fk_info (arrayref), uniq_info (arrayref) ]
+ ...
+ }
-This generates the code for the relationships of a given table.
+This generates the code for the relationships of each table.
C<local_moniker> is the moniker name of the table which had the REFERENCES
statements. The fk_info arrayref's contents should take the form:
# ...
],
+The uniq_info arrayref's contents should take the form:
+
+ [
+ [
+ uniq_constraint_name => [ 'col1', 'col2' ],
+ ],
+ [
+ another_uniq_constraint_name => [ 'col1', 'col2' ],
+ ],
+ ],
+
This method will return the generated relationships as a hashref keyed on the
class names. The values are arrayrefs of hashes containing method name and
arguments, like so:
relationship_attrs
rel_collision_map
_temp_classes
+ __tagger
/);
sub new {
return $relname if $relname eq 'id'; # this shouldn't happen, but just in case
- if ($self->base->_is_result_class_method($relname)) {
+ my $table = $self->base->tables->{$moniker};
+
+ if ($self->base->_is_result_class_method($relname, $table)) {
if (my $map = $self->rel_collision_map) {
for my $re (keys %$map) {
if (my @matches = $relname =~ /$re/) {
}
my $new_relname = $relname;
- while ($self->base->_is_result_class_method($new_relname)) {
+ while ($self->base->_is_result_class_method($new_relname, $table)) {
$new_relname .= '_rel'
}
}
sub generate_code {
- my ($self, $local_moniker, $rels, $uniqs) = @_;
+ my ($self, $tables) = @_;
+
+ # make a copy to destroy
+ my @tables = @$tables;
my $all_code = {};
- my $local_class = $self->schema->class($local_moniker);
+ while (my ($local_moniker, $rels, $uniqs) = @{ shift @tables || [] }) {
+ my $local_class = $self->schema->class($local_moniker);
- my %counters;
- foreach my $rel (@$rels) {
- next if !$rel->{remote_source};
- $counters{$rel->{remote_source}}++;
- }
+ my %counters;
+ foreach my $rel (@$rels) {
+ next if !$rel->{remote_source};
+ $counters{$rel->{remote_source}}++;
+ }
- foreach my $rel (@$rels) {
- my $remote_moniker = $rel->{remote_source}
- or next;
+ foreach my $rel (@$rels) {
+ my $remote_moniker = $rel->{remote_source}
+ or next;
- my $remote_class = $self->schema->class($remote_moniker);
- my $remote_obj = $self->schema->source($remote_moniker);
- my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
+ my $remote_class = $self->schema->class($remote_moniker);
+ my $remote_obj = $self->schema->source($remote_moniker);
+ my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
- my $local_cols = $rel->{local_columns};
+ my $local_cols = $rel->{local_columns};
- if($#$local_cols != $#$remote_cols) {
- croak "Column count mismatch: $local_moniker (@$local_cols) "
- . "$remote_moniker (@$remote_cols)";
- }
+ if($#$local_cols != $#$remote_cols) {
+ croak "Column count mismatch: $local_moniker (@$local_cols) "
+ . "$remote_moniker (@$remote_cols)";
+ }
- my %cond;
- foreach my $i (0 .. $#$local_cols) {
- $cond{$remote_cols->[$i]} = $local_cols->[$i];
+ my %cond;
+ foreach my $i (0 .. $#$local_cols) {
+ $cond{$remote_cols->[$i]} = $local_cols->[$i];
+ }
+
+ my ( $local_relname, $remote_relname, $remote_method ) =
+ $self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
+
+ $remote_relname = $self->_resolve_relname_collision($local_moniker, $local_cols, $remote_relname);
+ $local_relname = $self->_resolve_relname_collision($remote_moniker, $remote_cols, $local_relname);
+
+ push(@{$all_code->{$local_class}},
+ { method => 'belongs_to',
+ args => [ $remote_relname,
+ $remote_class,
+ \%cond,
+ $self->_remote_attrs($local_moniker, $local_cols),
+ ],
+ extra => {
+ moniker => $local_moniker,
+ },
+ }
+ );
+
+ my %rev_cond = reverse %cond;
+ for (keys %rev_cond) {
+ $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
+ delete $rev_cond{$_};
+ }
+
+ push(@{$all_code->{$remote_class}},
+ { method => $remote_method,
+ args => [ $local_relname,
+ $local_class,
+ \%rev_cond,
+ $self->_relationship_attrs($remote_method),
+ ],
+ extra => {
+ moniker => $remote_moniker,
+ },
+ }
+ );
}
+ }
+
+ # disambiguate rels with the same name
+ foreach my $class (keys %$all_code) {
+ my $dups = $self->_duplicates($all_code->{$class});
- my ( $local_relname, $remote_relname, $remote_method ) =
- $self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
+ $self->_disambiguate($all_code->{$class}, $dups) if $dups;
+ }
+
+ $self->_cleanup;
+
+ return $all_code;
+}
+
+sub _duplicates {
+ my ($self, $rels) = @_;
+
+ my @rels = map [ $_->{args}[0] => $_ ], @$rels;
+ my %rel_names;
+ $rel_names{$_}++ foreach map $_->[0], @rels;
+
+ my @dups = grep $rel_names{$_} > 1, keys %rel_names;
+
+ my %dups;
+
+ foreach my $dup (@dups) {
+ $dups{$dup} = [ map $_->[1], grep { $_->[0] eq $dup } @rels ];
+ }
+
+ return if not %dups;
+
+ return \%dups;
+}
+
+sub _tagger {
+ my $self = shift;
+
+ $self->__tagger(Lingua::EN::Tagger->new) unless $self->__tagger;
+
+ return $self->__tagger;
+}
- $remote_relname = $self->_resolve_relname_collision($local_moniker, $local_cols, $remote_relname);
- $local_relname = $self->_resolve_relname_collision($remote_moniker, $remote_cols, $local_relname);
+sub _adjectives {
+ my ($self, @cols) = @_;
- push(@{$all_code->{$local_class}},
- { method => 'belongs_to',
- args => [ $remote_relname,
- $remote_class,
- \%cond,
- $self->_remote_attrs($local_moniker, $local_cols),
- ],
+ my @adjectives;
+
+ foreach my $col (@cols) {
+ my @words = split_name $col;
+
+ my $tagged = $self->_tagger->get_readable(join ' ', @words);
+
+ push @adjectives, $tagged =~ m{\G(\w+)/JJ\s+}g;
+ }
+
+ return @adjectives;
+}
+
+sub _disambiguate {
+ my ($self, $all_rels, $dups) = @_;
+
+ foreach my $dup (keys %$dups) {
+ my @rels = @{ $dups->{$dup} };
+
+ foreach my $rel (@rels) {
+ next if $rel->{method} eq 'belongs_to';
+
+ my @to_cols = apply { s/^foreign\.//i }
+ keys %{ $rel->{args}[2] };
+
+ my @adjectives = $self->_adjectives(@to_cols);
+
+ # If there are no adjectives, and there is only one might_have
+ # rel to that class, we hardcode 'active'.
+
+ my $to_class = $rel->{args}[1];
+
+ if ((not @adjectives)
+ && (grep { $_->{method} eq 'might_have'
+ && $_->{args}[1] eq $to_class } @$all_rels) == 1) {
+
+ @adjectives = 'active';
}
- );
- my %rev_cond = reverse %cond;
- for (keys %rev_cond) {
- $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
- delete $rev_cond{$_};
- }
+ if (@adjectives) {
+ my $rel_name = join '_', sort(@adjectives), $rel->{args}[0];
+
+ $rel_name = $rel->{method} eq 'might_have' ?
+ $self->_inflect_singular($rel_name)
+ :
+ $self->_inflect_plural($rel_name);
+
+ my $moniker = $rel->{extra}{moniker};
+
+ my @from_cols = apply { s/^self\.//i }
+ values %{ $rel->{args}[2] };
- push(@{$all_code->{$remote_class}},
- { method => $remote_method,
- args => [ $local_relname,
- $local_class,
- \%rev_cond,
- $self->_relationship_attrs($remote_method),
- ],
+ $rel_name = $self->_resolve_relname_collision($moniker, \@from_cols, $rel_name);
+
+ $rel->{args}[0] = $rel_name;
}
- );
+ }
}
- return $all_code;
+ # Check again for duplicates, since the heuristics above may not have resolved them all.
+
+ if ($dups = $self->_duplicates($all_rels)) {
+ foreach my $dup (keys %$dups) {
+ # sort by method
+ my @rels = map $_->[1], sort { $a->[0] <=> $b->[0] } map [
+ ($_->{method} eq 'belongs_to' ? 3 : $_->{method} eq 'has_many' ? 2 : 1), $_
+ ], @{ $dups->{$dup} };
+
+ my $rel_num = 2;
+
+ foreach my $rel (@rels[1 .. $#rels]) {
+ my $inflect_type = $rel->{method} eq 'has_many' ?
+ 'inflect_plural'
+ :
+ 'inflect_singular';
+
+ my $inflect_method = "_$inflect_type";
+
+ my $relname_new_uninflected =
+ $self->_inflect_singular($rel->{args}[0]) . "_$rel_num";
+
+ $rel_num++;
+
+ my $relname_new = $self->$inflect_method($relname_new_uninflected);
+
+ my $moniker = $rel->{extra}{moniker};
+
+ my @from_cols = apply { s/^self\.//i }
+ values %{ $rel->{args}[2] };
+
+ warn <<"EOF";
+Could not find a proper name for relationship '$relname_new' in source '$moniker' for columns '@{[ join ',', @from_cols ]}'.
+Supply a value in '$inflect_type' for '$relname_new_uninflected' to name this relationship.
+EOF
+
+ $rel->{args}[0] = $relname_new;
+ }
+ }
+ }
}
sub _relnames_and_method {
return ( $local_relname, $remote_relname, $remote_method );
}
-sub cleanup {
+sub _cleanup {
my $self = shift;
for my $class (@{ $self->_temp_classes }) {
package DBIx::Class::TestComponentForMap;
-sub dbix_class_testcomponentformap { 'dbix_class_testcomponentformap works' }
+sub dbix_class_testcomponentmap { 'dbix_class_testcomponentmap works' }
1;
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/;
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 'Mysql';
$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 + $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];
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);
}
}
}
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}, 124 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);
# 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
$conn->storage->disconnect; # for access
- $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)');
+ if (lc($self->{vendor}) ne 'sybase') {
+ $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}
+ 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
- $conn->storage->dbh->do("DROP TABLE loader_test30");
+ $self->drop_table($conn->storage->dbh, 'loader_test30');
@new = $self->rescan_without_warnings($conn);
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 (
my @tables_preserve_case_tests = qw/ LoaderTest41 LoaderTest40 /;
- 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);
+ # 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 / commitdiff