Add option to allow extra columns in many_to_many link tables

The primary key must still equal the union of the foreign keys.

diff --git a/Changes b/Changes
index 636f703..f8363ac 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
         - Fix many_to_many bridges with overlapping foreign keys
+        - Add option to allow extra columns in many_to_many link tables
         - Document how to add perltidy markers via filter_generated_code
         - Fix DB2 foreign-key introspection
         - Remove dependency on List::MoreUtils and Sub::Name

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 26d952a..3cd33f1 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -84,6 +84,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 moniker_to_table
                                 uniq_to_primary
                                 quiet
+                                allow_extra_m2m_cols
 /);
 
 
@@ -993,6 +994,13 @@ Automatically promotes the largest unique constraints with non-nullable columns
 on tables to primary keys, assuming there is only one largest unique
 constraint.
 
+=head2 allow_extra_m2m_cols
+
+Generate C<many_to_many> relationship bridges even if the link table has
+extra columns other than the foreign keys.  The primary key must still
+equal the union of the foreign keys.
+
+
 =head2 filter_generated_code
 
 An optional hook that lets you filter the generated text for various classes

diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index b3ea5ef..18d0c85 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -115,6 +115,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
     relationship_attrs
     rel_collision_map
     rel_name_map
+    allow_extra_m2m_cols
     _temp_classes
     __tagger
 /);
@@ -133,12 +134,11 @@ sub new {
 
     my $self = {
         loader             => $loader,
-        schema             => $loader->schema,
-        inflect_plural     => $loader->inflect_plural,
-        inflect_singular   => $loader->inflect_singular,
-        relationship_attrs => $loader->relationship_attrs,
-        rel_collision_map  => $loader->rel_collision_map,
-        rel_name_map       => $loader->rel_name_map,
+        (map { $_ => $loader->$_ } qw(
+            schema inflect_plural inflect_singular
+            relationship_attrs rel_collision_map
+            rel_name_map allow_extra_m2m_cols
+        )),
         _temp_classes      => [],
     };
 
@@ -558,8 +558,10 @@ sub _generate_m2ms {
         my @link_table_primary_cols =
             @{[ $self->schema->source($link_moniker)->primary_columns ]};
 
-        next unless uniq(@{$class[0]{from_link_cols}}, @{$class[1]{from_link_cols}}) == @link_table_cols
-            && @link_table_cols == @link_table_primary_cols;
+        next unless array_eq(
+            [ sort +uniq @{$class[0]{from_link_cols}}, @{$class[1]{from_link_cols}} ],
+            [ sort @link_table_primary_cols ],
+        ) && ($self->allow_extra_m2m_cols || @link_table_cols == @link_table_primary_cols);
 
         foreach my $this (0, 1) {
             my $that = $this ? 0 : 1;