1 package # hide from PAUSE
7 use base qw/Test::Builder::Module Exporter/;
19 package # hide from PAUSE
20 DBIC::SqlMakerTest::SQLATest;
22 # replacement for SQL::Abstract::Test if not available
27 use base qw/Test::Builder::Module Exporter/;
29 use Scalar::Util qw(looks_like_number blessed reftype);
32 our $tb = __PACKAGE__->builder;
36 my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
38 my $same_sql = eq_sql($sql1, $sql2);
39 my $same_bind = eq_bind($bind_ref1, $bind_ref2);
41 $tb->ok($same_sql && $same_bind, $msg);
44 $tb->diag("SQL expressions differ\n"
50 $tb->diag("BIND values differ\n"
51 . " got: " . Dumper($bind_ref1)
52 . "expected: " . Dumper($bind_ref2)
59 my ($left, $right) = @_;
64 return $left eq $right;
67 # lifted from SQL::Abstract::Test
70 my ($bind_ref1, $bind_ref2) = @_;
72 my $ref1 = ref $bind_ref1;
73 my $ref2 = ref $bind_ref2;
75 return 0 if $ref1 ne $ref2;
77 if ($ref1 eq 'SCALAR' || $ref1 eq 'REF') {
78 return eq_bind($$bind_ref1, $$bind_ref2);
79 } elsif ($ref1 eq 'ARRAY') {
80 return 0 if scalar @$bind_ref1 != scalar @$bind_ref2;
81 for (my $i = 0; $i < @$bind_ref1; $i++) {
82 return 0 if !eq_bind($bind_ref1->[$i], $bind_ref2->[$i]);
85 } elsif ($ref1 eq 'HASH') {
88 [sort keys %$bind_ref1],
89 [sort keys %$bind_ref2]
92 [map { $bind_ref1->{$_} } sort keys %$bind_ref1],
93 [map { $bind_ref2->{$_} } sort keys %$bind_ref2]
96 if (!defined $bind_ref1 || !defined $bind_ref2) {
97 return !(defined $bind_ref1 ^ defined $bind_ref2);
98 } elsif (blessed($bind_ref1) || blessed($bind_ref2)) {
99 return 0 if (blessed($bind_ref1) || "") ne (blessed($bind_ref2) || "");
100 return 1 if $bind_ref1 == $bind_ref2; # uses overloaded '=='
101 # fallback: compare the guts of the object
102 my $reftype1 = reftype $bind_ref1;
103 my $reftype2 = reftype $bind_ref2;
104 return 0 if $reftype1 ne $reftype2;
105 if ($reftype1 eq 'SCALAR' || $reftype1 eq 'REF') {
106 $bind_ref1 = $$bind_ref1;
107 $bind_ref2 = $$bind_ref2;
108 } elsif ($reftype1 eq 'ARRAY') {
109 $bind_ref1 = [@$bind_ref1];
110 $bind_ref2 = [@$bind_ref2];
111 } elsif ($reftype1 eq 'HASH') {
112 $bind_ref1 = {%$bind_ref1};
113 $bind_ref2 = {%$bind_ref2};
117 return eq_bind($bind_ref1, $bind_ref2);
118 } elsif (looks_like_number($bind_ref1) && looks_like_number($bind_ref2)) {
119 return $bind_ref1 == $bind_ref2;
121 return $bind_ref1 eq $bind_ref2;
127 eval "use SQL::Abstract::Test;";
129 # SQL::Abstract::Test available
131 *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
132 *eq_sql = \&SQL::Abstract::Test::eq_sql;
133 *eq_bind = \&SQL::Abstract::Test::eq_bind;
137 *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
138 *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
139 *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
150 DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC
155 use DBIC::SqlMakerTest;
157 my ($sql, @bind) = $schema->storage->sql_maker->select(%args);
160 $expected_sql, \@expected_bind,
166 Exports functions that can be used to compare generated SQL and bind values.
168 If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and
169 above) is available, then it is used to perform the comparisons (all functions
170 are delegated to id). Otherwise uses simple string comparison for the SQL
171 statements and simple L<Data::Dumper>-like recursive stringification for
172 comparison of bind values.
177 =head2 is_same_sql_bind
180 $given_sql, \@given_bind,
181 $expected_sql, \@expected_bind,
185 Compares given and expected pairs of C<($sql, \@bind)>, and calls
186 L<Test::Builder/ok> on the result, with C<$test_msg> as message.
190 my $is_same = eq_sql($given_sql, $expected_sql);
192 Compares the two SQL statements. Returns true IFF they are equivalent.
196 my $is_same = eq_sql(\@given_bind, \@expected_bind);
198 Compares two lists of bind values. Returns true IFF their values are the same.
203 L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>.
207 Norbert Buchmuller, <norbi@nix.hu>
209 =head1 COPYRIGHT AND LICENSE
211 Copyright 2008 by Norbert Buchmuller.
213 This library is free software; you can redistribute it and/or modify
214 it under the same terms as Perl itself.