Fix overly-enthusiastic parenthesis unroller (RT#99503)

diff --git a/Changes b/Changes
index b69ed73..6294384 100644 (file)
--- a/Changes
+++ b/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 => ... }

diff --git a/Makefile.PL b/Makefile.PL
index a912c10..03997b5 100644 (file)
--- a/Makefile.PL
+++ b/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';

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index e9c06f7..9e3aad4 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/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;
 }
 
 

diff --git a/t/05in_between.t b/t/05in_between.t
index fc3aa1d..00fbd21 100644 (file)
--- a/t/05in_between.t
+++ b/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 => \[