use Try::Tiny;
use DBIx::Class ();
use Encode qw/encode/;
+use List::MoreUtils 'all';
use namespace::clean;
our $VERSION = '0.07010';
qualify_objects
tables
class_to_table
+ uniq_to_primary
/);
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
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;
}
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 {