X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=db415c4bfeb9a5aa2ca74ed816316aa5acfe670a;hb=72cbfae0026775cefa8b060f27959e7e3dade8f4;hp=275efaeb1a64b09e2fb71db8e4955ddd63e575ca;hpb=8007f3a7c22764af4ccfda238cbc53325902c927;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 275efae..db415c4 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -23,6 +23,7 @@ use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
 use Encode qw/encode/;
+use List::MoreUtils 'all';
 use namespace::clean;
 
 our $VERSION = '0.07010';
@@ -72,6 +73,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 qualify_objects
                                 tables
                                 class_to_table
+                                uniq_to_primary
 /);
 
 
@@ -586,6 +588,12 @@ rather than column names/accessors.
 The default is to just append C<_rel> to the relationship name, see
 L</RELATIONSHIP NAME COLLISIONS>.
 
+=head2 uniq_to_primary
+
+Automatically promotes the largest unique constraints with non-nullable columns
+on tables to primary keys, assuming there is only one largest unique
+constraint.
+
 =head1 METHODS
 
 None of these methods are intended for direct invocation by regular
@@ -1134,8 +1142,7 @@ sub rescan {
         }
     }
 
-    delete $self->{_dump_storage};
-    delete $self->{_relations_started};
+    delete @$self{qw/_dump_storage _relations_started _uniqs_started/};
 
     my $loaded = $self->_load_tables(@current);
 
@@ -1919,8 +1926,6 @@ sub _setup_src_meta {
     # be careful to not create refs Data::Dump can "optimize"
     $full_table_name = \do {"".$full_table_name} if ref $table_name;
 
-    $self->_raw_stmt($table_class, ''); # add a blank line
-
     $self->_dbic_stmt($table_class, 'table', $full_table_name);
 
     my $cols     = $self->_table_columns($table);
@@ -1960,6 +1965,39 @@ sub _setup_src_meta {
 
     my $pks = $self->_table_pk_info($table) || [];
 
+    my %uniq_tag; # used to eliminate duplicate uniqs
+
+    $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
+
+    my $uniqs = $self->_table_uniq_info($table) || [];
+    my @uniqs;
+
+    foreach my $uniq (@$uniqs) {
+        my ($name, $cols) = @$uniq;
+        next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
+        push @uniqs, [$name, $cols];
+    }
+
+    my @non_nullable_uniqs = grep {
+        all { $col_info->{$_}{is_nullable} == 0 } @{ $_->[1] }
+    } @uniqs;
+
+    if ($self->uniq_to_primary && (not @$pks) && @non_nullable_uniqs) {
+        my @by_colnum = sort { $b->[0] <=> $a->[0] }
+            map [ scalar @{ $_->[1] }, $_ ], @non_nullable_uniqs;
+
+        if (not (@by_colnum > 1 && $by_colnum[0][0] == $by_colnum[1][0])) {
+            my @keys = map $_->[1], @by_colnum;
+
+            my $pk = $keys[0];
+
+            # remove the uniq from list
+            @uniqs = grep { $_->[0] ne $pk->[0] } @uniqs;
+
+            $pks = $pk->[1];
+        }
+    }
+
     foreach my $pkcol (@$pks) {
         $col_info->{$pkcol}{is_nullable} = 0;
     }
@@ -1970,19 +2008,13 @@ sub _setup_src_meta {
         map { $_, ($col_info->{$_}||{}) } @$cols
     );
 
-    my %uniq_tag; # used to eliminate duplicate uniqs
-
-    @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
-          : carp("$table has no primary key");
-    $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
+    $self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
+        if @$pks;
 
-    my $uniqs = $self->_table_uniq_info($table) || [];
-    for (@$uniqs) {
-        my ($name, $cols) = @$_;
-        next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
+    foreach my $uniq (@uniqs) {
+        my ($name, $cols) = @$uniq;
         $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
     }
-
 }
 
 sub __columns_info_for {