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 ();
=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<DBIx::Class::Schema::Loader>, 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<DBIx::Class::Schema::Loader>, 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
The option also takes a hashref:
- naming => { relationships => 'v5', monikers => 'v4' }
+ naming => { relationships => 'v6', monikers => 'v6' }
The keys are:
=item current
-Latest default style, whatever that happens to be.
+Latest style, whatever that happens to be.
+
+=item v4
+
+Unsingularlized monikers, C<has_many> only relationships with no _id stripping.
=item v5
-Version 0.05XXX style.
+Monikers singularized as whole words, C<might_have> relationships for FKs on
+C<UNIQUE> 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<Lingua::EN::Inflect::Phrase>,
+more aggressive C<_id> stripping from relationships.
+
+In general, there is very little difference between v5 and v6 schemas.
=back
$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,
);
}
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 {
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';
=cut
sub new {
-
my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
my $self = {
# pluralize a relationship name
sub _inflect_plural {
- my ($self, $relname, $method) = @_;
+ my ($self, $relname) = @_;
return '' if !defined $relname || $relname eq '';
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 '';
return $inflected if $inflected;
}
- $method ||= '_to_S';
-
- return $self->$method($relname);
+ return $self->_to_S($relname);
}
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) = @_;
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,
}
sub _array_eq {
- my ($a, $b) = @_;
+ my ($self, $a, $b) = @_;
return unless @$a == @$b;
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;
$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 );
}
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 { +{} }
sub _remote_attrs { }
-1;
-
=head1 NAME
DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040 - RelBuilder for
=head1 DESCRIPTION
-See L<DBIx::Class::Schema::Loader::Base/naming>.
+See L<DBIx::Class::Schema::Loader::Base/naming> and
+L<DBIx::Class::Schema::Loader::RelBuilder>.
+
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
=cut
+
+1;
--- /dev/null
+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<DBIx::Class::Schema::Loader::Base/naming> and
+L<DBIx::Class::Schema::Loader::RelBuilder>.
+
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
{
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
'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
'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
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 ' .
'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();
'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
'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
'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();
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',
'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')),
'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}, {
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(
'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();
'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';
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(
'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')),
'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';
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(
'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')),
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')),
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')),
# 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' }
}
}
+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) }),
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) };
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';
}
{
}
sub schema_dir { result_dir(@_) }
+
+# vim:et sts=4 sw=4 tw=0:
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')|,
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); }
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff