Fix overly-enthusiastic parenthesis unroller (RT#99503)

Author: ribasushi

Changes

@@ -1,5 +1,7 @@
 Revision history for SQL::Abstract
 
+    - Fix overly-enthusiastic parenthesis unroller (RT#99503)
+
 revision 1.80  2014-10-05
 ----------------------------
     - Fix erroneous behavior of is_literal_value($) wrt { -ident => ... }

Makefile.PL

@@ -22,6 +22,7 @@ requires 'Exporter'       => '5.57';
 requires 'MRO::Compat'    => '0.12';
 requires 'Moo'            => '1.004002';
 requires 'Hash::Merge'    => '0.12';
+requires 'Text::Balanced' => '2.00';
 
 test_requires "Test::More"      => '0.88';
 test_requires "Test::Exception" => '0.31';

lib/SQL/Abstract.pm

@@ -1242,8 +1242,29 @@ sub _where_field_IN {
 # adding them back in the corresponding method
 sub _open_outer_paren {
   my ($self, $sql) = @_;
-  $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
-  return $sql;
+
+  while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
+
+    # there are closing parens inside, need the heavy duty machinery
+    # to reevaluate the extraction starting from $sql (full reevaluation)
+    if ( $inner =~ /\)/ ) {
+      require Text::Balanced;
+
+      my (undef, $remainder) = do {
+        # idiotic design - writes to $@ but *DOES NOT* throw exceptions
+        local $@;
+        Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
+      };
+
+      # the entire expression needs to be a balanced bracketed thing
+      # (after an extract no remainder sans trailing space)
+      last if defined $remainder and $remainder =~ /\S/;
+    }
+
+    $sql = $inner;
+  }
+
+  $sql;
 }
 
 

t/05in_between.t

@@ -174,6 +174,17 @@ my @in_between_tests = (
     bind => [],
     test => '-in multi-line subquery test',
   },
+
+  # check that the outer paren opener is not too agressive
+  # note: this syntax *is not legal* on SQLite (maybe others)
+  #       see end of https://rt.cpan.org/Ticket/Display.html?id=99503
+  {
+    where => { foo => { -in => \ '(SELECT 1) UNION (SELECT 2)' } },
+    stmt => 'WHERE foo IN ( (SELECT 1) UNION (SELECT 2) )',
+    bind => [],
+    test => '-in paren-opening works on balanced pairs only',
+  },
+
   {
     where => {
       customer => { -in => \[