use File::Temp 'tempfile';
use namespace::clean;
-our $VERSION = '0.07012';
+our $VERSION = '0.07018';
__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)
The default mode is L</v7>, to get L</v8> mode, you have to specify it in
-L</naming> explictly until C<0.08> comes out.
+L</naming> explicitly until C<0.08> comes out.
L</monikers> and L</column_accessors> are created using
L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
# check for moniker clashes
my $inverse_moniker_idx;
- foreach my $table (values %{ $self->_tables }) {
- push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
+ foreach my $imtable (values %{ $self->_tables }) {
+ push @{ $inverse_moniker_idx->{$self->monikers->{$imtable->sql_name}} }, $imtable;
}
my @clashes;
foreach my $moniker (keys %$inverse_moniker_idx) {
- my $tables = $inverse_moniker_idx->{$moniker};
- if (@$tables > 1) {
+ my $imtables = $inverse_moniker_idx->{$moniker};
+ if (@$imtables > 1) {
my $different_databases =
- $tables->[0]->can('database') && (uniq map $_->database||'', @$tables) > 1;
+ $imtables->[0]->can('database') && (uniq map $_->database||'', @$imtables) > 1;
my $different_schemas =
- (uniq map $_->schema||'', @$tables) > 1;
+ (uniq map $_->schema||'', @$imtables) > 1;
if ($different_databases || $different_schemas) {
my ($use_schema, $use_database) = (1, 0);
# 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;
+ $db_counts{$_}++ for map $_->database, @$imtables;
$use_schema = any { $_ > 1 } values %db_counts;
}
- delete $self->monikers->{$_->sql_name} for @$tables;
+ foreach my $tbl (@$imtables) { delete $self->monikers->{$tbl->sql_name}; }
- my $moniker_parts = $self->{moniker_parts};
+ 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 };
my %new_monikers;
- $new_monikers{$_->sql_name} = $self->_table2moniker($_) for @$tables;
-
- $self->monikers->{$_} = $new_monikers{$_} for map $_->sql_name, @$tables;
+ foreach my $tbl (@$imtables) { $new_monikers{$tbl->sql_name} = $self->_table2moniker($tbl); }
+ foreach my $name (map $_->sql_name, @$imtables) { $self->monikers->{$name} = $new_monikers{$name}; }
# check if there are still clashes
my %by_moniker;
}
else {
push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
- join (', ', map $_->sql_name, @$tables),
+ join (', ', map $_->sql_name, @$imtables),
$moniker,
);
}
;
}
- $self->_make_src_class($_) for @tables;
-
- $self->_setup_src_meta($_) for @tables;
+ foreach my $tbl (@tables) { $self->_make_src_class($tbl); }
+ foreach my $tbl (@tables) { $self->_setup_src_meta($tbl); }
if(!$self->skip_relationships) {
# The relationship loader needs a working schema
@INC = grep $_ ne $self->dump_directory, @INC;
}
- $self->_load_roles($_) for @tables;
-
- $self->_load_external($_)
- for map { $self->classes->{$_->sql_name} } @tables;
+ foreach my $tbl (@tables) { $self->_load_roles($tbl); }
+ foreach my $tbl (map { $self->classes->{$_->sql_name} } @tables) { $self->_load_external($tbl); }
# Reload without unloading first to preserve any symbols from external
# packages.
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