use Try::Tiny;
use DBIx::Class ();
use Encode qw/encode decode/;
-use List::MoreUtils qw/all firstidx/;
+use List::MoreUtils qw/all any firstidx uniq/;
use File::Temp 'tempfile';
use namespace::clean;
-our $VERSION = '0.07012';
+our $VERSION = '0.07014';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
=item v7
This mode is identical to C<v6> mode, except that monikerization of CamelCase
-table names is also done correctly.
+table names is also done better (but best in v8.)
-CamelCase column names in case-preserving mode will also be handled correctly
-for relationship name inflection. See L</preserve_case>.
+CamelCase column names in case-preserving mode will also be handled better
+for relationship name inflection (but best in v8.) See L</preserve_case>.
In this mode, CamelCase L</column_accessors> are normalized based on case
transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
-If you don't have any CamelCase table or column names, you can upgrade without
-breaking any of your code.
-
=item v8
(EXPERIMENTAL)
for all owners in all databases.
-You may need to control naming of monikers with L</moniker_parts> if you have
-name clashes for tables in different schemas/databases.
+Name clashes resulting from the same table name in different databases/schemas
+will be resolved automatically by prefixing the moniker with the database
+and/or schema.
+
+To prefix/suffix all monikers with the database and/or schema, see
+L</moniker_parts>.
=head2 moniker_parts
Overrides the default table name to moniker translation. Can be either a
hashref of table keys and moniker values, or a coderef for a translator
function taking a L<table object|DBIx::Class::Schema::Loader::Table> argument
-and returning a scalar moniker. If the hash entry does not exist, or the
-function returns a false value, the code falls back to default behavior for
-that table name.
+(which stringifies to the unqualified table name) and returning a scalar
+moniker. If the hash entry does not exist, or the function returns a false
+value, the code falls back to default behavior for that table name.
The default behavior is to split on case transition and non-alphanumeric
boundaries, singularize the resulting phrase, then join the titlecased words
full_table_name => schema-qualified name of the database table (RDBMS specific),
schema_class => name of the schema class we are building,
column_info => hashref of column info (data_type, is_nullable, etc),
- }
+ }
+
+the L<table object|DBIx::Class::Schema::Loader::Table> stringifies to the
+unqualified table name.
=head2 rel_name_map
Must be a coderef that returns a hashref with the extra attributes.
-Receives the L<table object|DBIx::Class::Schema::Loader::Table>, column name
-and column_info.
+Receives the L<table object|DBIx::Class::Schema::Loader::Table> (which
+stringifies to the unqualified table name), column name and column_info.
For example:
sub _load_tables {
my ($self, @tables) = @_;
- # Save the new tables to the tables list
+ # Save the new tables to the tables list and compute monikers
foreach (@tables) {
- $self->_tables->{$_->sql_name} = $_;
+ $self->_tables->{$_->sql_name} = $_;
+ $self->monikers->{$_->sql_name} = $self->_table2moniker($_);
}
- $self->_make_src_class($_) for @tables;
-
- # sanity-check for moniker clashes
+ # check for moniker clashes
my $inverse_moniker_idx;
foreach my $table (values %{ $self->_tables }) {
- push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
+ push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
}
my @clashes;
foreach my $moniker (keys %$inverse_moniker_idx) {
- my $tables = $inverse_moniker_idx->{$moniker};
- if (@$tables > 1) {
- push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
- join (', ', map $_->sql_name, @$tables),
- $moniker,
- );
- }
+ my $tables = $inverse_moniker_idx->{$moniker};
+ if (@$tables > 1) {
+ my $different_databases =
+ $tables->[0]->can('database') && (uniq map $_->database||'', @$tables) > 1;
+
+ my $different_schemas =
+ (uniq map $_->schema||'', @$tables) > 1;
+
+ if ($different_databases || $different_schemas) {
+ my ($use_schema, $use_database) = (1, 0);
+
+ if ($different_databases) {
+ $use_database = 1;
+
+ # If any monikers are in the same database, we have to distinguish by
+ # both schema and database.
+ my %db_counts;
+ $db_counts{$_}++ for map $_->database, @$tables;
+ $use_schema = any { $_ > 1 } values %db_counts;
+ }
+
+ delete $self->monikers->{$_->sql_name} for @$tables;
+
+ my $moniker_parts = [ @{ $self->moniker_parts } ];
+
+ my $have_schema = 1 if any { $_ eq 'schema' } @{ $self->moniker_parts };
+ my $have_database = 1 if any { $_ eq 'database' } @{ $self->moniker_parts };
+
+ unshift @$moniker_parts, 'schema' if $use_schema && !$have_schema;
+ unshift @$moniker_parts, 'database' if $use_database && !$have_database;
+
+ local $self->{moniker_parts} = $moniker_parts;
+
+ my %new_monikers;
+
+ $new_monikers{$_->sql_name} = $self->_table2moniker($_) for @$tables;
+
+ $self->monikers->{$_} = $new_monikers{$_} for map $_->sql_name, @$tables;
+
+ # check if there are still clashes
+ my %by_moniker;
+
+ while (my ($t, $m) = each %new_monikers) {
+ push @{ $by_moniker{$m} }, $t;
+ }
+
+ foreach my $m (grep @{ $by_moniker{$_} } > 1, keys %by_moniker) {
+ push @clashes, sprintf ("tried disambiguating by moniker_parts, but tables %s still reduced to the same source moniker '%s'",
+ join (', ', @{ $by_moniker{$m} }),
+ $m,
+ );
+ }
+ }
+ else {
+ push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
+ join (', ', map $_->sql_name, @$tables),
+ $moniker,
+ );
+ }
+ }
}
if (@clashes) {
- die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
- . 'In multi db_schema configurations you may need to set moniker_parts, '
- . 'otherwise change the naming style, or supply an explicit moniker_map: '
- . join ('; ', @clashes)
- . "\n"
- ;
+ die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
+ . 'Change the naming style, or supply an explicit moniker_map: '
+ . join ('; ', @clashes)
+ . "\n"
+ ;
}
+ $self->_make_src_class($_) for @tables;
+
$self->_setup_src_meta($_) for @tables;
if(!$self->skip_relationships) {
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $table_moniker = $self->_table2moniker($table);
+ my $table_moniker = $self->monikers->{$table->sql_name};
my @result_namespace = ($schema_class);
if ($self->use_namespaces) {
my $result_namespace = $self->result_namespace || 'Result';
}
$self->classes->{$table->sql_name} = $table_class;
- $self->monikers->{$table->sql_name} = $table_moniker;
$self->moniker_to_table->{$table_moniker} = $table;
$self->class_to_table->{$table_class} = $table;
foreach my $src_class (sort keys %$rel_stmts) {
# sort by rel name
- my @src_stmts = map $_->[1],
- sort { $a->[0] cmp $b->[0] }
- map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
+ my @src_stmts = map $_->[2],
+ sort {
+ $a->[0] <=> $b->[0]
+ ||
+ $a->[1] cmp $b->[1]
+ } map [
+ ($_->{method} eq 'many_to_many' ? 1 : 0),
+ $_->{args}[0],
+ $_,
+ ], @{ $rel_stmts->{$src_class} };
foreach my $stmt (@src_stmts) {
$self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
}
}
$self->_pod_cut( $class );
- } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
+ } elsif ( $method =~ /^(?:belongs_to|has_many|might_have)\z/ ) {
$self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
my ( $accessor, $rel_class ) = @_;
$self->_pod( $class, "=head2 $accessor" );
$self->_pod( $class, "Related object: L<$rel_class>" );
$self->_pod_cut( $class );
$self->{_relations_started} { $class } = 1;
+ } elsif ( $method eq 'many_to_many' ) {
+ $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
+ my ( $accessor, $rel1, $rel2 ) = @_;
+ $self->_pod( $class, "=head2 $accessor" );
+ $self->_pod( $class, 'Type: many_to_many' );
+ $self->_pod( $class, "Composing rels: L</$rel1> -> $rel2" );
+ $self->_pod_cut( $class );
+ $self->{_relations_started} { $class } = 1;
}
elsif ($method eq 'add_unique_constraint') {
$self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff