From: Rafael Kitover Date: Wed, 18 May 2011 02:24:16 +0000 (-0400) Subject: handle duplicate relationship names (RT#64041) X-Git-Tag: 0.07011~106 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc379dc68c7a7d620e16ee91c0c57a0b875081bd;p=dbsrgits%2FDBIx-Class-Schema-Loader.git handle duplicate relationship names (RT#64041) --- diff --git a/Changes b/Changes index 06a78b7..345084b 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ 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 diff --git a/Makefile.PL b/Makefile.PL index 2291030..f2be71b 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -38,6 +38,7 @@ requires 'File::Spec' => 0; 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'; diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 526a19a..47dccab 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -93,6 +93,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/ datetime_undef_if_invalid _result_class_methods naming_set + tables /); =head1 NAME @@ -686,7 +687,8 @@ sub new { } $self->{monikers} = {}; - $self->{classes} = {}; + $self->{tables} = {}; + $self->{classes} = {}; $self->{_upgrading_classes} = {}; $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} ); @@ -1179,8 +1181,7 @@ sub _load_tables { $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 @@ -1688,6 +1689,7 @@ sub _make_src_class { $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}); @@ -1721,7 +1723,7 @@ sub _make_src_class { 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; @@ -1885,7 +1887,7 @@ sub _setup_src_meta { $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) { @@ -1994,17 +1996,24 @@ sub _table2moniker { } 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}; diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm index ba6f7be..3d48a83 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm @@ -108,7 +108,7 @@ sub _table_fk_info { } $sth->finish; - return $self->_table_fk_info_builder($table); + return $self->_table_fk_info_by_sp_helpconstraint($table); } sub _table_fk_info_by_name { @@ -142,58 +142,40 @@ 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; diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index 14307e9..5345749 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -7,6 +7,7 @@ use mro 'c3'; 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; @@ -44,9 +45,14 @@ Arguments: $base object =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 is the moniker name of the table which had the REFERENCES statements. The fk_info arrayref's contents should take the form: @@ -65,6 +71,17 @@ 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: @@ -90,6 +107,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/ relationship_attrs rel_collision_map _temp_classes + __tagger /); sub new { @@ -294,7 +312,9 @@ sub _resolve_relname_collision { 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/) { @@ -304,7 +324,7 @@ sub _resolve_relname_collision { } 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' } @@ -321,72 +341,224 @@ EOF } 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 { @@ -463,7 +635,7 @@ sub _relnames_and_method { return ( $local_relname, $remote_relname, $remote_method ); } -sub cleanup { +sub _cleanup { my $self = shift; for my $class (@{ $self->_temp_classes }) { diff --git a/t/lib/DBIx/Class/TestComponentForMap.pm b/t/lib/DBIx/Class/TestComponentForMap.pm index 8b3f715..882469e 100644 --- a/t/lib/DBIx/Class/TestComponentForMap.pm +++ b/t/lib/DBIx/Class/TestComponentForMap.pm @@ -1,5 +1,5 @@ package DBIx::Class::TestComponentForMap; -sub dbix_class_testcomponentformap { 'dbix_class_testcomponentformap works' } +sub dbix_class_testcomponentmap { 'dbix_class_testcomponentmap works' } 1; diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index bc7cd8a..7728ade 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -16,6 +16,7 @@ use DBIx::Class::Schema::Loader::Utils 'dumper_squashed'; 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/; @@ -97,12 +98,12 @@ sub run_tests { 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]; @@ -172,11 +173,11 @@ sub drop_extra_tables_only { 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); } } } @@ -360,7 +361,7 @@ sub test_schema { 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'; @@ -373,8 +374,8 @@ sub test_schema { && (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} @@ -463,10 +464,10 @@ sub test_schema { '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', @@ -556,7 +557,7 @@ sub test_schema { } 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}; @@ -772,10 +773,43 @@ sub test_schema { 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); @@ -954,9 +988,6 @@ sub test_schema { # 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 @@ -966,7 +997,15 @@ sub test_schema { $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 @@ -1083,7 +1122,7 @@ sub test_schema { } $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); @@ -1295,7 +1334,7 @@ sub create { 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}, @@ -1421,15 +1460,31 @@ sub create { (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 ( @@ -1440,8 +1495,9 @@ sub create { ) $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 ( @@ -1452,13 +1508,27 @@ sub create { 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 ( @@ -1840,11 +1910,18 @@ sub drop_tables { 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 @@ -1855,46 +1932,71 @@ sub drop_tables { $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 ) = @_;