[scpubgit/Q-Branch.git] / lib / SQL / Abstract / Test.pm

package SQL::Abstract::Test; # see doc at end of file

use strict;
use warnings;
use base qw/Test::Builder::Module Exporter/;
use Data::Dumper;
use Carp;
use Test::Builder;
use Test::Deep qw(eq_deeply);

our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
                    &eq_sql_bind &eq_sql &eq_bind 
                    $case_sensitive $sql_differ/;

our $case_sensitive = 0;
our $sql_differ; # keeps track of differing portion between SQLs
our $tb = __PACKAGE__->builder;

# Parser states for _recurse_parse()
use constant PARSE_TOP_LEVEL => 0;
use constant PARSE_IN_EXPR => 1;
use constant PARSE_IN_PARENS => 2;

# These SQL keywords always signal end of the current expression (except inside
# of a parenthesized subexpression).
# Format: A list of strings that will be compiled to extended syntax (ie.
# /.../x) regexes, without capturing parentheses. They will be automatically
# anchored to word boundaries to match the whole token).
my @expression_terminator_sql_keywords = (
  'FROM',
  '(?:
    (?:
        (?: \b (?: LEFT | RIGHT | FULL ) \s+ )?
        (?: \b (?: CROSS | INNER | OUTER ) \s+ )?
    )?
    JOIN
  )',
  'ON',
  'WHERE',
  'GROUP \s+ BY',
  'HAVING',
  'ORDER \s+ BY',
  'LIMIT',
  'OFFSET',
  'FOR',
  'UNION',
  'INTERSECT',
  'EXCEPT',
);

my $tokenizer_re_str = join('|',
  map { '\b' . $_ . '\b' }
    @expression_terminator_sql_keywords, 'AND', 'OR'
);

my $tokenizer_re = qr/
  \s*
  (
      \(
    |
      \)
    |
      $tokenizer_re_str
  )
  \s*
/xi;


sub is_same_sql_bind {
  my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;

  # compare
  my $same_sql  = eq_sql($sql1, $sql2);
  my $same_bind = eq_bind($bind_ref1, $bind_ref2);

  # call Test::Builder::ok
  $tb->ok($same_sql && $same_bind, $msg);

  # add debugging info
  if (!$same_sql) {
    _sql_differ_diag($sql1, $sql2);
  }
  if (!$same_bind) {
    _bind_differ_diag($bind_ref1, $bind_ref2);
  }
}

sub is_same_sql {
  my ($sql1, $sql2, $msg) = @_;

  # compare
  my $same_sql  = eq_sql($sql1, $sql2);

  # call Test::Builder::ok
  $tb->ok($same_sql, $msg);

  # add debugging info
  if (!$same_sql) {
    _sql_differ_diag($sql1, $sql2);
  }
}

sub is_same_bind {
  my ($bind_ref1, $bind_ref2, $msg) = @_;

  # compare
  my $same_bind = eq_bind($bind_ref1, $bind_ref2);

  # call Test::Builder::ok
  $tb->ok($same_bind, $msg);

  # add debugging info
  if (!$same_bind) {
    _bind_differ_diag($bind_ref1, $bind_ref2);
  }
}

sub _sql_differ_diag {
  my ($sql1, $sql2) = @_;

  $tb->diag("SQL expressions differ\n"
      ."     got: $sql1\n"
      ."expected: $sql2\n"
      ."differing in :\n$sql_differ\n"
      );
}

sub _bind_differ_diag {
  my ($bind_ref1, $bind_ref2) = @_;

  $tb->diag("BIND values differ\n"
      ."     got: " . Dumper($bind_ref1)
      ."expected: " . Dumper($bind_ref2)
      );
}

sub eq_sql_bind {
  my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;

  return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
}


sub eq_bind {
  my ($bind_ref1, $bind_ref2) = @_;

  return eq_deeply($bind_ref1, $bind_ref2);
}

sub eq_sql {
  my ($sql1, $sql2) = @_;

  # parse
  my $tree1 = parse($sql1);
  my $tree2 = parse($sql2);

  return _eq_sql($tree1, $tree2);
}

sub _eq_sql {
  my ($left, $right) = @_;

  # ignore top-level parentheses 
  while ($left->[0] and $left->[0]  eq 'PAREN') {$left  = $left->[1] }
  while ($right->[0] and $right->[0] eq 'PAREN') {$right = $right->[1]}

  # if both are undef i.e. ()
  if (not grep { defined $_ } ($left->[0], $right->[0]) ) {
    return 1;
  }
  # if operators are different
  elsif ($left->[0] ne $right->[0]) { 
    $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
      unparse($left),
      unparse($right);
    return 0;
  }
  # elsif operators are identical, compare operands
  else { 
    if ($left->[0] eq 'EXPR' ) { # unary operator
      (my $l = " $left->[1] " ) =~ s/\s+/ /g;
      (my $r = " $right->[1] ") =~ s/\s+/ /g;
      my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r);
      $sql_differ = "[$left->[1]] != [$right->[1]]\n" if not $eq;
      return $eq;
    }
    else { # binary operator
      return _eq_sql($left->[1][0], $right->[1][0])  # left operand
          && _eq_sql($left->[1][1], $right->[1][1]); # right operand
    }
  }
}


sub parse {
  my $s = shift;

  # tokenize string, and remove all optional whitespace
  my $tokens = [];
  foreach my $token (split $tokenizer_re, $s) {
    $token =~ s/\s+/ /g;
    $token =~ s/\s+([^\w\s])/$1/g;
    $token =~ s/([^\w\s])\s+/$1/g;
    push @$tokens, $token if $token !~ /^$/;
  }

  my $tree = _recurse_parse($tokens, PARSE_TOP_LEVEL);
  return $tree;
}

sub _recurse_parse {
  my ($tokens, $state) = @_;

  my $left;
  while (1) { # left-associative parsing

    my $lookahead = $tokens->[0];
    return $left if !defined($lookahead)
      || ($state == PARSE_IN_PARENS && $lookahead eq ')')
      || ($state == PARSE_IN_EXPR && grep { $lookahead =~ /^$_$/xi }
            '\)', @expression_terminator_sql_keywords
         );

    my $token = shift @$tokens;

    # nested expression in ()
    if ($token eq '(') {
      my $right = _recurse_parse($tokens, PARSE_IN_PARENS);
      $token = shift @$tokens   or croak "missing ')'";
      $token eq ')'             or croak "unexpected token : $token";
      $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
                    : [PAREN  => $right];
    }
    # AND/OR
    elsif ($token eq 'AND' || $token eq 'OR')  {
      my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
      $left = [$token => [$left, $right]];
    }
    # expression terminator keywords (as they start a new expression)
    elsif (grep { $token =~ /^$_$/xi } @expression_terminator_sql_keywords) {
      my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
      $left = $left ? [CONCAT => [$left, [CONCAT => [[EXPR => $token], [PAREN => $right]]]]]
                    : [CONCAT => [[EXPR => $token], [PAREN  => $right]]];
    }
    # leaf expression
    else {
      $left = $left ? [CONCAT => [$left, [EXPR => $token]]]
                    : [EXPR   => $token];
    }
  }
}


sub unparse {
  my $tree = shift;
  my $dispatch = {
    EXPR   => sub {$tree->[1]                                   },
    PAREN  => sub {"(" . unparse($tree->[1]) . ")"              },
    CONCAT => sub {join " ",     map {unparse($_)} @{$tree->[1]}},
    AND    => sub {join " AND ", map {unparse($_)} @{$tree->[1]}},
    OR     => sub {join " OR ",  map {unparse($_)} @{$tree->[1]}},
   };
  $dispatch->{$tree->[0]}->();
}


1;


__END__

=head1 NAME

SQL::Abstract::Test - Helper function for testing SQL::Abstract

=head1 SYNOPSIS

  use SQL::Abstract;
  use Test::More;
  use SQL::Abstract::Test import => [qw/
    is_same_sql_bind is_same_sql is_same_bind
    eq_sql_bind eq_sql eq_bind
  /];
  
  my ($sql, @bind) = SQL::Abstract->new->select(%args);

  is_same_sql_bind($given_sql,    \@given_bind, 
                   $expected_sql, \@expected_bind, $test_msg);

  is_same_sql($given_sql, $expected_sql, $test_msg);
  is_same_bind(\@given_bind, \@expected_bind, $test_msg);

  my $is_same = eq_sql_bind($given_sql,    \@given_bind, 
                            $expected_sql, \@expected_bind);

  my $sql_same = eq_sql($given_sql, $expected_sql);
  my $bind_same = eq_bind(\@given_bind, \@expected_bind);

=head1 DESCRIPTION

This module is only intended for authors of tests on
L<SQL::Abstract|SQL::Abstract> and related modules;
it exports functions for comparing two SQL statements
and their bound values.

The SQL comparison is performed on I<abstract syntax>,
ignoring differences in spaces or in levels of parentheses.
Therefore the tests will pass as long as the semantics
is preserved, even if the surface syntax has changed.

B<Disclaimer> : this is only a half-cooked semantic equivalence;
parsing is simple-minded, and comparison of SQL abstract syntax trees
ignores commutativity or associativity of AND/OR operators, Morgan
laws, etc.

=head1 FUNCTIONS

=head2 is_same_sql_bind

  is_same_sql_bind($given_sql,    \@given_bind, 
                   $expected_sql, \@expected_bind, $test_msg);

Compares given and expected pairs of C<($sql, \@bind)>, and calls
L<Test::Builder/ok> on the result, with C<$test_msg> as message. If the test
fails, a detailed diagnostic is printed. For clients which use L<Test::More>,
this is the one of the three functions (L</is_same_sql_bind>, L</is_same_sql>,
L</is_same_bind>) that needs to be imported.

=head2 is_same_sql

  is_same_sql($given_sql, $expected_sql, $test_msg);

Compares given and expected SQL statements, and calls L<Test::Builder/ok> on
the result, with C<$test_msg> as message. If the test fails, a detailed
diagnostic is printed. For clients which use L<Test::More>, this is the one of
the three functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>)
that needs to be imported.

=head2 is_same_bind

  is_same_bind(\@given_bind, \@expected_bind, $test_msg);

Compares given and expected bind values, and calls L<Test::Builder/ok> on the
result, with C<$test_msg> as message. If the test fails, a detailed diagnostic
is printed. For clients which use L<Test::More>, this is the one of the three
functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>) that needs
to be imported.

=head2 eq_sql_bind

  my $is_same = eq_sql_bind($given_sql,    \@given_bind, 
                            $expected_sql, \@expected_bind);

Compares given and expected pairs of C<($sql, \@bind)>. Similar to
L</is_same_sql_bind>, but it just returns a boolean value and does not print
diagnostics or talk to L<Test::Builder>.

=head2 eq_sql

  my $is_same = eq_sql($given_sql, $expected_sql);

Compares the abstract syntax of two SQL statements. Similar to L</is_same_sql>,
but it just returns a boolean value and does not print diagnostics or talk to
L<Test::Builder>. If the result is false, the global variable L</$sql_differ>
will contain the SQL portion where a difference was encountered; this is useful
for printing diagnostics.

=head2 eq_bind

  my $is_same = eq_sql(\@given_bind, \@expected_bind);

Compares two lists of bind values, taking into account the fact that some of
the values may be arrayrefs (see L<SQL::Abstract/bindtype>). Similar to
L</is_same_bind>, but it just returns a boolean value and does not print
diagnostics or talk to L<Test::Builder>.

=head1 GLOBAL VARIABLES

=head2 $case_sensitive

If true, SQL comparisons will be case-sensitive. Default is false;

=head2 $sql_differ

When L</eq_sql> returns false, the global variable
C<$sql_differ> contains the SQL portion
where a difference was encountered.


=head1 SEE ALSO

L<SQL::Abstract>, L<Test::More>, L<Test::Builder>.

=head1 AUTHORS

Laurent Dami, E<lt>laurent.dami AT etat  geneve  chE<gt>

Norbert Buchmuller <norbi@nix.hu>

=head1 COPYRIGHT AND LICENSE

Copyright 2008 by Laurent Dami.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
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;
fffe6900	7	use Carp;
4abea32b	8	use Test::Builder;
4abea32b	9	use Test::Deep qw(eq_deeply);
fffe6900	10
e7827ba2	11	our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
e7827ba2	12	&eq_sql_bind &eq_sql &eq_bind
fffe6900	13	$case_sensitive $sql_differ/;
	14
	15	our $case_sensitive = 0;
	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()
5221d7fc	20	use constant PARSE_TOP_LEVEL => 0;
	21	use constant PARSE_IN_EXPR => 1;
	22	use constant PARSE_IN_PARENS => 2;
25823711	23
	24	# These SQL keywords always signal end of the current expression (except inside
	25	# of a parenthesized subexpression).
	26	# Format: A list of strings that will be compiled to extended syntax (ie.
	27	# /.../x) regexes, without capturing parentheses. They will be automatically
	28	# anchored to word boundaries to match the whole token).
	29	my @expression_terminator_sql_keywords = (
	30	'FROM',
	31	'(?:
	32	(?:
	33	(?: \b (?: LEFT \| RIGHT \| FULL ) \s+ )?
	34	(?: \b (?: CROSS \| INNER \| OUTER ) \s+ )?
	35	)?
	36	JOIN
	37	)',
	38	'ON',
	39	'WHERE',
	40	'GROUP \s+ BY',
	41	'HAVING',
	42	'ORDER \s+ BY',
	43	'LIMIT',
	44	'OFFSET',
	45	'FOR',
	46	'UNION',
	47	'INTERSECT',
	48	'EXCEPT',
	49	);
	50
	51	my $tokenizer_re_str = join('\|',
	52	map { '\b' . $_ . '\b' }
	53	@expression_terminator_sql_keywords, 'AND', 'OR'
	54	);
	55
	56	my $tokenizer_re = qr/
	57	\s*
	58	(
	59	\(
	60	\|
	61	\)
	62	\|
	63	$tokenizer_re_str
	64	)
	65	\s*
	66	/xi;
	67
	68
fffe6900	69	sub is_same_sql_bind {
	70	my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
	71
	72	# compare
25823711	73	my $same_sql = eq_sql($sql1, $sql2);
fffe6900	74	my $same_bind = eq_bind($bind_ref1, $bind_ref2);
fffe6900	75
a6daa642	76	# call Test::Builder::ok
5aad8cf3	77	$tb->ok($same_sql && $same_bind, $msg);
fffe6900	78
	79	# add debugging info
	80	if (!$same_sql) {
e7827ba2	81	_sql_differ_diag($sql1, $sql2);
fffe6900	82	}
fffe6900	83	if (!$same_bind) {
e7827ba2	84	_bind_differ_diag($bind_ref1, $bind_ref2);
fffe6900	85	}
	86	}
	87
e7827ba2	88	sub is_same_sql {
	89	my ($sql1, $sql2, $msg) = @_;
	90
	91	# compare
	92	my $same_sql = eq_sql($sql1, $sql2);
	93
	94	# call Test::Builder::ok
	95	$tb->ok($same_sql, $msg);
	96
	97	# add debugging info
	98	if (!$same_sql) {
	99	_sql_differ_diag($sql1, $sql2);
	100	}
	101	}
	102
	103	sub is_same_bind {
	104	my ($bind_ref1, $bind_ref2, $msg) = @_;
	105
	106	# compare
	107	my $same_bind = eq_bind($bind_ref1, $bind_ref2);
	108
	109	# call Test::Builder::ok
	110	$tb->ok($same_bind, $msg);
	111
	112	# add debugging info
	113	if (!$same_bind) {
	114	_bind_differ_diag($bind_ref1, $bind_ref2);
	115	}
	116	}
	117
	118	sub _sql_differ_diag {
	119	my ($sql1, $sql2) = @_;
	120
	121	$tb->diag("SQL expressions differ\n"
	122	." got: $sql1\n"
	123	."expected: $sql2\n"
	124	."differing in :\n$sql_differ\n"
	125	);
	126	}
	127
	128	sub _bind_differ_diag {
	129	my ($bind_ref1, $bind_ref2) = @_;
	130
	131	$tb->diag("BIND values differ\n"
	132	." got: " . Dumper($bind_ref1)
	133	."expected: " . Dumper($bind_ref2)
	134	);
	135	}
	136
	137	sub eq_sql_bind {
	138	my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
	139
	140	return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
	141	}
	142
	143
fffe6900	144	sub eq_bind {
fffe6900	145	my ($bind_ref1, $bind_ref2) = @_;
fffe6900	146
4abea32b	147	return eq_deeply($bind_ref1, $bind_ref2);
fffe6900	148	}
	149
	150	sub eq_sql {
25823711	151	my ($sql1, $sql2) = @_;
	152
	153	# parse
	154	my $tree1 = parse($sql1);
	155	my $tree2 = parse($sql2);
	156
	157	return _eq_sql($tree1, $tree2);
	158	}
	159
	160	sub _eq_sql {
fffe6900	161	my ($left, $right) = @_;
	162
	163	# ignore top-level parentheses
d15c14cc	164	while ($left->[0] and $left->[0] eq 'PAREN') {$left = $left->[1] }
d15c14cc	165	while ($right->[0] and $right->[0] eq 'PAREN') {$right = $right->[1]}
fffe6900	166
d15c14cc	167	# if both are undef i.e. ()
	168	if (not grep { defined $_ } ($left->[0], $right->[0]) ) {
	169	return 1;
	170	}
fffe6900	171	# if operators are different
d15c14cc	172	elsif ($left->[0] ne $right->[0]) {
fffe6900	173	$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
	174	unparse($left),
	175	unparse($right);
	176	return 0;
	177	}
	178	# elsif operators are identical, compare operands
	179	else {
	180	if ($left->[0] eq 'EXPR' ) { # unary operator
	181	(my $l = " $left->[1] " ) =~ s/\s+/ /g;
	182	(my $r = " $right->[1] ") =~ s/\s+/ /g;
	183	my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r);
	184	$sql_differ = "[$left->[1]] != [$right->[1]]\n" if not $eq;
	185	return $eq;
	186	}
	187	else { # binary operator
25823711	188	return _eq_sql($left->[1][0], $right->[1][0]) # left operand
25823711	189	&& _eq_sql($left->[1][1], $right->[1][1]); # right operand
fffe6900	190	}
	191	}
	192	}
	193
	194
	195	sub parse {
	196	my $s = shift;
	197
25823711	198	# tokenize string, and remove all optional whitespace
	199	my $tokens = [];
	200	foreach my $token (split $tokenizer_re, $s) {
	201	$token =~ s/\s+/ /g;
	202	$token =~ s/\s+([^\w\s])/$1/g;
	203	$token =~ s/([^\w\s])\s+/$1/g;
	204	push @$tokens, $token if $token !~ /^$/;
	205	}
fffe6900	206
25823711	207	my $tree = _recurse_parse($tokens, PARSE_TOP_LEVEL);
fffe6900	208	return $tree;
	209	}
	210
	211	sub _recurse_parse {
25823711	212	my ($tokens, $state) = @_;
fffe6900	213
	214	my $left;
	215	while (1) { # left-associative parsing
	216
	217	my $lookahead = $tokens->[0];
25823711	218	return $left if !defined($lookahead)
	219	\|\| ($state == PARSE_IN_PARENS && $lookahead eq ')')
	220	\|\| ($state == PARSE_IN_EXPR && grep { $lookahead =~ /^$_$/xi }
	221	'\)', @expression_terminator_sql_keywords
	222	);
fffe6900	223
	224	my $token = shift @$tokens;
	225
	226	# nested expression in ()
	227	if ($token eq '(') {
25823711	228	my $right = _recurse_parse($tokens, PARSE_IN_PARENS);
fffe6900	229	$token = shift @$tokens or croak "missing ')'";
	230	$token eq ')' or croak "unexpected token : $token";
	231	$left = $left ? [CONCAT => [$left, [PAREN => $right]]]
	232	: [PAREN => $right];
	233	}
	234	# AND/OR
	235	elsif ($token eq 'AND' \|\| $token eq 'OR') {
25823711	236	my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
fffe6900	237	$left = [$token => [$left, $right]];
fffe6900	238	}
25823711	239	# expression terminator keywords (as they start a new expression)
	240	elsif (grep { $token =~ /^$_$/xi } @expression_terminator_sql_keywords) {
	241	my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
	242	$left = $left ? [CONCAT => [$left, [CONCAT => [[EXPR => $token], [PAREN => $right]]]]]
	243	: [CONCAT => [[EXPR => $token], [PAREN => $right]]];
	244	}
fffe6900	245	# leaf expression
	246	else {
	247	$left = $left ? [CONCAT => [$left, [EXPR => $token]]]
	248	: [EXPR => $token];
	249	}
	250	}
	251	}
	252
	253
	254
	255	sub unparse {
	256	my $tree = shift;
	257	my $dispatch = {
	258	EXPR => sub {$tree->[1] },
	259	PAREN => sub {"(" . unparse($tree->[1]) . ")" },
	260	CONCAT => sub {join " ", map {unparse($_)} @{$tree->[1]}},
	261	AND => sub {join " AND ", map {unparse($_)} @{$tree->[1]}},
	262	OR => sub {join " OR ", map {unparse($_)} @{$tree->[1]}},
	263	};
	264	$dispatch->{$tree->[0]}->();
	265	}
	266
	267
	268	1;
	269
	270
	271	__END__
	272
	273	=head1 NAME
	274
	275	SQL::Abstract::Test - Helper function for testing SQL::Abstract
	276
	277	=head1 SYNOPSIS
	278
	279	use SQL::Abstract;
	280	use Test::More;
e7827ba2	281	use SQL::Abstract::Test import => [qw/
	282	is_same_sql_bind is_same_sql is_same_bind
	283	eq_sql_bind eq_sql eq_bind
	284	/];
fffe6900	285
fffe6900	286	my ($sql, @bind) = SQL::Abstract->new->select(%args);
e7827ba2	287
fffe6900	288	is_same_sql_bind($given_sql, \@given_bind,
	289	$expected_sql, \@expected_bind, $test_msg);
	290
e7827ba2	291	is_same_sql($given_sql, $expected_sql, $test_msg);
	292	is_same_bind(\@given_bind, \@expected_bind, $test_msg);
	293
	294	my $is_same = eq_sql_bind($given_sql, \@given_bind,
	295	$expected_sql, \@expected_bind);
	296
	297	my $sql_same = eq_sql($given_sql, $expected_sql);
	298	my $bind_same = eq_bind(\@given_bind, \@expected_bind);
	299
fffe6900	300	=head1 DESCRIPTION
	301
	302	This module is only intended for authors of tests on
	303	L<SQL::Abstract\|SQL::Abstract> and related modules;
	304	it exports functions for comparing two SQL statements
	305	and their bound values.
	306
	307	The SQL comparison is performed on I<abstract syntax>,
	308	ignoring differences in spaces or in levels of parentheses.
	309	Therefore the tests will pass as long as the semantics
	310	is preserved, even if the surface syntax has changed.
	311
	312	B<Disclaimer> : this is only a half-cooked semantic equivalence;
	313	parsing is simple-minded, and comparison of SQL abstract syntax trees
	314	ignores commutativity or associativity of AND/OR operators, Morgan
	315	laws, etc.
	316
	317	=head1 FUNCTIONS
	318
	319	=head2 is_same_sql_bind
	320
	321	is_same_sql_bind($given_sql, \@given_bind,
	322	$expected_sql, \@expected_bind, $test_msg);
	323
	324	Compares given and expected pairs of C<($sql, \@bind)>, and calls
e7827ba2	325	L<Test::Builder/ok> on the result, with C<$test_msg> as message. If the test
	326	fails, a detailed diagnostic is printed. For clients which use L<Test::More>,
	327	this is the one of the three functions (L</is_same_sql_bind>, L</is_same_sql>,
	328	L</is_same_bind>) that needs to be imported.
	329
	330	=head2 is_same_sql
	331
	332	is_same_sql($given_sql, $expected_sql, $test_msg);
	333
	334	Compares given and expected SQL statements, and calls L<Test::Builder/ok> on
	335	the result, with C<$test_msg> as message. If the test fails, a detailed
	336	diagnostic is printed. For clients which use L<Test::More>, this is the one of
	337	the three functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>)
	338	that needs to be imported.
	339
	340	=head2 is_same_bind
	341
	342	is_same_bind(\@given_bind, \@expected_bind, $test_msg);
	343
	344	Compares given and expected bind values, and calls L<Test::Builder/ok> on the
	345	result, with C<$test_msg> as message. If the test fails, a detailed diagnostic
	346	is printed. For clients which use L<Test::More>, this is the one of the three
	347	functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>) that needs
	348	to be imported.
	349
	350	=head2 eq_sql_bind
	351
	352	my $is_same = eq_sql_bind($given_sql, \@given_bind,
	353	$expected_sql, \@expected_bind);
	354
	355	Compares given and expected pairs of C<($sql, \@bind)>. Similar to
	356	L</is_same_sql_bind>, but it just returns a boolean value and does not print
	357	diagnostics or talk to L<Test::Builder>.
fffe6900	358
	359	=head2 eq_sql
	360
	361	my $is_same = eq_sql($given_sql, $expected_sql);
	362
e7827ba2	363	Compares the abstract syntax of two SQL statements. Similar to L</is_same_sql>,
	364	but it just returns a boolean value and does not print diagnostics or talk to
	365	L<Test::Builder>. If the result is false, the global variable L</$sql_differ>
	366	will contain the SQL portion where a difference was encountered; this is useful
	367	for printing diagnostics.
fffe6900	368
	369	=head2 eq_bind
	370
	371	my $is_same = eq_sql(\@given_bind, \@expected_bind);
	372
e7827ba2	373	Compares two lists of bind values, taking into account the fact that some of
	374	the values may be arrayrefs (see L<SQL::Abstract/bindtype>). Similar to
	375	L</is_same_bind>, but it just returns a boolean value and does not print
	376	diagnostics or talk to L<Test::Builder>.
fffe6900	377
	378	=head1 GLOBAL VARIABLES
	379
e7827ba2	380	=head2 $case_sensitive
fffe6900	381
	382	If true, SQL comparisons will be case-sensitive. Default is false;
	383
e7827ba2	384	=head2 $sql_differ
fffe6900	385
	386	When L</eq_sql> returns false, the global variable
	387	C<$sql_differ> contains the SQL portion
	388	where a difference was encountered.
	389
	390
	391	=head1 SEE ALSO
	392
a6daa642	393	L<SQL::Abstract>, L<Test::More>, L<Test::Builder>.
fffe6900	394
25823711	395	=head1 AUTHORS
fffe6900	396
	397	Laurent Dami, E<lt>laurent.dami AT etat geneve chE<gt>
	398
25823711	399	Norbert Buchmuller <norbi@nix.hu>
25823711	400
fffe6900	401	=head1 COPYRIGHT AND LICENSE
	402
	403	Copyright 2008 by Laurent Dami.
	404
	405	This library is free software; you can redistribute it and/or modify
	406	it under the same terms as Perl itself.