fix a dumb dumb regex error, /me --
[scpubgit/Q-Branch.git] / lib / SQL / Abstract / Test.pm
index 98277b9..8b7d43d 100644 (file)
@@ -53,18 +53,25 @@ my @expression_terminator_sql_keywords = (
 
 # These are binary operator keywords always a single LHS and RHS
 # * AND/OR are handled separately as they are N-ary
+# * so is NOT as being unary
 # * BETWEEN without paranthesis around the ANDed arguments (which
 #   makes it a non-binary op) is detected and accomodated in 
 #   _recurse_parse()
+my $stuff_around_mathops = qr/[\w\s\`\'\)]/;
 my @binary_op_keywords = (
-  (map { "\Q$_\E" } (qw/< > != = <= >=/)),
-  '(?: NOT \s+)? LIKE',
-  '(?: NOT \s+)? BETWEEN',
+  ( map
+    { " (?<=  $stuff_around_mathops) " . quotemeta $_ . "(?= $stuff_around_mathops )" }
+    (qw/< > != = <= >=/)
+  ),
+  ( map
+    { '\b (?: NOT \s+)?' . $_ . '\b' }
+    (qw/IN BETWEEN LIKE/)
+  ),
 );
 
 my $tokenizer_re_str = join("\n\t|\n",
-  ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR' ),
-  ( map { q! (?<= [\w\s\`\'\)] ) ! . $_ . q! (?= [\w\s\`\'\(] ) ! } @binary_op_keywords ),
+  ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR', 'NOT'),
+  @binary_op_keywords,
 );
 
 my $tokenizer_re = qr/ \s* ( \( | \) | \? | $tokenizer_re_str ) \s* /xi;
@@ -261,7 +268,7 @@ sub _recurse_parse {
           or
         ($state == PARSE_IN_EXPR && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords ) )
           or
-        ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR' ) )
+        ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR', 'NOT' ) )
     ) {
       return $left;
     }
@@ -310,6 +317,14 @@ sub _recurse_parse {
       $left = $left ? [@$left,  [$op => [$right] ]]
                     : [[ $op => [$right] ]];
     }
+    # NOT (last as to allow all other NOT X pieces first)
+    elsif ( $token =~ /^ not $/ix ) {
+      my $op = uc $token;
+      my $right = _recurse_parse ($tokens, PARSE_RHS);
+      $left = $left ? [ @$left, [$op => [$right] ]]
+                    : [[ $op => [$right] ]];
+
+    }
     # leaf expression
     else {
       $left = $left ? [@$left, [EXPR => [$token] ] ]
@@ -357,6 +372,14 @@ sub _parenthesis_unroll {
         $changes++;
       }
 
+      # only one EXPR element in the parenthesis
+      elsif (
+        @{$child->[1]} == 1 && $child->[1][0][0] eq 'EXPR'
+      ) {
+        push @children, $child->[1][0];
+        $changes++;
+      }
+
       # only one element in the parenthesis which is a binary op with two EXPR sub-children
       elsif (
         @{$child->[1]} == 1