&eq_sql_bind &eq_sql &eq_bind
$case_sensitive $sql_differ/;
+my $sqlat = SQL::Abstract::Tree->new;
+
our $case_sensitive = 0;
our $parenthesis_significant = 0;
our $sql_differ; # keeps track of differing portion between SQLs
my ($sql1, $sql2) = @_;
# parse
- my $tree1 = parse($sql1);
- my $tree2 = parse($sql2);
+ my $tree1 = $sqlat->parse($sql1);
+ my $tree2 = $sqlat->parse($sql2);
return 1 if _eq_sql($tree1, $tree2);
}
elsif (not defined $left) {
return 1;
}
+ # different amount of elements
+ elsif (@$left != @$right) {
+ $sql_differ = sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
+ return 0;
+ }
+ # one is empty - so is the other
+ elsif (@$left == 0) {
+ return 1;
+ }
# one is a list, the other is an op with a list
elsif (ref $left->[0] xor ref $right->[0]) {
- $sql_differ = sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) );
+ $sql_differ = sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
return 0;
}
# one is a list, so is the other
# if operators are different
if ( $left->[0] ne $right->[0] ) {
$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
- unparse($left),
- unparse($right);
+ $sqlat->unparse($left),
+ $sqlat->unparse($right);
return 0;
}
# elsif operators are identical, compare operands
}
else {
my $eq = _eq_sql($left->[1], $right->[1]);
- $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) ) if not $eq;
+ $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
return $eq;
}
}
$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][0][0] eq 'PAREN') {
+ while ( @{$child->[1]} && $child->[1][0][0] eq 'PAREN') {
$child = $child->[1][0];
$changes++;
}
$changes++;
}
- # only one LITERAL element in the parenthesis
+ # only *ONE* LITERAL element
elsif (
@{$child->[1]} == 1 && $child->[1][0][0] eq 'LITERAL'
) {
$changes++;
}
- # only one element in the parenthesis which is a binary op with two LITERAL sub-children
+ # 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 ( ... ) )
elsif (
@{$child->[1]} == 1
and
- grep { $child->[1][0][0] =~ /^ $_ $/xi } (SQL::Abstract::Tree::_binary_op_keywords())
+ @{$child->[1][0][1]} == 1
and
- $child->[1][0][1][0][0] eq 'LITERAL'
+ $child->[1][0][1][0][0] eq 'PAREN'
and
- $child->[1][0][1][1][0] eq 'LITERAL'
+ $ast->[0] =~ SQL::Abstract::Tree::_math_op_re()
+ and
+ $child->[1][0][0] !~ SQL::Abstract::Tree::_math_op_re
) {
push @children, $child->[1][0];
$changes++;
}
+
# otherwise no more mucking for this pass
else {
push @children, $child;
}
-sub parse { goto &SQL::Abstract::Tree::parse }
-
-sub unparse { goto &SQL::Abstract::Tree::unparse }
-
-
+sub parse { $sqlat->parse(@_) }
1;