Add index length option for MySQL (#68)

* Add index length option for MySQL Producer (parser to come!)
* Add IndexField objects to handle fancy index fields (like our new length option)
* YAML + JSON producers now dump the extras for index fields

---------

Co-authored-by: Andrew Beverley <[email protected]>
Co-authored-by: Jess Robinson <[email protected]>
Co-authored-by: Veesh Goldman <[email protected]>

lib/SQL/Translator/Producer/JSON.pm

@@ -176,7 +176,7 @@ sub view_index {
     return {
         'name'      => scalar $index->name,
         'type'      => scalar $index->type,
-        'fields'    => scalar $index->fields,
+        'fields'    => [ map { ref($_) && $_->extra && keys %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ],
         'options'   => scalar $index->options,
         keys %{$index->extra} ? ('extra' => { $index->extra } ) : (),
     };

lib/SQL/Translator/Producer/MySQL.pm

@@ -674,6 +674,15 @@ sub create_index
     my ( $index, $options ) = @_;
     my $generator = _generator($options);
 
+    my @fields;
+    for my $field ($index->fields) {
+      my $name = $generator->quote($field->name);
+      if (my $len = $field->extra->{prefix_length}) {
+        $name .= "($len)";
+      }
+      push @fields, $name;
+
+    }
     return join(
         ' ',
         map { $_ || () }
@@ -684,7 +693,7 @@ sub create_index
                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
           ))
         : '',
-        '(' . join( ', ', map { $generator->quote($_) } $index->fields ) . ')'
+        '(' . join( ', ', @fields) . ')'
     );
 }
 

lib/SQL/Translator/Producer/YAML.pm

@@ -173,7 +173,8 @@ sub view_index {
     return {
         'name'      => scalar $index->name,
         'type'      => scalar $index->type,
-        'fields'    => [ map { ref($_) ? $_->name : $_ } $index->fields ],
+        # If the index has extra properties, make sure these are written too
+        'fields'    => [ map { ref($_) && $_->extra && keys %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ],
         'options'   => scalar $index->options,
         keys %{$index->extra} ? ('extra' => { $index->extra } ) : (),
     };

lib/SQL/Translator/Schema/Index.pm

@@ -27,7 +27,8 @@ Primary and unique keys are table constraints, not indices.
 
 use Moo;
 use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(ex2err throw);
+use SQL::Translator::Schema::IndexField;
+use SQL::Translator::Utils qw(ex2err throw parse_list_arg);
 use SQL::Translator::Role::ListAttr;
 use SQL::Translator::Types qw(schema_obj enum);
 use Sub::Quote qw(quote_sub);
@@ -61,12 +62,23 @@ names and keep them in order by the first occurrence of a field name.
   $index->fields( 'id, name' );
   $index->fields( [ 'id', 'name' ] );
   $index->fields( qw[ id name ] );
+  $index->fields(id => { name => 'name', order_by => 'ASC NULLS LAST' });
 
   my @fields = $index->fields;
 
 =cut
 
-with ListAttr fields => ( uniq => 1 );
+
+with ListAttr fields => (
+  coerce => sub {
+    my %seen;
+    return [
+      grep !$seen{$_->name}++,
+      map SQL::Translator::Schema::IndexField->new($_),
+      @{parse_list_arg($_[0])}
+    ]
+  }
+);
 
 sub is_valid {
 
@@ -174,27 +186,23 @@ around equals => sub {
     return 0 unless $self->$orig($other);
 
     unless ($ignore_index_names) {
-      unless ((!$self->name && ($other->name eq $other->fields->[0])) ||
-        (!$other->name && ($self->name eq $self->fields->[0]))) {
+      unless ((!$self->name && ($other->name eq $other->fields->[0]->name)) ||
+        (!$other->name && ($self->name eq $self->fields->[0]->name))) {
         return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
       }
     }
     #return 0 unless $self->is_valid eq $other->is_valid;
     return 0 unless $self->type eq $other->type;
 
     # 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;
-    }
-    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 $get_name = sub { return $case_insensitive ? uc(shift->name) : shift->name; };
+    my @otherFields = sort { $a->{key} cmp $b->{key} } map +{ item => $_, key => $get_name->($_) }, $other->fields;
+    my @selfFields  = sort { $a->{key} cmp $b->{key} } map +{ item => $_, key => $get_name->($_) }, $self->fields;
+    return 0 unless @otherFields == @selfFields;
+    for my $idx (0..$#selfFields) {
+      return 0 unless $selfFields[$idx]{key} eq $otherFields[$idx]{key};
+      return 0 unless $self->_compare_objects(scalar $selfFields[$idx]{item}->extra, scalar $otherFields[$idx]{item}->extra);
     }
-    # Check all other fields were accounted for
-    return 0 unless keys %otherFields == 0;
 
     return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);

lib/SQL/Translator/Schema/IndexField.pm

@@ -0,0 +1,92 @@
+package SQL::Translator::Schema::IndexField;
+
+=pod
+
+=head1 NAME
+
+SQL::Translator::Schema::IndexField - SQL::Translator index field object
+
+=head1 DESCRIPTION
+
+C<SQL::Translator::Schema::IndexField> is the index field object.
+
+Different databases allow for different options on index fields. Those are supported through here
+
+=head1 METHODS
+
+=cut
+use Moo;
+
+extends 'SQL::Translator::Schema::Object';
+
+use overload '""' => sub { shift->name };
+
+=head2 new
+
+Object constructor.
+
+  my $schema = SQL::Translator::Schema::IndexField->new;
+
+=head2 name
+
+The name of the index. The object stringifies to this. In addition, you can simply pass
+a string to the constructor to only set this attribute.
+
+=head2 extra
+
+All options for the field are stored under the extra hash. The constructor will collect
+them for you if passed in straight. In addition, an accessor is provided for all supported options
+
+Currently supported options:
+
+=over 4
+
+=item prefix_length
+
+Supported by MySQL. Indicates that only N characters of the column are indexed.
+
+=back
+
+=cut
+
+around BUILDARGS => sub {
+  my ($orig, $self, @args) = @_;
+  if (@args == 1 && !ref $args[0]) {
+    @args = (name => $args[0]);
+  }
+  # there are some weird pathological cases where we get an object passed in rather than a
+  # hashref. We'll just clone it
+  if (ref $args[0] eq $self) {
+    return { %{$args[0]} }
+  }
+  my $args = $self->$orig(@args);
+  my $extra = delete $args->{extra} || {};
+  my $name = delete $args->{name};
+  return {
+    name => $name,
+    extra => {
+      %$extra,
+      %$args
+    }
+  }
+};
+
+has name => (
+  is => 'rw',
+  required => 1,
+);
+
+has extra => (
+  is => 'rw',
+  default => sub { {} },
+);
+
+=pod
+
+=head1 AUTHOR
+
+Veesh Goldman E<lt>[email protected]E<gt>.
+
+=cut
+
+9007

lib/SQL/Translator/Utils.pm

@@ -7,6 +7,7 @@ use File::Spec;
 use Scalar::Util qw(blessed);
 use Try::Tiny;
 use Carp qw(carp croak);
+use List::Util qw(any);
 
 our $VERSION = '1.63';
 
@@ -131,7 +132,7 @@ sub parse_list_arg {
     #
     # This protects stringification of references.
     #
-    if ( @$list && ref $list->[0] ) {
+    if (any { ref $_ } @$list ) {
         return $list;
     }
     #