X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTree.pm;h=0db1757bfa417638338cd6d81031b2a90bd040da;hb=bb54fcb44cb8362f47b6b1f5c26427b4204d0caa;hp=9536ce9c92eedea91f2b40ef643e5565416a2091;hpb=257ecc8a4f33c53c658100982c39f27c736e4423;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm index 9536ce9..0db1757 100644 --- a/lib/SQL/Abstract/Tree.pm +++ b/lib/SQL/Abstract/Tree.pm @@ -461,6 +461,7 @@ sub fill_in_placeholder { # FIXME - terrible name for a user facing API sub unparse { my ($self, $tree, $bindargs) = @_; + $self->_parenthesis_unroll($tree); $self->_unparse($tree, [@{$bindargs||[]}], 0); } @@ -519,6 +520,135 @@ sub _unparse { } } +# All of these keywords allow their parameters to be specified with or without parenthesis without changing the semantics +my @unrollable_ops = ( + 'ON', + 'WHERE', + 'GROUP \s+ BY', + 'HAVING', + 'ORDER \s+ BY', +); +my $unrollable_ops_re = join ' | ', @unrollable_ops; +$unrollable_ops_re = qr/$unrollable_ops_re/xi; + +sub _parenthesis_unroll { + my $self = shift; + my $ast = shift; + + #return if $self->parenthesis_significant; + return unless (ref $ast and ref $ast->[1]); + + my $changes; + do { + my @children; + $changes = 0; + + for my $child (@{$ast->[1]}) { + # the current node in this loop is *always* a PAREN + if (not ref $child or not $child->[0] eq 'PAREN') { + push @children, $child; + next; + } + + # unroll nested parenthesis + while ( @{$child->[1]} && $child->[1][0][0] eq 'PAREN') { + $child = $child->[1][0]; + $changes++; + } + + # if the parenthesis are wrapped around an AND/OR matching the parent AND/OR - open the parenthesis up and merge the list + if ( + ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR') + and + $child->[1][0][0] eq $ast->[0] + ) { + push @children, @{$child->[1][0][1]}; + $changes++; + } + + # if the parent operator explcitly allows it nuke the parenthesis + elsif ( $ast->[0] =~ $unrollable_ops_re ) { + push @children, $child->[1][0]; + $changes++; + } + + # only *ONE* LITERAL or placeholder element + elsif ( + @{$child->[1]} == 1 && ( + $child->[1][0][0] eq 'LITERAL' + or + $child->[1][0][0] eq 'PLACEHOLDER' + ) + ) { + push @children, $child->[1][0]; + $changes++; + } + + # only one element in the parenthesis which is a binary op + # and has exactly two grandchildren + # the only time when we can *not* unroll this is when both + # the parent and the child are mathops (in which case we'll + # break precedence) or when the child is BETWEEN (special + # case) + elsif ( + @{$child->[1]} == 1 + and + $child->[1][0][0] =~ SQL::Abstract::Tree::_binary_op_re() + and + $child->[1][0][0] ne 'BETWEEN' + and + @{$child->[1][0][1]} == 2 + and + ! ( + $child->[1][0][0] =~ SQL::Abstract::Tree::_math_op_re() + and + $ast->[0] =~ SQL::Abstract::Tree::_math_op_re() + ) + ) { + push @children, $child->[1][0]; + $changes++; + } + + # a function binds tighter than a mathop - see if our ancestor is a + # mathop, and our content is: + # a single non-mathop child with a single PAREN grandchild which + # would indicate mathop ( nonmathop ( ... ) ) + # or a single non-mathop with a single LITERAL ( nonmathop foo ) + # or a single non-mathop with a single PLACEHOLDER ( nonmathop ? ) + elsif ( + @{$child->[1]} == 1 + and + @{$child->[1][0][1]} == 1 + and + $ast->[0] =~ SQL::Abstract::Tree::_math_op_re() + and + $child->[1][0][0] !~ SQL::Abstract::Tree::_math_op_re + and + ( + $child->[1][0][1][0][0] eq 'PAREN' + or + $child->[1][0][1][0][0] eq 'LITERAL' + or + $child->[1][0][1][0][0] eq 'PLACEHOLDER' + ) + ) { + push @children, $child->[1][0]; + $changes++; + } + + + # otherwise no more mucking for this pass + else { + push @children, $child; + } + } + + $ast->[1] = \@children; + + } while ($changes); + +} + sub format { my $self = shift; $self->unparse($self->parse($_[0]), $_[1]) } 1;