Skip to content

Commit

Permalink
migrate _parenthesis_unroll to SQL::Abstract::Tree
Browse files Browse the repository at this point in the history
  • Loading branch information
Arthur Axel 'fREW' Schmidt committed Nov 13, 2010
1 parent 257ecc8 commit bb54fcb
Show file tree
Hide file tree
Showing 3 changed files with 132 additions and 129 deletions.
1 change: 1 addition & 0 deletions examples/console.pl
View file
Expand Up @@ -23,6 +23,7 @@
'SAVEPOINT station',
'ROLLBACK TO SAVEPOINT station',
'RELEASE SAVEPOINT station',
"SELECT COUNT( * ) FROM message_children me WHERE( ( me.phone_number NOT IN ( SELECT message_child.phone_number FROM blocked_destinations me JOIN message_children_status reason ON reason.id = me.reason_id JOIN message_children message_child ON message_child.id = reason.message_child_id) AND ( ( me.api_id IS NULL ) ) ) )"
);

print "\n\n'" . $sqlat->format($_) . "'\n" for @sql;
Expand Down
130 changes: 1 addition & 129 deletions lib/SQL/Abstract/Test.pm
View file
Expand Up @@ -18,17 +18,6 @@ our $parenthesis_significant = 0;
our $sql_differ; # keeps track of differing portion between SQLs
our $tb = __PACKAGE__->builder;

# 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 is_same_sql_bind {
my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;

Expand Down Expand Up @@ -168,7 +157,7 @@ sub _eq_sql {
else {

# unroll parenthesis if possible/allowed
_parenthesis_unroll ($_) for ($left, $right);
$parenthesis_significant || $sqlat->_parenthesis_unroll($_) for $left, $right;

# if operators are different
if ( $left->[0] ne $right->[0] ) {
Expand All @@ -195,123 +184,6 @@ sub _eq_sql {
}
}

sub _parenthesis_unroll {
my $ast = shift;

return if $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 parse { $sqlat->parse(@_) }
1;

Expand Down
130 changes: 130 additions & 0 deletions lib/SQL/Abstract/Tree.pm
View file
Expand Up @@ -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);
}

Expand Down Expand Up @@ -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;
Expand Down

0 comments on commit bb54fcb

Please sign in to comment.