From: Rafael Kitover Date: Sat, 27 Mar 2010 22:08:02 +0000 (-0400) Subject: major version -> v6, more tests needed X-Git-Tag: 0.06000~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ecf930e6ea3321d8ae6e042b282c824897684c18;p=dbsrgits%2FDBIx-Class-Schema-Loader.git major version -> v6, more tests needed --- diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index b1036e1..fe61d13 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -13,6 +13,7 @@ use File::Spec qw//; use Cwd qw//; use Digest::MD5 qw//; use Lingua::EN::Inflect::Number qw//; +use Lingua::EN::Inflect::Phrase qw//; use File::Temp qw//; use Class::Unload; use Class::Inspector (); @@ -110,15 +111,15 @@ with the same name found in @INC into the schema file we are creating. =head2 naming -Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX +Static schemas (ones dumped to disk) will, by default, use the new-style relationship names and singularized Results, unless you're overwriting an -existing dump made by a 0.04XXX version of L, in -which case the backward compatible RelBuilder will be activated, and -singularization will be turned off. +existing dump made by an older version of L, in +which case the backward compatible RelBuilder will be activated, and the +appropriate monikerization used. Specifying - naming => 'v5' + naming => 'current' will disable the backward-compatible RelBuilder and use the new-style relationship names along with singularized Results, even when @@ -126,7 +127,7 @@ overwriting a dump made with an earlier version. The option also takes a hashref: - naming => { relationships => 'v5', monikers => 'v4' } + naming => { relationships => 'v6', monikers => 'v6' } The keys are: @@ -148,15 +149,26 @@ The values can be: =item current -Latest default style, whatever that happens to be. +Latest style, whatever that happens to be. + +=item v4 + +Unsingularlized monikers, C only relationships with no _id stripping. =item v5 -Version 0.05XXX style. +Monikers singularized as whole words, C relationships for FKs on +C constraints, C<_id> stripping for belongs_to relationships. -=item v4 +Some of the C<_id> stripping edge cases in C<0.05003> have been reverted for +the v5 RelBuilder. + +=item v6 -Version 0.04XXX style. +All monikers and relationships inflected using L, +more aggressive C<_id> stripping from relationships. + +In general, there is very little difference between v5 and v6 schemas. =back @@ -908,12 +920,21 @@ sub _relbuilder { $self->schema, $self->inflect_plural, $self->inflect_singular ); } + elsif ($self->naming->{relationships} eq 'v5') { + require DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_05; + return $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_05->new ( + $self->schema, + $self->inflect_plural, + $self->inflect_singular, + $self->relationship_attrs, + ); + } - $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new ( - $self->schema, - $self->inflect_plural, - $self->inflect_singular, - $self->relationship_attrs, + return $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new ( + $self->schema, + $self->inflect_plural, + $self->inflect_singular, + $self->relationship_attrs, ); } @@ -1471,9 +1492,15 @@ sub _default_table2moniker { if ($self->naming->{monikers} eq 'v4') { return join '', map ucfirst, split /[\W_]+/, lc $table; } + elsif ($self->naming->{monikers} eq 'v5') { + return join '', map ucfirst, split /[\W_]+/, + Lingua::EN::Inflect::Number::to_S(lc $table); + } + + (my $as_phrase = lc $table) =~ s/_+/ /g; + my $inflected = Lingua::EN::Inflect::Phrase::to_S($as_phrase); - return join '', map ucfirst, split /[\W_]+/, - Lingua::EN::Inflect::Number::to_S(lc $table); + return join '', map ucfirst, split /\W+/, $inflected; } sub _table2moniker { diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index 33562aa..c98a579 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -4,7 +4,6 @@ use strict; use warnings; use Class::C3; use Carp::Clan qw/^DBIx::Class/; -use Lingua::EN::Inflect::Number (); use Lingua::EN::Inflect::Phrase (); our $VERSION = '0.06000'; @@ -77,7 +76,6 @@ arguments, like so: =cut sub new { - my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_; my $self = { @@ -99,7 +97,7 @@ sub new { # pluralize a relationship name sub _inflect_plural { - my ($self, $relname, $method) = @_; + my ($self, $relname) = @_; return '' if !defined $relname || $relname eq ''; @@ -112,14 +110,12 @@ sub _inflect_plural { return $inflected if $inflected; } - $method ||= '_to_PL'; - - return $self->$method($relname); + return $self->_to_PL($relname); } # Singularize a relationship name sub _inflect_singular { - my ($self, $relname, $method) = @_; + my ($self, $relname) = @_; return '' if !defined $relname || $relname eq ''; @@ -132,9 +128,7 @@ sub _inflect_singular { return $inflected if $inflected; } - $method ||= '_to_S'; - - return $self->$method($relname); + return $self->_to_S($relname); } sub _to_PL { @@ -147,12 +141,6 @@ sub _to_PL { return $plural; } -sub _old_to_PL { - my ($self, $name) = @_; - - return Lingua::EN::Inflect::Number::to_PL($name); -} - sub _to_S { my ($self, $name) = @_; @@ -163,12 +151,6 @@ sub _to_S { return $singular; } -sub _old_to_S { - my ($self, $name) = @_; - - return Lingua::EN::Inflect::Number::to_S($name); -} - sub _default_relationship_attrs { +{ has_many => { cascade_delete => 0, @@ -206,7 +188,7 @@ sub _relationship_attrs { } sub _array_eq { - my ($a, $b) = @_; + my ($self, $a, $b) = @_; return unless @$a == @$b; @@ -321,16 +303,16 @@ sub _relnames_and_method { my $remote_moniker = $rel->{remote_source}; my $remote_obj = $self->{schema}->source( $remote_moniker ); my $remote_class = $self->{schema}->class( $remote_moniker ); - my $remote_relname = lc $self->_remote_relname( $remote_obj->from, $cond); + my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond); my $local_cols = $rel->{local_columns}; my $local_table = $self->{schema}->source($local_moniker)->from; # If more than one rel between this pair of tables, use the local # col names to distinguish - my ($local_relname, $old_local_relname, $local_relname_uninflected, $old_local_relname_uninflected); + my ($local_relname, $local_relname_uninflected); if ( $counters->{$remote_moniker} > 1) { - my $colnames = lc(q{_} . join(q{_}, @$local_cols)); + my $colnames = lc(q{_} . join(q{_}, map lc($_), @$local_cols)); $remote_relname .= $colnames if keys %$cond > 1; $local_relname = lc($local_table) . $colnames; @@ -338,31 +320,21 @@ sub _relnames_and_method { $local_relname_uninflected = $local_relname; $local_relname = $self->_inflect_plural( $local_relname ); - - $old_local_relname_uninflected = lc($local_table) . $colnames; - $old_local_relname = $self->_inflect_plural( lc($local_table) . $colnames, '_old_to_PL' ); - } else { $local_relname_uninflected = lc $local_table; $local_relname = $self->_inflect_plural(lc $local_table); - - $old_local_relname_uninflected = lc $local_table; - $old_local_relname = $self->_inflect_plural(lc $local_table, '_old_to_PL'); } my $remote_method = 'has_many'; # If the local columns have a UNIQUE constraint, this is a one-to-one rel my $local_source = $self->{schema}->source($local_moniker); - if (_array_eq([ $local_source->primary_columns ], $local_cols) || - grep { _array_eq($_->[1], $local_cols) } @$uniqs) { + if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) || + grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) { $remote_method = 'might_have'; $local_relname = $self->_inflect_singular($local_relname_uninflected); - $old_local_relname = $self->_inflect_singular($old_local_relname_uninflected, '_old_to_S'); } - warn __PACKAGE__." $VERSION: renaming ${remote_class} relation '$old_local_relname' to '$local_relname'. This behavior is new as of 0.05003.\n" if $old_local_relname && $local_relname ne $old_local_relname; - return ( $local_relname, $remote_relname, $remote_method ); } diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm index 4eebaf6..147b026 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm @@ -3,9 +3,11 @@ package DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040; use strict; use warnings; use Class::C3; +use base 'DBIx::Class::Schema::Loader::RelBuilder'; +use Carp::Clan qw/^DBIx::Class/; use Lingua::EN::Inflect::Number (); -use base 'DBIx::Class::Schema::Loader::RelBuilder'; +our $VERSION = '0.06000'; sub _default_relationship_attrs { +{} } @@ -52,8 +54,6 @@ sub _relnames_and_method { sub _remote_attrs { } -1; - =head1 NAME DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040 - RelBuilder for @@ -61,6 +61,18 @@ compatibility with DBIx::Class::Schema::Loader version 0.04006 =head1 DESCRIPTION -See L. +See L and +L. + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. =cut + +1; diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_05.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_05.pm new file mode 100644 index 0000000..c6d3ec7 --- /dev/null +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_05.pm @@ -0,0 +1,87 @@ +package DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_05; + +use strict; +use warnings; +use Class::C3; +use base 'DBIx::Class::Schema::Loader::RelBuilder'; +use Carp::Clan qw/^DBIx::Class/; +use Lingua::EN::Inflect::Number (); + +our $VERSION = '0.06000'; + +sub _to_PL { + my ($self, $name) = @_; + + return Lingua::EN::Inflect::Number::to_PL($name); +} + +sub _to_S { + my ($self, $name) = @_; + + return Lingua::EN::Inflect::Number::to_S($name); +} + +sub _default_relationship_attrs { +{} } + +sub _relnames_and_method { + my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_; + + my $remote_moniker = $rel->{remote_source}; + my $remote_obj = $self->{schema}->source( $remote_moniker ); + my $remote_class = $self->{schema}->class( $remote_moniker ); + my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond); + + my $local_cols = $rel->{local_columns}; + my $local_table = $self->{schema}->source($local_moniker)->from; + + # If more than one rel between this pair of tables, use the local + # col names to distinguish + my ($local_relname, $local_relname_uninflected); + if ( $counters->{$remote_moniker} > 1) { + my $colnames = lc(q{_} . join(q{_}, map lc($_), @$local_cols)); + $remote_relname .= $colnames if keys %$cond > 1; + + $local_relname = lc($local_table) . $colnames; + + $local_relname_uninflected = $local_relname; + $local_relname = $self->_inflect_plural( $local_relname ); + } else { + $local_relname_uninflected = lc $local_table; + $local_relname = $self->_inflect_plural(lc $local_table); + } + + my $remote_method = 'has_many'; + + # If the local columns have a UNIQUE constraint, this is a one-to-one rel + my $local_source = $self->{schema}->source($local_moniker); + if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) || + grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) { + $remote_method = 'might_have'; + $local_relname = $self->_inflect_singular($local_relname_uninflected); + } + + return ( $local_relname, $remote_relname, $remote_method ); +} + +=head1 NAME + +DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_05 - RelBuilder for +compatibility with DBIx::Class::Schema::Loader version 0.05000 + +=head1 DESCRIPTION + +See L and +L. + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/t/25backcompat_v4.t b/t/25backcompat.t similarity index 89% rename from t/25backcompat_v4.t rename to t/25backcompat.t index bb9d54d..dfb4f4e 100644 --- a/t/25backcompat_v4.t +++ b/t/25backcompat.t @@ -45,7 +45,7 @@ sub class_content_like; { my $res = run_loader(naming => 'current'); is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; - run_v5_tests($res); + run_v6_tests($res); } # test upgraded dynamic schema with external content loaded @@ -82,7 +82,7 @@ sub class_content_like; 'unsingularized class names in external content from unchanged Result class ' . 'names are translated'; - run_v5_tests($res); + run_v6_tests($res); } # test upgraded dynamic schema with use_namespaces with external content loaded @@ -116,7 +116,7 @@ sub class_content_like; 'unsingularized class names in external content from unchanged Result class ' . 'names are translated'; - run_v5_tests($res); + run_v6_tests($res); } # test upgraded static schema with external content loaded @@ -133,7 +133,7 @@ sub class_content_like; my $res = run_loader(static => 1, naming => 'current'); my $schema = $res->{schema}; - run_v5_tests($res); + run_v6_tests($res); lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } 'external custom content for unsingularized Result was loaded by upgraded ' . @@ -155,6 +155,29 @@ sub class_content_like; 'external custom content loaded into static dump correctly'; } +# test creating static schema in v5 mode then upgrade to current with external +# content loaded +# XXX needs real load_external tests +{ + clean_dumpdir(); + + my $temp_dir = setup_load_external({ + Quux => 'Baz', + Bar => 'Foo', + }, { result_namespace => 'Result' }); + + write_v5_schema_pm(); + + my $res = run_loader(static => 1); + + run_v5_tests($res); + + $res = run_loader(static => 1, naming => 'current'); + my $schema = $res->{schema}; + + run_v6_tests($res); +} + # test running against v4 schema without upgrade, twice, then upgrade { clean_dumpdir(); @@ -201,9 +224,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); - is result_count('Result'), 4, + is result_count('Result'), 6, 'un-singularized results were replaced during upgrade'; # check that custom content was preserved @@ -265,9 +288,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); - is result_count(), 4, + is result_count(), 6, 'un-singularized results were replaced during upgrade'; # check that custom content was preserved @@ -282,7 +305,7 @@ sub class_content_like; 'custom content from unsingularized Result loaded into static dump correctly'; } -# test running against v4 schema with load_namespaces, upgrade to v5 but +# test running against v4 schema with load_namespaces, upgrade to current but # downgrade to load_classes, with external content { clean_dumpdir(); @@ -319,7 +342,7 @@ sub class_content_like; rel_name_map => { QuuxBaz => 'bazrel2' }, }); - # now upgrade the schema to v5 but downgrade to load_classes + # now upgrade the schema to current but downgrade to load_classes $res = run_loader( static => 1, naming => 'current', @@ -339,9 +362,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); - is result_count(), 4, + is result_count(), 6, 'un-singularized results were replaced during upgrade and Result dir removed'; ok ((not -d result_dir('Result')), @@ -396,7 +419,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema with use_namespaces => 0' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); my $schema = $res->{schema}; add_custom_content($res->{schema}, { @@ -423,7 +446,7 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes preserved on re-dump'; - run_v5_tests($res); + run_v6_tests($res); # now upgrade the schema to use_namespaces $res = run_loader( @@ -442,7 +465,7 @@ sub class_content_like; 'correct number of warnings on upgrading to use_namespaces' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); my @schema_files = schema_files(); @@ -479,7 +502,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', 'defaults to use_namespaces on regular dump'; @@ -502,7 +525,7 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', 'use_namespaces preserved on re-dump'; - run_v5_tests($res); + run_v6_tests($res); # now downgrade the schema to load_classes $res = run_loader( @@ -521,12 +544,12 @@ sub class_content_like; 'correct number of warnings on downgrading to load_classes' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes downgrade correct'; - is result_count(), 4, + is result_count(), 6, 'correct number of Results after upgrade and Result dir removed'; ok ((not -d result_dir('Result')), @@ -565,7 +588,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'defaults to use_namespaces and uses custom result_namespace'; @@ -589,7 +612,7 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'use_namespaces and custom result_namespace preserved on re-dump'; - run_v5_tests($res); + run_v6_tests($res); # now downgrade the schema to load_classes $res = run_loader( @@ -608,12 +631,12 @@ sub class_content_like; 'correct number of warnings on downgrading to load_classes' or diag @{ $res->{warnings} }; - run_v5_tests($res); + run_v6_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes downgrade correct'; - is result_count(), 4, + is result_count(), 6, 'correct number of Results after upgrade and Result dir removed'; ok ((not -d result_dir('MyResult')), @@ -653,7 +676,7 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'using new result_namespace'; - is result_count('MyResult'), 4, + is result_count('MyResult'), 6, 'correct number of Results after rewritten result_namespace'; ok ((not -d schema_dir('Result')), @@ -681,7 +704,7 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux', 'using new result_namespace'; - is result_count('Mtfnpy'), 4, + is result_count('Mtfnpy'), 6, 'correct number of Results after rewritten result_namespace'; ok ((not -d result_dir('MyResult')), @@ -749,7 +772,7 @@ sub class_content_like; # now upgrade the schema $res = run_loader(static => 1, naming => 'current'); $schema = $res->{schema}; - run_v5_tests($res); + run_v6_tests($res); # check that custom content was preserved lives_and { is $schema->resultset('Bar')->find(1)->b_method, 'dongs' } @@ -872,12 +895,68 @@ EOF } } +sub write_v5_schema_pm { + my %opts = @_; + + (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; + rmtree $schema_dir; + make_path $schema_dir; + my $schema_pm = "$schema_dir/Schema.pm"; + open my $fh, '>', $schema_pm or die $!; + if (exists $opts{use_namespaces} && $opts{use_namespaces} == 0) { + print $fh <<'EOF'; +package DBIXCSL_Test::Schema; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + + +# Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-27 17:07:37 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:LIzC/LT5IYvWpgusfbqMrg + + +# You can replace this text with custom content, and it will be preserved on regeneration +1; +EOF + } + else { + print $fh <<'EOF'; +package DBIXCSL_Test::Schema; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + + +# Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-27 17:07:37 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:LIzC/LT5IYvWpgusfbqMrg + + +# You can replace this text with custom content, and it will be preserved on regeneration +1; +EOF + } +} + sub run_v4_tests { my $res = shift; my $schema = $res->{schema}; - is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ], - [qw/Foos Bar Bazs Quuxs/], + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], + [qw/Foos Bar Bazs Quuxs StationsVisited Email/], 'correct monikers in 0.04006 mode'; isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }), @@ -891,14 +970,43 @@ sub run_v4_tests { isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet', 'correct rel type and name for UNIQUE FK in 0.04006 mode'; + + ok my $foo = eval { $schema->resultset('Foos')->find(1) }; + + isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', + 'correct rel name inflection in 0.04006 mode'; } sub run_v5_tests { my $res = shift; my $schema = $res->{schema}; - is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ], - [qw/Foo Bar Baz Quux/], + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], + [qw/Foo Bar Baz Quux StationsVisited Email/], + 'correct monikers in current mode'; + + ok my $bar = eval { $schema->resultset('Bar')->find(1) }; + + isa_ok eval { $bar->foo }, $res->{classes}{foos}, + 'correct rel name in v5 mode'; + + ok my $baz = eval { $schema->resultset('Baz')->find(1) }; + + isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, + 'correct rel type and name for UNIQUE FK in v5 mode'; + + ok my $foo = eval { $schema->resultset('Foo')->find(1) }; + + isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', + 'correct rel name inflection in v5 mode'; +} + +sub run_v6_tests { + my $res = shift; + my $schema = $res->{schema}; + + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], + [qw/Foo Bar Baz Quux StationVisited Email/], 'correct monikers in current mode'; ok my $bar = eval { $schema->resultset('Bar')->find(1) }; @@ -910,6 +1018,11 @@ sub run_v5_tests { isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, 'correct rel type and name for UNIQUE FK in current mode'; + + ok my $foo = eval { $schema->resultset('Foo')->find(1) }; + + isa_ok eval { $foo->emails_to }, 'DBIx::Class::ResultSet', + 'correct rel name inflection in current mode'; } { @@ -1075,3 +1188,5 @@ sub result_dir { } sub schema_dir { result_dir(@_) } + +# vim:et sts=4 sw=4 tw=0: diff --git a/t/lib/make_dbictest_db_with_unique.pm b/t/lib/make_dbictest_db_with_unique.pm index 62f6f9a..cd5e432 100644 --- a/t/lib/make_dbictest_db_with_unique.pm +++ b/t/lib/make_dbictest_db_with_unique.pm @@ -31,6 +31,14 @@ $dbh->do($_) for ( baz_id INTEGER NOT NULL UNIQUE, FOREIGN KEY (baz_id) REFERENCES bazs (baz_num) )|, + q|CREATE TABLE stations_visited ( + id INTEGER PRIMARY KEY + )|, + q|CREATE TABLE email ( + id INTEGER PRIMARY KEY, + to_id INTEGER REFERENCES foos (fooid), + from_id INTEGER REFERENCES foos (fooid) + )|, q|INSERT INTO foos VALUES (1,'Foos text for number 1')|, q|INSERT INTO foos VALUES (2,'Foos record associated with the Bar with barid 3')|, q|INSERT INTO foos VALUES (3,'Foos text for number 3')|, @@ -43,6 +51,7 @@ $dbh->do($_) for ( q|INSERT INTO bazs VALUES (2,19)|, q|INSERT INTO quuxs VALUES (1,20)|, q|INSERT INTO quuxs VALUES (2,19)|, + q|INSERT INTO stations_visited VALUES (1)|, ); END { unlink($fn); }