Proof of concept for index lengths

abeverley · Aug 11, 2015 · e31c185 · e31c185 · ribasushi · Aug 11, 2015
1 parent d5103d9
commit e31c185
Show file tree

Hide file tree

Showing 4 changed files with 26 additions and 9 deletions.
diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm
@@ -684,7 +684,9 @@ sub create_index
                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
           ))
         : '',
-        '(' . join( ', ', map { $generator->quote($_) } $index->fields ) . ')'
+        '(' . join( ', ', map {
+            ref $_ ? $generator->quote($_->{name}) . "($_->{size})" : $generator->quote($_)
+        } $index->fields ) . ')'
     );
 }
 

diff --git a/lib/SQL/Translator/Role/ListAttr.pm b/lib/SQL/Translator/Role/ListAttr.pm
@@ -22,7 +22,7 @@ attributes.
 
 =cut
 
-use SQL::Translator::Utils qw(parse_list_arg ex2err uniq);
+use SQL::Translator::Utils qw(parse_list_arg ex2err uniq uniq_keys);
 use Sub::Quote qw(quote_sub);
 
 use Package::Variant (
@@ -83,8 +83,11 @@ sub make_variant {
     my $may_throw = delete $arguments{may_throw};
     my $undef_if_empty = delete $arguments{undef_if_empty};
     my $append = delete $arguments{append};
+    my $uniq_keys = delete $arguments{uniq_keys};
     my $coerce = delete $arguments{uniq}
         ? sub { [ uniq @{parse_list_arg($_[0])} ] }
+        : $uniq_keys
+        ? sub { [ uniq_keys $uniq_keys, @{parse_list_arg($_[0])} ] }
         : \&parse_list_arg;
 
     has($name => (

diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm
@@ -66,7 +66,7 @@ names and keep them in order by the first occurrence of a field name.
 
 =cut
 
-with ListAttr fields => ( uniq => 1 );
+with ListAttr fields => ( uniq_keys => 'name' );
 
 sub is_valid {
 
@@ -173,6 +173,7 @@ around equals => sub {
 
     return 0 unless $self->$orig($other);
 
+    # XXX Probably needs changing too
     unless ($ignore_index_names) {
       unless ((!$self->name && ($other->name eq $other->fields->[0])) ||
         (!$other->name && ($self->name eq $self->fields->[0]))) {
@@ -185,13 +186,15 @@ around equals => sub {
     # Check fields, regardless of order
     my %otherFields = ();  # create a hash of the other fields
     foreach my $otherField ($other->fields) {
-      $otherField = uc($otherField) if $case_insensitive;
-      $otherFields{$otherField} = 1;
+      my $name = ref $otherField ? $otherField->{name} : $otherField;
+      $name = uc($name) if $case_insensitive;
+      $otherFields{$name} = ref $otherField ? $otherField->{size} : -1;
     }
     foreach my $selfField ($self->fields) { # check for self fields in hash
-      $selfField = uc($selfField) if $case_insensitive;
-      return 0 unless $otherFields{$selfField};
-      delete $otherFields{$selfField};
+      my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{size}) : ($selfField, -1);
+      $name = uc($name) if $case_insensitive;
+      return 0 unless exists $otherFields{$name} && $otherFields{$name} == $size;
+      delete $otherFields{$name};
     }
     # Check all other fields were accounted for
     return 0 unless keys %otherFields == 0;

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
@@ -16,7 +16,7 @@ our @EXPORT_OK = qw(
     debug normalize_name header_comment parse_list_arg truncate_id_uniquely
     $DEFAULT_COMMENT parse_mysql_version parse_dbms_version
     ddl_parser_instance batch_alter_table_statements
-    uniq throw ex2err carp_ro
+    uniq uniq_keys throw ex2err carp_ro
     normalize_quote_options
 );
 use constant COLLISION_TAG_LENGTH => 8;
@@ -375,6 +375,15 @@ sub uniq {
   ) } @_;
 }
 
+sub uniq_keys {
+  my $key = shift;
+  my %seen;
+  grep {
+    my $name = ref $_ ? $_->{$key} : $_;
+    not ( $seen{$name}++ );
+  } @_;
+}
+
 sub throw {
     die SQL::Translator::Utils::Error->new($_[0]);
 }