From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Fri, 20 Dec 2013 22:18:53 +0000 (+0000)
Subject: Warn on belongs_to rels to non-unique columns
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fk-to-non-uniq;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

Warn on belongs_to rels to non-unique columns
---

diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index 8ae4559..b8cef85 100644
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'weaken';
 use DBIx::Class::Schema::Loader::Utils qw/split_name slurp_file array_eq/;
 use Try::Tiny;
 use List::Util 'first';
-use List::MoreUtils qw/apply uniq any/;
+use List::MoreUtils qw/apply uniq any none/;
 use namespace::clean;
 use Lingua::EN::Inflect::Phrase ();
 use Lingua::EN::Tagger ();
@@ -381,6 +381,7 @@ sub generate_code {
 
     # make a copy to destroy
     my @tables = @$tables;
+    my %uniq_cols = map { $_->[0] => [ map { $_->[1] } @{$_->[2]} ] } @tables;
 
     my $all_code = {};
 
@@ -433,6 +434,17 @@ sub generate_code {
                 $remote_moniker, $remote_cols, $remote_relname,
             );
 
+            if (!$self->loader->_disable_uniq_detection
+                && none { array_eq($_, $remote_cols) }
+                    [ $remote_obj->primary_columns ],
+                    @{$uniq_cols{$remote_moniker}},
+            ) {
+                warn <<"EOF";
+$local_method relationship '$remote_relname' in source '$local_moniker' references
+non-unique columns (@{[join(',', @$remote_cols)]}) in source '$remote_moniker'.
+EOF
+            }
+
             my $rel_attrs_params = {
                 rel_name      => $local_relname,
                 rel_type      => $local_method,