SQL::Translator::Utils::parse_list_arg does not allow indexes on expressions with more than one argument

[mrmuskrat]

You cannot add an index on an expression (aka a functional index) using a function that more than one argument like shown in the following test addition:

git diff t/47postgres-producer.t
diff --git a/t/47postgres-producer.t b/t/47postgres-producer.t
index 9c50db7..c2db844 100644
--- a/t/47postgres-producer.t
+++ b/t/47postgres-producer.t
@@ -686,6 +686,14 @@ is($view2_sql1, $view2_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL 2');
         ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
         is($def, 'CREATE INDEX "myindex" on "foobar" USING hash ("bar", lower(foo)) WHERE upper(foo) = \'bar\' AND bar = \'foo\'', 'index using & where created w/ quotes');
     }
+
+    {
+        my $index = $table->add_index(name => 'myindex', fields => ['coalesce(foo, 0)']);
+        my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index);
+        is($def, "CREATE INDEX myindex on foobar (coalesce(foo, 0))", 'index created');
+        ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
+        is($def, 'CREATE INDEX "myindex" on "foobar" (coalesce(foo, 0))', 'index created w/ quotes');
+    }
 }

 my $drop_view_opts1 = { add_drop_view => 1, no_comments => 1, postgres_version => 8.001 };

[mrmuskrat]

It looks like this is actually the behavior of SQL::Translator::Utils::parse_list_arg (called by SQL::Translator::Schema::Index->new when it processes the fields argument). It splits strings on commas without regard for the contents.

[mrmuskrat]

I have a fix for it but it's a bit verbose. It uses Regexp::Common::balanced to only do the comma split on portions of strings that do not contain balanced parentheses.

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index ccc7ad3..ed3c966 100644
--- a/lib/SQL/Translator/Utils.pm
+++ b/lib/SQL/Translator/Utils.pm
@@ -124,24 +124,52 @@ HEADER_COMMENT
     return $header_comment;
 }

-sub parse_list_arg {
-    my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ];
-
-    #
-    # This protects stringification of references.
-    #
-    if ( @$list && ref $list->[0] ) {
-        return $list;
+{
+    use Regexp::Common qw/ balanced /; # included here to make the patch easier to read
+
+    # declare variabled shared in this scope
+    my @chars = ('a'..'z', 'A'..'Z', '_', '-', 0..9);
+    my %symbols;
+
+    sub save_string {
+        my ($str) = @_;
+        my $sym;
+        # iterate on the off chance that our random string isn't unique
+        do {  $sym = "STRING_" . join '', map { $chars[rand(@chars)] } 0..15; }
+          while exists $symbols{$sym};
+        $symbols{$sym} = $str;
+        return $sym
     }
-    #
-    # This processes string-like arguments.
-    #
-    else {
-        return [
-            map { s/^\s+|\s+$//g; $_ }
-            map { split /,/ }
-            grep { defined && length } @$list
-        ];
+
+    sub restore_strings {
+        for my $re (keys %symbols) {
+            $_[0] =~ s/($re)/$symbols{$1}/g;
+        }
+    }
+
+    sub clear_saved_strings {
+        %symbols = ();
+    }
+
+    sub parse_list_arg {
+        my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ];
+        #
+        # This protects stringification of references.
+        #
+        if ( @$list && ref $list->[0] ) {
+            return $list;
+        }
+        #
+        # This processes string-like arguments.
+        #
+        else {
+          clear_saved_strings(); # start fresh each time
+          return [
+              map { restore_strings($_); s/^\s+|\s+$//g; $_ }
+              map { $_ =~ s/$RE{balanced}{-parens=>'()'}/save_string($1)/ge; split /,/ }
+              grep { defined && length } @$list
+          ];
+        }
     }
 }