diff --git a/Makefile.PL b/Makefile.PL index 7761db4e..b1713e17 100644 --- a/Makefile.PL +++ b/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 => { diff --git a/lib/SQL/Translator/Generator/DDL/SQLite.pm b/lib/SQL/Translator/Generator/DDL/SQLite.pm index 86f2e394..97f915d7 100644 --- a/lib/SQL/Translator/Generator/DDL/SQLite.pm +++ b/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, { diff --git a/lib/SQL/Translator/Parser/PostgreSQL.pm b/lib/SQL/Translator/Parser/PostgreSQL.pm index 0fc5363a..e0b47a6b 100644 --- a/lib/SQL/Translator/Parser/PostgreSQL.pm +++ b/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'}, } } | @@ -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'}; diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index 3fdebc70..cf58c983 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/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'}; diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index a0d4ac99..2e0ffd64 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/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 # diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index f4c000a3..6f9dadd7 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/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 }) : (), }; } diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 50d3b49c..81dc76e7 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/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 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. diff --git a/t/case-insensitive.t b/t/case-insensitive.t new file mode 100644 index 00000000..cb589c60 --- /dev/null +++ b/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; +