1 package TestSqlAbstract;
\r
3 # compares two SQL expressions on their abstract syntax,
\r
4 # ignoring differences in levels of parentheses.
\r
12 our @EXPORT = qw/is_same_sql_bind/;
\r
17 sub is_same_sql_bind {
\r
18 my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
\r
20 my $tree1 = parse($sql1);
\r
21 my $tree2 = parse($sql2);
\r
22 my $same_sql = eq_tree($tree1, $tree2);
\r
23 my $same_bind = stringify_bind($bind_ref1) eq stringify_bind($bind_ref2);
\r
24 ok($same_sql && $same_bind, $msg);
\r
26 diag "SQL expressions differ\n"
\r
28 ."expected: $sql2\n"
\r
29 ."differing in :\n$last_differ\n";
\r
33 diag "BIND values differ\n"
\r
34 ." got: " . Dumper($bind_ref1)
\r
35 ."expected: " . Dumper($bind_ref2)
\r
40 sub stringify_bind {
\r
41 my $bind_ref = shift || [];
\r
42 return join "///", map {ref $_ ? join('=>', @$_) : ($_ || '')}
\r
49 my ($left, $right) = @_;
\r
51 # ignore top-level parentheses
\r
52 while ($left->[0] eq 'PAREN') {$left = $left->[1] }
\r
53 while ($right->[0] eq 'PAREN') {$right = $right->[1]}
\r
55 if ($left->[0] ne $right->[0]) { # if operators are different
\r
56 $last_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
\r
61 else { # else compare operands
\r
62 if ($left->[0] eq 'EXPR' ) {
\r
63 if ($left->[1] ne $right->[1]) {
\r
64 $last_differ = "[$left->[1]] != [$right->[1]]\n";
\r
72 my $eq_left = eq_tree($left->[1][0], $right->[1][0]);
\r
73 my $eq_right = eq_tree($left->[1][1], $right->[1][1]);
\r
74 return $eq_left && $eq_right;
\r
86 @tokens = grep {!/^\s*$/} split /\s*(\(|\)|\bAND\b|\bOR\b)\s*/, $s;
\r
88 my $tree = _recurse_parse();
\r
92 sub _recurse_parse {
\r
97 my $lookahead = $tokens[0];
\r
98 return $left if !defined($lookahead) || $lookahead eq ')';
\r
100 my $token = shift @tokens;
\r
102 if ($token eq '(') {
\r
103 my $right = _recurse_parse();
\r
104 $token = shift @tokens
\r
105 or die "missing ')'";
\r
107 or die "unexpected token : $token";
\r
108 $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
\r
109 : [PAREN => $right];
\r
111 elsif ($token eq 'AND' || $token eq 'OR') {
\r
112 my $right = _recurse_parse();
\r
113 $left = [$token => [$left, $right]];
\r
116 $left = $left ? [CONCAT => [$left, [EXPR => $token]]]
\r
117 : [EXPR => $token];
\r
127 EXPR => sub {$tree->[1] },
\r
128 PAREN => sub {"(" . unparse($tree->[1]) . ")" },
\r
129 CONCAT => sub {join " ", map {unparse($_)} @{$tree->[1]}},
\r
130 AND => sub {join " AND ", map {unparse($_)} @{$tree->[1]}},
\r
131 OR => sub {join " OR ", map {unparse($_)} @{$tree->[1]}},
\r
133 $dispatch->{$tree->[0]}->();
\r