And yet more improvements in the parsing engine
[scpubgit/Q-Branch.git] / lib / SQL / Abstract / Tree.pm
index 81a360d..f826ba7 100644 (file)
@@ -91,25 +91,25 @@ $expr_start_re = qr/ $op_look_behind (?i: $expr_start_re ) $op_look_ahead /x;
 # 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
+# * BETWEEN without parentheses around the ANDed arguments (which
+#   makes it a non-binary op) is detected and accommodated in
 #   _recurse_parse()
 # * AS is not really an operator but is handled here as it's also LHS/RHS
 
 # this will be included in the $binary_op_re, the distinction is interesting during
-# testing as one is tighter than the other, plus mathops have different look
-# ahead/behind (e.g. "x"="y" )
-my @math_op_keywords = (qw/ - + < > != <> = <= >= /);
-my $math_op_re = join ("\n\t|\n", map
+# testing as one is tighter than the other, plus alphanum cmp ops have different
+# look ahead/behind (e.g. "x"="y" )
+my @alphanum_cmp_op_keywords = (qw/< > != <> = <= >= /);
+my $alphanum_cmp_op_re = join ("\n\t|\n", map
   { "(?: (?<= [\\w\\s] | $quote_right ) | \\A )"  . quotemeta ($_) . "(?: (?= [\\w\\s] | $quote_left ) | \\z )" }
-  @math_op_keywords
+  @alphanum_cmp_op_keywords
 );
-$math_op_re = qr/$math_op_re/x;
+$alphanum_cmp_op_re = qr/$alphanum_cmp_op_re/x;
 
 my $binary_op_re = '(?: NOT \s+)? (?:' . join ('|', qw/IN BETWEEN R?LIKE/) . ')';
 $binary_op_re = join "\n\t|\n",
   "$op_look_behind (?i: $binary_op_re | AS ) $op_look_ahead",
-  $math_op_re,
+  $alphanum_cmp_op_re,
   $op_look_behind . 'IS (?:\s+ NOT)?' . "(?= \\s+ NULL \\b | $op_look_ahead )",
 ;
 $binary_op_re = qr/$binary_op_re/x;
@@ -129,14 +129,14 @@ my $tokenizer_re = join("\n\t|\n",
   $unary_op_re,
   $asc_desc_re,
   $and_or_re,
-  "$op_look_behind \\* $op_look_ahead",
+  $op_look_behind . ' \* ' . $op_look_ahead,
   (map { quotemeta $_ } qw/, ( )/),
   $placeholder_re,
 );
 
 # this one *is* capturing for the split below
 # splits on whitespace if all else fails
-# has to happen before the composiign qr's are anchored (below)
+# has to happen before the composing qr's are anchored (below)
 $tokenizer_re = qr/ \s* ( $tokenizer_re ) \s* | \s+ /x;
 
 # Parser states for _recurse_parse()
@@ -149,8 +149,7 @@ use constant PARSE_LIST_ELT => 5;
 
 my $expr_term_re = qr/$expr_start_re | \)/x;
 my $rhs_term_re = qr/ $expr_term_re | $binary_op_re | $unary_op_re | $asc_desc_re | $and_or_re | \, /x;
-my $common_single_args_re = qr/ \* | $placeholder_re /x;
-my $all_std_keywords_re = qr/ $rhs_term_re | \( | $common_single_args_re /x;
+my $all_std_keywords_re = qr/ $rhs_term_re | \( | $placeholder_re /x;
 
 # anchor everything - even though keywords are separated by the tokenizer, leakage may occur
 for (
@@ -158,20 +157,20 @@ for (
   $quote_right,
   $placeholder_re,
   $expr_start_re,
-  $math_op_re,
+  $alphanum_cmp_op_re,
   $binary_op_re,
   $unary_op_re,
   $asc_desc_re,
   $and_or_re,
   $expr_term_re,
   $rhs_term_re,
-  $common_single_args_re,
   $all_std_keywords_re,
 ) {
   $_ = qr/ \A $_ \z /x;
 }
 
-
+# what can be bunched together under one MISC in an AST
+my $compressable_node_re = qr/^ \- (?: MISC | LITERAL | PLACEHOLDER ) $/x;
 
 my %indents = (
    select        => 0,
@@ -444,44 +443,61 @@ sub _recurse_parse {
     }
 
     # check if the current token is an unknown op-start
-    elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $common_single_args_re ) ) {
+    elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $placeholder_re ) ) {
       push @left, [ $token => [ $self->_recurse_parse($tokens, PARSE_RHS) ] ];
     }
 
     # we're now in "unknown token" land - start eating tokens until
-    # we see something familiar
+    # we see something familiar, OR in the case of RHS (binop) stop
+    # after the first token
+    # Also stop processing when we could end up with an unknown func
     else {
       my @lits = [ -LITERAL => [$token] ];
 
-      while (@$tokens and $tokens->[0] !~ $all_std_keywords_re) {
-        push @lits, [ -LITERAL => [ shift @$tokens ] ];
-       }
+      unshift @lits, pop @left if @left == 1;
 
-      if (@left == 1) {
-        unshift @lits, pop @left;
-       }
+      unless ( $state == PARSE_RHS ) {
+        while (
+          @$tokens
+            and
+          $tokens->[0] !~ $all_std_keywords_re
+            and
+          ! ( @$tokens > 1 and $tokens->[1] eq '(' )
+        ) {
+          push @lits, [ -LITERAL => [ shift @$tokens ] ];
+        }
+      }
 
       @lits = [ -MISC => [ @lits ] ] if @lits > 1;
 
       push @left, @lits;
     }
 
-    # deal with post-fix operators (only when sql is sane - i.e. we have one element to apply to)
-    if (@left == 1 and @$tokens) {
-
-      # asc/desc
-      if ($tokens->[0] =~ $asc_desc_re) {
-        my $op = shift @$tokens;
-
-        # if -MISC - this is a literal collection, do not promote asc/desc to an op
-        if ($left[0][0] eq '-MISC') {
-          push @{$left[0][1]}, [ -LITERAL => [ $op ] ];
+    # compress -LITERAL -MISC and -PLACEHOLDER pieces into a single
+    # -MISC container
+    if (@left > 1) {
+      my $i = 0;
+      while ($#left > $i) {
+        if ($left[$i][0] =~ $compressable_node_re and $left[$i+1][0] =~ $compressable_node_re) {
+          splice @left, $i, 2, [ -MISC => [
+            map { $_->[0] eq '-MISC' ? @{$_->[1]} : $_ } (@left[$i, $i+1])
+          ]];
         }
         else {
-          @left = [ ('-' . uc ($op)) => [ @left ] ];
+          $i++;
         }
       }
     }
+
+    return @left if $state == PARSE_RHS;
+
+    # deal with post-fix operators
+    if (@$tokens) {
+      # asc/desc
+      if ($tokens->[0] =~ $asc_desc_re) {
+        @left = [ ('-' . uc (shift @$tokens)) => [ @left ] ];
+      }
+    }
   }
 }
 
@@ -596,14 +612,17 @@ sub _unparse {
   }
   else {
     my ($l, $r) = @{$self->pad_keyword($op, $depth)};
-    return sprintf "$l%s%s%s$r",
-      $self->format_keyword($op),
+
+    my $rhs = $self->_unparse($args, $bindargs, $depth);
+
+    return sprintf "$l%s$r", join(
       ( ref $args eq 'ARRAY' and @{$args} == 1 and $args->[0][0] eq '-PAREN' )
         ? ''    # mysql--
         : ' '
       ,
-      $self->_unparse($args, $bindargs, $depth),
-    ;
+      $self->format_keyword($op),
+      (length $rhs ? $rhs : () ),
+    );
   }
 }
 
@@ -644,7 +663,7 @@ sub _parenthesis_unroll {
         $changes++;
       }
 
-      # if the parent operator explcitly allows it nuke the parenthesis
+      # if the parent operator explicitly allows it nuke the parenthesis
       if ( $ast->[0] =~ $unrollable_ops_re ) {
         push @children, @{$child->[1]};
         $changes++;
@@ -695,9 +714,9 @@ sub _parenthesis_unroll {
         @{$child->[1][0][1]} == 2
           and
         ! (
-          $child->[1][0][0] =~ $math_op_re
+          $child->[1][0][0] =~ $alphanum_cmp_op_re
             and
-          $ast->[0] =~ $math_op_re
+          $ast->[0] =~ $alphanum_cmp_op_re
         )
       ) {
         push @children, @{$child->[1]};
@@ -715,9 +734,9 @@ sub _parenthesis_unroll {
           and
         @{$child->[1][0][1]} == 1
           and
-        $ast->[0] =~ $math_op_re
+        $ast->[0] =~ $alphanum_cmp_op_re
           and
-        $child->[1][0][0] !~ $math_op_re
+        $child->[1][0][0] !~ $alphanum_cmp_op_re
           and
         (
           $child->[1][0][1][0][0] eq '-PAREN'