Commit | Line | Data |
fffe6900 |
1 | package SQL::Abstract::Test; # see doc at end of file |
2 | |
3 | use strict; |
4 | use warnings; |
5aad8cf3 |
5 | use base qw/Test::Builder::Module Exporter/; |
fffe6900 |
6 | use Data::Dumper; |
7 | use Carp; |
4abea32b |
8 | use Test::Builder; |
fffe6900 |
9 | |
e7827ba2 |
10 | our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind |
11 | &eq_sql_bind &eq_sql &eq_bind |
fffe6900 |
12 | $case_sensitive $sql_differ/; |
13 | |
14 | our $case_sensitive = 0; |
e40f5df9 |
15 | our $parenthesis_significant = 0; |
fffe6900 |
16 | our $sql_differ; # keeps track of differing portion between SQLs |
5aad8cf3 |
17 | our $tb = __PACKAGE__->builder; |
fffe6900 |
18 | |
25823711 |
19 | # Parser states for _recurse_parse() |
01b64cb7 |
20 | use constant PARSE_TOP_LEVEL => 0; |
5221d7fc |
21 | use constant PARSE_IN_EXPR => 1; |
22 | use constant PARSE_IN_PARENS => 2; |
01b64cb7 |
23 | use constant PARSE_RHS => 3; |
25823711 |
24 | |
25 | # These SQL keywords always signal end of the current expression (except inside |
26 | # of a parenthesized subexpression). |
27 | # Format: A list of strings that will be compiled to extended syntax (ie. |
28 | # /.../x) regexes, without capturing parentheses. They will be automatically |
29 | # anchored to word boundaries to match the whole token). |
30 | my @expression_terminator_sql_keywords = ( |
1b17d1b0 |
31 | 'SELECT', |
25823711 |
32 | 'FROM', |
33 | '(?: |
34 | (?: |
35 | (?: \b (?: LEFT | RIGHT | FULL ) \s+ )? |
36 | (?: \b (?: CROSS | INNER | OUTER ) \s+ )? |
37 | )? |
38 | JOIN |
39 | )', |
40 | 'ON', |
41 | 'WHERE', |
b9a4fdae |
42 | 'EXISTS', |
25823711 |
43 | 'GROUP \s+ BY', |
44 | 'HAVING', |
45 | 'ORDER \s+ BY', |
46 | 'LIMIT', |
47 | 'OFFSET', |
48 | 'FOR', |
49 | 'UNION', |
50 | 'INTERSECT', |
51 | 'EXCEPT', |
02288357 |
52 | 'RETURNING', |
25823711 |
53 | ); |
54 | |
01b64cb7 |
55 | # These are binary operator keywords always a single LHS and RHS |
56 | # * AND/OR are handled separately as they are N-ary |
9e8dab3f |
57 | # * so is NOT as being unary |
01b64cb7 |
58 | # * BETWEEN without paranthesis around the ANDed arguments (which |
59 | # makes it a non-binary op) is detected and accomodated in |
60 | # _recurse_parse() |
b9a4fdae |
61 | my $stuff_around_mathops = qr/[\w\s\`\'\"\)]/; |
01b64cb7 |
62 | my @binary_op_keywords = ( |
30d09fa9 |
63 | ( map |
b9a4fdae |
64 | { |
65 | ' ^ ' . quotemeta ($_) . "(?= \$ | $stuff_around_mathops ) ", |
66 | " (?<= $stuff_around_mathops)" . quotemeta ($_) . "(?= \$ | $stuff_around_mathops ) ", |
67 | } |
68 | (qw/< > != <> = <= >=/) |
30d09fa9 |
69 | ), |
70 | ( map |
71 | { '\b (?: NOT \s+)?' . $_ . '\b' } |
72 | (qw/IN BETWEEN LIKE/) |
73 | ), |
01b64cb7 |
74 | ); |
75 | |
76 | my $tokenizer_re_str = join("\n\t|\n", |
9e8dab3f |
77 | ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR', 'NOT'), |
30d09fa9 |
78 | @binary_op_keywords, |
01b64cb7 |
79 | ); |
80 | |
b9a4fdae |
81 | my $tokenizer_re = qr/ \s* ( $tokenizer_re_str | \( | \) | \? ) \s* /xi; |
01b64cb7 |
82 | |
35149895 |
83 | # All of these keywords allow their parameters to be specified with or without parenthesis without changing the semantics |
01b64cb7 |
84 | my @unrollable_ops = ( |
1b17d1b0 |
85 | 'ON', |
86 | 'WHERE', |
87 | 'GROUP \s+ BY', |
88 | 'HAVING', |
89 | 'ORDER \s+ BY', |
90 | ); |
91 | |
fffe6900 |
92 | sub is_same_sql_bind { |
93 | my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; |
94 | |
95 | # compare |
25823711 |
96 | my $same_sql = eq_sql($sql1, $sql2); |
fffe6900 |
97 | my $same_bind = eq_bind($bind_ref1, $bind_ref2); |
98 | |
a6daa642 |
99 | # call Test::Builder::ok |
1a828f61 |
100 | my $ret = $tb->ok($same_sql && $same_bind, $msg); |
fffe6900 |
101 | |
102 | # add debugging info |
103 | if (!$same_sql) { |
e7827ba2 |
104 | _sql_differ_diag($sql1, $sql2); |
fffe6900 |
105 | } |
106 | if (!$same_bind) { |
e7827ba2 |
107 | _bind_differ_diag($bind_ref1, $bind_ref2); |
fffe6900 |
108 | } |
1a828f61 |
109 | |
110 | # pass ok() result further |
111 | return $ret; |
fffe6900 |
112 | } |
113 | |
e7827ba2 |
114 | sub is_same_sql { |
115 | my ($sql1, $sql2, $msg) = @_; |
116 | |
117 | # compare |
118 | my $same_sql = eq_sql($sql1, $sql2); |
119 | |
120 | # call Test::Builder::ok |
1a828f61 |
121 | my $ret = $tb->ok($same_sql, $msg); |
e7827ba2 |
122 | |
123 | # add debugging info |
124 | if (!$same_sql) { |
125 | _sql_differ_diag($sql1, $sql2); |
126 | } |
1a828f61 |
127 | |
128 | # pass ok() result further |
129 | return $ret; |
e7827ba2 |
130 | } |
131 | |
132 | sub is_same_bind { |
133 | my ($bind_ref1, $bind_ref2, $msg) = @_; |
134 | |
135 | # compare |
136 | my $same_bind = eq_bind($bind_ref1, $bind_ref2); |
137 | |
138 | # call Test::Builder::ok |
1a828f61 |
139 | my $ret = $tb->ok($same_bind, $msg); |
e7827ba2 |
140 | |
141 | # add debugging info |
142 | if (!$same_bind) { |
143 | _bind_differ_diag($bind_ref1, $bind_ref2); |
144 | } |
1a828f61 |
145 | |
146 | # pass ok() result further |
147 | return $ret; |
e7827ba2 |
148 | } |
149 | |
150 | sub _sql_differ_diag { |
151 | my ($sql1, $sql2) = @_; |
152 | |
153 | $tb->diag("SQL expressions differ\n" |
154 | ." got: $sql1\n" |
155 | ."expected: $sql2\n" |
156 | ."differing in :\n$sql_differ\n" |
157 | ); |
158 | } |
159 | |
160 | sub _bind_differ_diag { |
161 | my ($bind_ref1, $bind_ref2) = @_; |
162 | |
163 | $tb->diag("BIND values differ\n" |
164 | ." got: " . Dumper($bind_ref1) |
165 | ."expected: " . Dumper($bind_ref2) |
166 | ); |
167 | } |
168 | |
169 | sub eq_sql_bind { |
170 | my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_; |
171 | |
172 | return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2); |
173 | } |
174 | |
175 | |
fffe6900 |
176 | sub eq_bind { |
177 | my ($bind_ref1, $bind_ref2) = @_; |
fffe6900 |
178 | |
fdfbbc65 |
179 | local $Data::Dumper::Useqq = 1; |
180 | local $Data::Dumper::Sortkeys = 1; |
181 | |
182 | return Dumper($bind_ref1) eq Dumper($bind_ref2); |
fffe6900 |
183 | } |
184 | |
185 | sub eq_sql { |
25823711 |
186 | my ($sql1, $sql2) = @_; |
187 | |
188 | # parse |
189 | my $tree1 = parse($sql1); |
190 | my $tree2 = parse($sql2); |
191 | |
1b17d1b0 |
192 | return 1 if _eq_sql($tree1, $tree2); |
25823711 |
193 | } |
194 | |
195 | sub _eq_sql { |
fffe6900 |
196 | my ($left, $right) = @_; |
197 | |
939db550 |
198 | # one is defined the other not |
199 | if ( (defined $left) xor (defined $right) ) { |
200 | return 0; |
201 | } |
202 | # one is undefined, then so is the other |
203 | elsif (not defined $left) { |
d15c14cc |
204 | return 1; |
205 | } |
1b17d1b0 |
206 | # one is a list, the other is an op with a list |
207 | elsif (ref $left->[0] xor ref $right->[0]) { |
208 | $sql_differ = sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) ); |
fffe6900 |
209 | return 0; |
210 | } |
1b17d1b0 |
211 | # one is a list, so is the other |
212 | elsif (ref $left->[0]) { |
213 | for (my $i = 0; $i <= $#$left or $i <= $#$right; $i++ ) { |
214 | return 0 if (not _eq_sql ($left->[$i], $right->[$i]) ); |
215 | } |
216 | return 1; |
217 | } |
218 | # both are an op-list combo |
219 | else { |
220 | |
e40f5df9 |
221 | # unroll parenthesis if possible/allowed |
222 | _parenthesis_unroll ($_) for ($left, $right); |
1b17d1b0 |
223 | |
224 | # if operators are different |
b9a4fdae |
225 | if ( $left->[0] ne $right->[0] ) { |
1b17d1b0 |
226 | $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n", |
227 | unparse($left), |
228 | unparse($right); |
229 | return 0; |
230 | } |
231 | # elsif operators are identical, compare operands |
232 | else { |
b9a4fdae |
233 | if ($left->[0] eq 'LITERAL' ) { # unary |
01b64cb7 |
234 | (my $l = " $left->[1][0] " ) =~ s/\s+/ /g; |
235 | (my $r = " $right->[1][0] ") =~ s/\s+/ /g; |
1b17d1b0 |
236 | my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r); |
01b64cb7 |
237 | $sql_differ = "[$l] != [$r]\n" if not $eq; |
1b17d1b0 |
238 | return $eq; |
239 | } |
240 | else { |
241 | my $eq = _eq_sql($left->[1], $right->[1]); |
242 | $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) ) if not $eq; |
243 | return $eq; |
244 | } |
fffe6900 |
245 | } |
246 | } |
247 | } |
248 | |
fffe6900 |
249 | sub parse { |
250 | my $s = shift; |
251 | |
25823711 |
252 | # tokenize string, and remove all optional whitespace |
253 | my $tokens = []; |
254 | foreach my $token (split $tokenizer_re, $s) { |
b9a4fdae |
255 | push @$tokens, $token if (length $token) && ($token =~ /\S/); |
25823711 |
256 | } |
fffe6900 |
257 | |
25823711 |
258 | my $tree = _recurse_parse($tokens, PARSE_TOP_LEVEL); |
fffe6900 |
259 | return $tree; |
260 | } |
261 | |
262 | sub _recurse_parse { |
25823711 |
263 | my ($tokens, $state) = @_; |
fffe6900 |
264 | |
265 | my $left; |
266 | while (1) { # left-associative parsing |
267 | |
268 | my $lookahead = $tokens->[0]; |
1b17d1b0 |
269 | if ( not defined($lookahead) |
270 | or |
271 | ($state == PARSE_IN_PARENS && $lookahead eq ')') |
272 | or |
01b64cb7 |
273 | ($state == PARSE_IN_EXPR && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords ) ) |
274 | or |
9e8dab3f |
275 | ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR', 'NOT' ) ) |
1b17d1b0 |
276 | ) { |
1b17d1b0 |
277 | return $left; |
1b17d1b0 |
278 | } |
fffe6900 |
279 | |
280 | my $token = shift @$tokens; |
281 | |
282 | # nested expression in () |
b9a4fdae |
283 | if ($token eq '(' ) { |
25823711 |
284 | my $right = _recurse_parse($tokens, PARSE_IN_PARENS); |
09abf3a0 |
285 | $token = shift @$tokens or croak "missing closing ')' around block " . unparse ($right); |
286 | $token eq ')' or croak "unexpected token '$token' terminating block " . unparse ($right); |
54629227 |
287 | |
1b17d1b0 |
288 | $left = $left ? [@$left, [PAREN => [$right] ]] |
289 | : [PAREN => [$right] ]; |
fffe6900 |
290 | } |
01b64cb7 |
291 | # AND/OR |
1b17d1b0 |
292 | elsif ($token =~ /^ (?: OR | AND ) $/xi ) { |
293 | my $op = uc $token; |
25823711 |
294 | my $right = _recurse_parse($tokens, PARSE_IN_EXPR); |
1b17d1b0 |
295 | |
296 | # Merge chunks if logic matches |
297 | if (ref $right and $op eq $right->[0]) { |
298 | $left = [ (shift @$right ), [$left, map { @$_ } @$right] ]; |
299 | } |
300 | else { |
301 | $left = [$op => [$left, $right]]; |
302 | } |
fffe6900 |
303 | } |
01b64cb7 |
304 | # binary operator keywords |
305 | elsif (grep { $token =~ /^ $_ $/xi } @binary_op_keywords ) { |
306 | my $op = uc $token; |
307 | my $right = _recurse_parse($tokens, PARSE_RHS); |
308 | |
b9a4fdae |
309 | # A between with a simple LITERAL for a 1st RHS argument needs a |
01b64cb7 |
310 | # rerun of the search to (hopefully) find the proper AND construct |
b9a4fdae |
311 | if ($op eq 'BETWEEN' and $right->[0] eq 'LITERAL') { |
01b64cb7 |
312 | unshift @$tokens, $right->[1][0]; |
313 | $right = _recurse_parse($tokens, PARSE_IN_EXPR); |
314 | } |
315 | |
316 | $left = [$op => [$left, $right] ]; |
317 | } |
25823711 |
318 | # expression terminator keywords (as they start a new expression) |
1b17d1b0 |
319 | elsif (grep { $token =~ /^ $_ $/xi } @expression_terminator_sql_keywords ) { |
01b64cb7 |
320 | my $op = uc $token; |
25823711 |
321 | my $right = _recurse_parse($tokens, PARSE_IN_EXPR); |
54629227 |
322 | $left = $left ? [ $left, [$op => [$right] ]] |
323 | : [ $op => [$right] ]; |
25823711 |
324 | } |
9e8dab3f |
325 | # NOT (last as to allow all other NOT X pieces first) |
326 | elsif ( $token =~ /^ not $/ix ) { |
327 | my $op = uc $token; |
328 | my $right = _recurse_parse ($tokens, PARSE_RHS); |
329 | $left = $left ? [ @$left, [$op => [$right] ]] |
54629227 |
330 | : [ $op => [$right] ]; |
9e8dab3f |
331 | |
332 | } |
b9a4fdae |
333 | # literal (eat everything on the right until RHS termination) |
fffe6900 |
334 | else { |
b9a4fdae |
335 | my $right = _recurse_parse ($tokens, PARSE_RHS); |
54629227 |
336 | $left = $left ? [ $left, [LITERAL => [join ' ', $token, unparse($right)||()] ] ] |
b9a4fdae |
337 | : [ LITERAL => [join ' ', $token, unparse($right)||()] ]; |
fffe6900 |
338 | } |
339 | } |
340 | } |
341 | |
e40f5df9 |
342 | sub _parenthesis_unroll { |
343 | my $ast = shift; |
344 | |
345 | return if $parenthesis_significant; |
346 | return unless (ref $ast and ref $ast->[1]); |
347 | |
348 | my $changes; |
349 | do { |
350 | my @children; |
351 | $changes = 0; |
352 | |
353 | for my $child (@{$ast->[1]}) { |
354 | if (not ref $child or not $child->[0] eq 'PAREN') { |
355 | push @children, $child; |
356 | next; |
357 | } |
358 | |
359 | # unroll nested parenthesis |
360 | while ($child->[1][0][0] eq 'PAREN') { |
361 | $child = $child->[1][0]; |
362 | $changes++; |
363 | } |
364 | |
365 | # if the parenthesis are wrapped around an AND/OR matching the parent AND/OR - open the parenthesis up and merge the list |
366 | if ( |
367 | ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR') |
368 | and |
369 | $child->[1][0][0] eq $ast->[0] |
370 | ) { |
371 | push @children, @{$child->[1][0][1]}; |
372 | $changes++; |
373 | } |
fffe6900 |
374 | |
e40f5df9 |
375 | # if the parent operator explcitly allows it nuke the parenthesis |
376 | elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) { |
377 | push @children, $child->[1][0]; |
378 | $changes++; |
379 | } |
380 | |
b9a4fdae |
381 | # only one LITERAL element in the parenthesis |
9e8dab3f |
382 | elsif ( |
b9a4fdae |
383 | @{$child->[1]} == 1 && $child->[1][0][0] eq 'LITERAL' |
9e8dab3f |
384 | ) { |
385 | push @children, $child->[1][0]; |
386 | $changes++; |
387 | } |
388 | |
b9a4fdae |
389 | # only one element in the parenthesis which is a binary op with two LITERAL sub-children |
e40f5df9 |
390 | elsif ( |
391 | @{$child->[1]} == 1 |
392 | and |
393 | grep { $child->[1][0][0] =~ /^ $_ $/xi } (@binary_op_keywords) |
394 | and |
b9a4fdae |
395 | $child->[1][0][1][0][0] eq 'LITERAL' |
e40f5df9 |
396 | and |
b9a4fdae |
397 | $child->[1][0][1][1][0] eq 'LITERAL' |
e40f5df9 |
398 | ) { |
399 | push @children, $child->[1][0]; |
400 | $changes++; |
401 | } |
402 | |
403 | # otherwise no more mucking for this pass |
404 | else { |
405 | push @children, $child; |
406 | } |
407 | } |
408 | |
409 | $ast->[1] = \@children; |
410 | |
411 | } while ($changes); |
412 | |
413 | } |
fffe6900 |
414 | |
415 | sub unparse { |
416 | my $tree = shift; |
1b17d1b0 |
417 | |
418 | if (not $tree ) { |
419 | return ''; |
420 | } |
421 | elsif (ref $tree->[0]) { |
422 | return join (" ", map { unparse ($_) } @$tree); |
423 | } |
b9a4fdae |
424 | elsif ($tree->[0] eq 'LITERAL') { |
01b64cb7 |
425 | return $tree->[1][0]; |
1b17d1b0 |
426 | } |
427 | elsif ($tree->[0] eq 'PAREN') { |
01b64cb7 |
428 | return sprintf '(%s)', join (" ", map {unparse($_)} @{$tree->[1]}); |
1b17d1b0 |
429 | } |
01b64cb7 |
430 | elsif ($tree->[0] eq 'OR' or $tree->[0] eq 'AND' or (grep { $tree->[0] =~ /^ $_ $/xi } @binary_op_keywords ) ) { |
1b17d1b0 |
431 | return join (" $tree->[0] ", map {unparse($_)} @{$tree->[1]}); |
432 | } |
433 | else { |
434 | return sprintf '%s %s', $tree->[0], unparse ($tree->[1]); |
435 | } |
fffe6900 |
436 | } |
437 | |
438 | |
439 | 1; |
440 | |
441 | |
442 | __END__ |
443 | |
444 | =head1 NAME |
445 | |
446 | SQL::Abstract::Test - Helper function for testing SQL::Abstract |
447 | |
448 | =head1 SYNOPSIS |
449 | |
450 | use SQL::Abstract; |
451 | use Test::More; |
e7827ba2 |
452 | use SQL::Abstract::Test import => [qw/ |
453 | is_same_sql_bind is_same_sql is_same_bind |
454 | eq_sql_bind eq_sql eq_bind |
455 | /]; |
ec9af79e |
456 | |
fffe6900 |
457 | my ($sql, @bind) = SQL::Abstract->new->select(%args); |
e7827ba2 |
458 | |
fffe6900 |
459 | is_same_sql_bind($given_sql, \@given_bind, |
460 | $expected_sql, \@expected_bind, $test_msg); |
461 | |
e7827ba2 |
462 | is_same_sql($given_sql, $expected_sql, $test_msg); |
463 | is_same_bind(\@given_bind, \@expected_bind, $test_msg); |
464 | |
465 | my $is_same = eq_sql_bind($given_sql, \@given_bind, |
466 | $expected_sql, \@expected_bind); |
467 | |
468 | my $sql_same = eq_sql($given_sql, $expected_sql); |
469 | my $bind_same = eq_bind(\@given_bind, \@expected_bind); |
470 | |
fffe6900 |
471 | =head1 DESCRIPTION |
472 | |
473 | This module is only intended for authors of tests on |
474 | L<SQL::Abstract|SQL::Abstract> and related modules; |
475 | it exports functions for comparing two SQL statements |
476 | and their bound values. |
477 | |
478 | The SQL comparison is performed on I<abstract syntax>, |
479 | ignoring differences in spaces or in levels of parentheses. |
480 | Therefore the tests will pass as long as the semantics |
481 | is preserved, even if the surface syntax has changed. |
482 | |
ec9af79e |
483 | B<Disclaimer> : the semantic equivalence handling is pretty limited. |
484 | A lot of effort goes into distinguishing significant from |
485 | non-significant parenthesis, including AND/OR operator associativity. |
486 | Currently this module does not support commutativity and more |
487 | intelligent transformations like Morgan laws, etc. |
488 | |
489 | For a good overview of what this test framework is capable of refer |
490 | to C<t/10test.t> |
fffe6900 |
491 | |
492 | =head1 FUNCTIONS |
493 | |
494 | =head2 is_same_sql_bind |
495 | |
496 | is_same_sql_bind($given_sql, \@given_bind, |
497 | $expected_sql, \@expected_bind, $test_msg); |
498 | |
499 | Compares given and expected pairs of C<($sql, \@bind)>, and calls |
e7827ba2 |
500 | L<Test::Builder/ok> on the result, with C<$test_msg> as message. If the test |
501 | fails, a detailed diagnostic is printed. For clients which use L<Test::More>, |
502 | this is the one of the three functions (L</is_same_sql_bind>, L</is_same_sql>, |
503 | L</is_same_bind>) that needs to be imported. |
504 | |
505 | =head2 is_same_sql |
506 | |
507 | is_same_sql($given_sql, $expected_sql, $test_msg); |
508 | |
509 | Compares given and expected SQL statements, and calls L<Test::Builder/ok> on |
510 | the result, with C<$test_msg> as message. If the test fails, a detailed |
511 | diagnostic is printed. For clients which use L<Test::More>, this is the one of |
512 | the three functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>) |
513 | that needs to be imported. |
514 | |
515 | =head2 is_same_bind |
516 | |
517 | is_same_bind(\@given_bind, \@expected_bind, $test_msg); |
518 | |
519 | Compares given and expected bind values, and calls L<Test::Builder/ok> on the |
520 | result, with C<$test_msg> as message. If the test fails, a detailed diagnostic |
521 | is printed. For clients which use L<Test::More>, this is the one of the three |
522 | functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>) that needs |
523 | to be imported. |
524 | |
525 | =head2 eq_sql_bind |
526 | |
527 | my $is_same = eq_sql_bind($given_sql, \@given_bind, |
528 | $expected_sql, \@expected_bind); |
529 | |
530 | Compares given and expected pairs of C<($sql, \@bind)>. Similar to |
531 | L</is_same_sql_bind>, but it just returns a boolean value and does not print |
532 | diagnostics or talk to L<Test::Builder>. |
fffe6900 |
533 | |
534 | =head2 eq_sql |
535 | |
536 | my $is_same = eq_sql($given_sql, $expected_sql); |
537 | |
e7827ba2 |
538 | Compares the abstract syntax of two SQL statements. Similar to L</is_same_sql>, |
539 | but it just returns a boolean value and does not print diagnostics or talk to |
540 | L<Test::Builder>. If the result is false, the global variable L</$sql_differ> |
541 | will contain the SQL portion where a difference was encountered; this is useful |
542 | for printing diagnostics. |
fffe6900 |
543 | |
544 | =head2 eq_bind |
545 | |
546 | my $is_same = eq_sql(\@given_bind, \@expected_bind); |
547 | |
e7827ba2 |
548 | Compares two lists of bind values, taking into account the fact that some of |
549 | the values may be arrayrefs (see L<SQL::Abstract/bindtype>). Similar to |
550 | L</is_same_bind>, but it just returns a boolean value and does not print |
551 | diagnostics or talk to L<Test::Builder>. |
fffe6900 |
552 | |
553 | =head1 GLOBAL VARIABLES |
554 | |
e7827ba2 |
555 | =head2 $case_sensitive |
fffe6900 |
556 | |
557 | If true, SQL comparisons will be case-sensitive. Default is false; |
558 | |
e40f5df9 |
559 | =head2 $parenthesis_significant |
560 | |
561 | If true, SQL comparison will preserve and report difference in nested |
562 | parenthesis. Useful for testing the C<-nest> modifier. Defaults to false; |
563 | |
e7827ba2 |
564 | =head2 $sql_differ |
fffe6900 |
565 | |
566 | When L</eq_sql> returns false, the global variable |
567 | C<$sql_differ> contains the SQL portion |
568 | where a difference was encountered. |
569 | |
570 | |
571 | =head1 SEE ALSO |
572 | |
a6daa642 |
573 | L<SQL::Abstract>, L<Test::More>, L<Test::Builder>. |
fffe6900 |
574 | |
25823711 |
575 | =head1 AUTHORS |
fffe6900 |
576 | |
577 | Laurent Dami, E<lt>laurent.dami AT etat geneve chE<gt> |
578 | |
25823711 |
579 | Norbert Buchmuller <norbi@nix.hu> |
580 | |
e96c510a |
581 | Peter Rabbitson <ribasushi@cpan.org> |
582 | |
fffe6900 |
583 | =head1 COPYRIGHT AND LICENSE |
584 | |
585 | Copyright 2008 by Laurent Dami. |
586 | |
587 | This library is free software; you can redistribute it and/or modify |
588 | it under the same terms as Perl itself. |