Add field option for case-insensitivity (#200)

Makefile.PL

@@ -23,6 +23,7 @@ my %eumm_args = (
     'Test::More'        => '0.88',
     'Test::Differences' => '0',
     'Test::Exception'   => '0.42',
+    'Test::Warn'        => '0',
     'Text::ParseWords'  => '0',
   },
   PREREQ_PM => {

lib/SQL/Translator/Generator/DDL/SQLite.pm

@@ -91,6 +91,16 @@ sub field_autoinc {
   );
 }
 
+sub field_case_insensitive {
+  my ($self, $field) = @_;
+
+  return (
+    $field->is_case_insensitive
+    ? 'COLLATE NOCASE'
+    : ''
+  );
+}
+
 sub field {
   my ($self, $field) = @_;
 
@@ -101,6 +111,7 @@ sub field {
         : ($self->field_type($field))
       ),
       ($self->field_autoinc($field) || ()), $self->field_nullable($field),
+      ($self->field_case_insensitive($field) || ()),
       $self->field_default(
         $field,
         {

lib/SQL/Translator/Parser/PostgreSQL.pm

@@ -408,16 +408,17 @@ field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?)
         my @comments = ( @{ $item[1] }, @{ $item[5] } );
 
         $return = {
-            supertype         => 'field',
-            name              => $item{'field_name'},
-            data_type         => $item{'data_type'}{'type'},
-            size              => $item{'data_type'}{'size'},
-            is_nullable       => $is_nullable,
-            default           => $default->{'value'},
-            constraints       => [ @constraints ],
-            comments          => [ @comments ],
-            is_primary_key    => $is_pk || 0,
-            is_auto_increment => $item{'data_type'}{'is_auto_increment'},
+            supertype           => 'field',
+            name                => $item{'field_name'},
+            data_type           => $item{'data_type'}{'type'},
+            size                => $item{'data_type'}{'size'},
+            is_nullable         => $is_nullable,
+            default             => $default->{'value'},
+            constraints         => [ @constraints ],
+            comments            => [ @comments ],
+            is_primary_key      => $is_pk || 0,
+            is_auto_increment   => $item{'data_type'}{'is_auto_increment'},
+            is_case_insensitive => $item{'data_type'}{'is_case_insensitive'},
         }
     }
     | <error>
@@ -653,6 +654,15 @@ pg_data_type :
             };
         }
     |
+    /citext/i
+        {
+            $return = {
+                type                => 'text',
+                size                => 64_000,
+                is_case_insensitive => 1,
+            };
+        }
+    |
     /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|varchar|json|hstore|uuid)/i
         {
             $return = { type => $item[1] };
@@ -1098,13 +1108,14 @@ sub parse {
       my $fdata = $tdata->{'fields'}{$fname};
       next if $fdata->{'drop'};
       my $field = $table->add_field(
-        name              => $fdata->{'name'},
-        data_type         => $fdata->{'data_type'},
-        size              => $fdata->{'size'},
-        default_value     => $fdata->{'default'},
-        is_auto_increment => $fdata->{'is_auto_increment'},
-        is_nullable       => $fdata->{'is_nullable'},
-        comments          => $fdata->{'comments'},
+        name                => $fdata->{'name'},
+        data_type           => $fdata->{'data_type'},
+        size                => $fdata->{'size'},
+        default_value       => $fdata->{'default'},
+        is_auto_increment   => $fdata->{'is_auto_increment'},
+        is_case_insensitive => $fdata->{'is_case_insensitive'},
+        is_nullable         => $fdata->{'is_nullable'},
+        comments            => $fdata->{'comments'},
       ) or die $table->error;
 
       $table->primary_key($field->name) if $fdata->{'is_primary_key'};

lib/SQL/Translator/Parser/SQLite.pm

@@ -54,6 +54,7 @@ column-constraint ::=
     UNIQUE [ conflict-clause ] |
     CHECK ( expr ) [ conflict-clause ] |
     DEFAULT value
+    COLLATE value
 
 constraint ::=
     PRIMARY KEY ( name [, name]* ) [ conflict-clause ]|
@@ -264,17 +265,18 @@ definition : constraint_def | column_def
 column_def: comment(s?) NAME type(?) column_constraint_def(s?)
     {
         my $column = {
-            supertype      => 'column',
-            name           => $item[2],
-            data_type      => $item[3][0]->{'type'},
-            size           => $item[3][0]->{'size'},
-            is_nullable    => 1,
-            is_primary_key => 0,
-            is_unique      => 0,
-            check          => '',
-            default        => undef,
-            constraints    => $item[4],
-            comments       => $item[1],
+            supertype           => 'column',
+            name                => $item[2],
+            data_type           => $item[3][0]->{'type'},
+            size                => $item[3][0]->{'size'},
+            is_nullable         => 1,
+            is_primary_key      => 0,
+            is_case_insensitive => 0,
+            is_unique           => 0,
+            check               => '',
+            default             => undef,
+            constraints         => $item[4],
+            comments            => $item[1],
         };
 
 
@@ -285,6 +287,9 @@ column_def: comment(s?) NAME type(?) column_constraint_def(s?)
             elsif ( $c->{'type'} eq 'primary_key' ) {
                 $column->{'is_primary_key'} = 1;
             }
+            elsif ( $c->{'type'} eq 'collate' && lc $c->{'value'} eq 'nocase' ) {
+                $column->{'is_case_insensitive'} = 1;
+            }
             elsif ( $c->{'type'} eq 'unique' ) {
                 $column->{'is_unique'} = 1;
             }
@@ -361,6 +366,14 @@ column_constraint : NOT_NULL conflict_clause(?)
         }
     }
     |
+    COLLATE collate_def
+    {
+        $return   = {
+            type  => 'collate',
+            value => $item[2],
+        }
+    }
+    |
     REFERENCES ref_def cascade_def(?)
     {
         $return   = {
@@ -456,6 +469,8 @@ cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no ac
 
 table_name : qualified_name
 
+collate_def : /(BINARY|NOCASE|RTRIM)/i
+
 qualified_name : NAME
     { $return = { name => $item[1] } }
 
@@ -597,6 +612,8 @@ CHECK_C : /check/i
 
 DEFAULT : /default/i
 
+COLLATE : /collate/i
+
 TRIGGER : /trigger/i
 
 VIEW : /view/i
@@ -686,8 +703,9 @@ sub parse {
           ? (extra => { auto_increment_type => 'monotonic' })
           : ()
         ),
-        is_nullable => $fdata->{'is_nullable'},
-        comments    => $fdata->{'comments'},
+        is_nullable         => $fdata->{'is_nullable'},
+        comments            => $fdata->{'comments'},
+        is_case_insensitive => $fdata->{'is_case_insensitive'},
       ) or die $table->error;
 
       $table->primary_key($field->name) if $fdata->{'is_primary_key'};

lib/SQL/Translator/Producer/PostgreSQL.pm

@@ -113,6 +113,7 @@ use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils
     qw(debug header_comment parse_dbms_version batch_alter_table_statements normalize_quote_options);
 use SQL::Translator::Generator::DDL::PostgreSQL;
+use Carp qw(carp);
 use Data::Dumper;
 
 use constant MAX_ID_LENGTH => 62;
@@ -882,6 +883,17 @@ sub convert_datatype {
     $data_type .= '[]';
   }
 
+  # Case-insensitive flag set? Convert but only if suitable
+  if ($field->is_case_insensitive)
+  {
+    # Text
+    if ($data_type eq 'text') {
+      $data_type = 'citext';
+    } else {
+      carp "Only text fields can be used with is_case_insensitive option";
+    }
+  }
+
   #
   # Geography
   #

lib/SQL/Translator/Producer/YAML.pm

@@ -107,9 +107,10 @@ sub view_field {
     'is_nullable'    => scalar $field->is_nullable,
     'is_primary_key' => scalar $field->is_primary_key,
     'is_unique'      => scalar $field->is_unique,
-    $field->is_auto_increment ? ('is_auto_increment' => 1)                    : (),
-    $field->comments          ? ('comments'          => [ $field->comments ]) : (),
-    keys %{ $field->extra }   ? ('extra'             => { $field->extra })    : (),
+    $field->is_auto_increment   ? ('is_auto_increment'   => 1)                    : (),
+    $field->is_case_insensitive ? ('is_case_insensitive' => 1)                    : (),
+    $field->comments            ? ('comments'            => [ $field->comments ]) : (),
+    keys %{ $field->extra }     ? ('extra'               => { $field->extra })    : (),
   };
 }
 

lib/SQL/Translator/Schema/Field.pm

@@ -210,6 +210,17 @@ has is_auto_increment => (
   lazy    => 1,
 );
 
+=head2 is_case_insensitive
+
+Get or set the field's C<is_case_insensitive> attribute.
+
+Although databases generally handle case-sensitivity as part of their
+collation, there are some database-specific case-insensitive options that this
+attribute controls. In particular, SQLite has the COLLATE NOCASE field option
+and PostgreSQL has the citext extension.
+
+=cut
+
 sub _build_is_auto_increment {
   my ($self) = @_;
 
@@ -224,6 +235,12 @@ sub _build_is_auto_increment {
   return 0;
 }
 
+has is_case_insensitive => (
+  is      => 'rw',
+  coerce  => quote_sub(q{ $_[0] ? 1 : 0 }),
+  default => 0,
+);
+
 =head2 is_foreign_key
 
 Returns whether or not the field is a foreign key.

t/case-insensitive.t

@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Test::More;
+use Test::Differences;
+use Test::Warn;
+use YAML qw(Load);
+
+use_ok("SQL::Translator");
+use_ok("SQL::Translator::Parser::SQLite");
+use_ok("SQL::Translator::Producer::PostgreSQL");
+
+# Test conversion of case-insensitive fields where possible. Although
+# case-sensitivity generally depends on the collation of a databases character
+# set, there are some case-specific options that are included here.
+
+# SQLite specifically has the field option COLLATE NOCASE
+my $sqlite_original = 'BEGIN TRANSACTION;
+
+CREATE TABLE "my_text_table" (
+  "mytext" TEXT NOT NULL COLLATE NOCASE,
+  "myvarchar" VARCHAR(16) NOT NULL COLLATE NOCASE,
+  "mychar" CHAR(16) NOT NULL COLLATE NOCASE
+);
+
+COMMIT;
+';
+
+# For this test, the standard text field is converted (into citext). However,
+# the other 2 text-like fields (CHAR and VARCHAR) do not have a direct
+# equivalent. These 2 therefore remain the same, although because the SQLite
+# parser will have flagged them as case-insensitive, the PostgreSQL generator
+# will warn as such.
+my $expected_warning = { carped => 'Only text fields can be used with is_case_insensitive option' };
+my $postgresql;
+warnings_are sub {
+    $postgresql = SQL::Translator->new(data => $sqlite_original, no_comments => 1, quote_identifiers => 1)
+        ->translate(from => 'SQLite', to => 'PostgreSQL')
+}, [$expected_warning, $expected_warning], "Expected warning for incompatible fields";
+
+# PostgreSQL has the plugin citext
+eq_or_diff($postgresql, <<'DDL', 'Conversion from SQLite to PostgreSQL');
+CREATE TABLE "my_text_table" (
+  "mytext" citext NOT NULL,
+  "myvarchar" character varying(16) NOT NULL,
+  "mychar" character(16) NOT NULL
+);
+
+DDL
+
+# Test the option stored in YAML
+my $yaml = SQL::Translator->new(data => $sqlite_original, no_comments => 1, quote_identifiers => 1)
+    ->translate(from => 'SQLite', to => 'YAML');
+
+my $yaml_parsed = Load($yaml);
+my $fields = $yaml_parsed->{schema}->{tables}->{my_text_table}->{fields};
+ok($fields->{mytext}, "YAML: normal text is case-insensitive");
+ok($fields->{myvarchar}, "YAML: variable char is case-insensitive");
+ok($fields->{mychar}, "YAML: fixed char is case-insensitive");
+
+# Convert back from YAML to SQLite
+my $sqlite_converted = SQL::Translator->new(data => $yaml, no_comments => 1, quote_identifiers => 1)
+    ->translate(from => 'YAML', to => 'SQLite');
+
+eq_or_diff($sqlite_converted, $sqlite_original);
+
+# Convert back from PostgreSQL, although only text is applicable
+$postgresql = 'CREATE TABLE "my_text_table" (
+  "mytext" citext NOT NULL
+);';
+
+$sqlite_converted = SQL::Translator->new(data => $postgresql, no_comments   => 1, quote_identifiers => 1)
+    ->translate(from => 'PostgreSQL', to => 'SQLite');
+
+eq_or_diff($sqlite_converted, <<'DDL', 'DDL with default quoting');
+BEGIN TRANSACTION;
+
+CREATE TABLE "my_text_table" (
+  "mytext" text NOT NULL COLLATE NOCASE
+);
+
+COMMIT;
+DDL
+
+done_testing;
+