X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=fde0a2ebf047d3b0176ab8f7e5974a49aea00b81;hb=18eb280f9b71785a12c105299f813358faa47143;hp=a2f1218770113fcddb2e2ceb5e5446a567380315;hpb=6bb8fa3c45e71b384cd8217753152fd13381431a;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 a2f1218..fde0a2e 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -28,7 +28,7 @@ use List::MoreUtils qw/all any firstidx uniq/;
 use File::Temp 'tempfile';
 use namespace::clean;
 
-our $VERSION = '0.07013';
+our $VERSION = '0.07018';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -239,23 +239,20 @@ In general, there is very little difference between v5 and v6 schemas.
 =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
@@ -1486,19 +1483,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);
@@ -1509,13 +1506,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 };
@@ -1527,9 +1524,8 @@ 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;
@@ -1547,7 +1543,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,
                 );
             }
@@ -1562,9 +1558,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
@@ -1577,10 +1572,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.
@@ -2552,9 +2545,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}});
@@ -2683,7 +2683,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" );
@@ -2691,6 +2691,14 @@ 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</$rel1> -> $rel2" );
+        $self->_pod_cut( $class );
+        $self->{_relations_started} { $class } = 1;
     }
     elsif ($method eq 'add_unique_constraint') {
         $self->_pod($class, '=head1 UNIQUE CONSTRAINTS')