X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=3e77cadd341dd553f86f9af315e6c60e1311c7e0;hb=ef73d2ade02190ee6e89138aa52d19f7138272b1;hp=9d5292a32e2c656770c8cedbdb218d56d8b080e6;hpb=4c2e2ce9f827fbe28aa59e242050167d50ffc705;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 9d5292a..3e77cad 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -3,6 +3,7 @@ package DBIx::Class::Schema::Loader::Base; use strict; use warnings; use base qw/Class::Accessor::Grouped Class::C3::Componentised/; +use MRO::Compat; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; use DBIx::Class::Schema::Loader::RelBuilder (); @@ -28,7 +29,7 @@ use List::MoreUtils qw/all any firstidx uniq/; use File::Temp 'tempfile'; use namespace::clean; -our $VERSION = '0.07012'; +our $VERSION = '0.07027'; __PACKAGE__->mk_group_ro_accessors('simple', qw/ schema @@ -239,23 +240,20 @@ In general, there is very little difference between v5 and v6 schemas. =item v7 This mode is identical to C 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. +CamelCase column names in case-preserving mode will also be handled better +for relationship name inflection (but best in v8.) See L. In this mode, CamelCase L are normalized based on case transition instead of just being lowercased, so C becomes C. -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, to get L mode, you have to specify it in -L explictly until C<0.08> comes out. +L explicitly until C<0.08> comes out. L and L are created using L or L if @@ -450,7 +448,7 @@ C, C =item * Informix, MSSQL, Sybase ASE -C, C, C +C, C, C =back @@ -467,9 +465,9 @@ Exclude tables matching regex. Best specified as a qr// regex. 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 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 @@ -497,7 +495,10 @@ passed, the code is called with arguments of 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
stringifies to the +unqualified table name. =head2 rel_name_map @@ -593,7 +594,7 @@ load certain components for specified Result classes. For example: 'InflateColumn::DateTime', ], } - + You may use this in conjunction with L. =head2 result_roles @@ -613,7 +614,7 @@ certain roles for specified Result classes. For example: ], RouteChange => 'YourApp::Role::TripEvent', } - + You may use this in conjunction with L. =head2 use_namespaces @@ -688,8 +689,8 @@ L for a column. Must be a coderef that returns a hashref with the extra attributes. -Receives the L
, column name -and column_info. +Receives the L
(which +stringifies to the unqualified table name), column name and column_info. For example: @@ -884,7 +885,7 @@ sub new { } $self->result_components_map($self->{result_component_map}) } - + if (defined $self->{result_role_map}) { if (defined $self->result_roles_map) { croak "Specify only one of result_roles_map or result_role_map"; @@ -1483,19 +1484,19 @@ sub _load_tables { # 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); @@ -1506,13 +1507,13 @@ sub _load_tables { # 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 }; @@ -1524,15 +1525,14 @@ sub _load_tables { 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; - + while (my ($t, $m) = each %new_monikers) { - push @{ $by_moniker{$m} }, $t; + push @{ $by_moniker{$m} }, $t; } foreach my $m (grep @{ $by_moniker{$_} } > 1, keys %by_moniker) { @@ -1544,7 +1544,7 @@ sub _load_tables { } else { push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'", - join (', ', map $_->sql_name, @$tables), + join (', ', map $_->sql_name, @$imtables), $moniker, ); } @@ -1559,9 +1559,8 @@ sub _load_tables { ; } - $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 @@ -1574,10 +1573,8 @@ sub _load_tables { @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. @@ -1603,7 +1600,7 @@ sub _reload_classes { $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables); unshift @INC, $self->dump_directory; - + my @to_register; my %have_source = map { $_ => $self->schema->source($_) } $self->schema->sources; @@ -1611,7 +1608,7 @@ sub _reload_classes { for my $table (@tables) { my $moniker = $self->monikers->{$table->sql_name}; my $class = $self->classes->{$table->sql_name}; - + { no warnings 'redefine'; local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below @@ -1781,7 +1778,7 @@ sub _dump_to_dir { my $result_base_class = $self->result_base_class || 'DBIx::Class::Core'; foreach my $src_class (@classes) { - my $src_text = + my $src_text = qq|use utf8;\n| . qq|package $src_class;\n\n| . qq|# Created by DBIx::Class::Schema::Loader\n| @@ -1836,7 +1833,7 @@ sub _sig_comment { my ($self, $version, $ts) = @_; return qq|\n\n# Created by DBIx::Class::Schema::Loader| . qq| v| . $version - . q| @ | . $ts + . q| @ | . $ts . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|; } @@ -1981,7 +1978,7 @@ sub _default_moose_custom_content { if (not $is_schema) { return qq|\n__PACKAGE__->meta->make_immutable;|; } - + return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|; } @@ -2549,9 +2546,16 @@ sub _load_relationships { 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}}); @@ -2680,7 +2684,7 @@ sub _make_pod { } } $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" ); @@ -2688,16 +2692,24 @@ sub _make_pod { $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 -> $rel2" ); + $self->_pod_cut( $class ); + $self->{_relations_started} { $class } = 1; } elsif ($method eq 'add_unique_constraint') { $self->_pod($class, '=head1 UNIQUE CONSTRAINTS') unless $self->{_uniqs_started}{$class}; - + my ($name, $cols) = @_; $self->_pod($class, "=head2 C<$name>"); $self->_pod($class, '=over 4'); - + foreach my $col (@$cols) { $self->_pod($class, "=item \* L"); } @@ -2710,7 +2722,7 @@ sub _make_pod { elsif ($method eq 'set_primary_key') { $self->_pod($class, "=head1 PRIMARY KEY"); $self->_pod($class, '=over 4'); - + foreach my $col (@_) { $self->_pod($class, "=item \* L"); } @@ -2765,7 +2777,7 @@ sub __table_comment { if (my $code = $self->can('_table_comment')) { return $self->_filter_comment($self->$code(@_)); } - + return ''; }