Commit | Line | Data |
b596c25c |
1 | package DBIC::SqlMakerTest; |
949172b0 |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base qw/Test::Builder::Module Exporter/; |
7 | |
949172b0 |
8 | our @EXPORT = qw/ |
9 | &is_same_sql_bind |
6ffb5be5 |
10 | &is_same_sql |
11 | &is_same_bind |
949172b0 |
12 | &eq_sql |
13 | &eq_bind |
6ffb5be5 |
14 | &eq_sql_bind |
949172b0 |
15 | /; |
16 | |
17 | |
18 | { |
7add4671 |
19 | package DBIC::SqlMakerTest::SQLATest; |
949172b0 |
20 | |
21 | # replacement for SQL::Abstract::Test if not available |
22 | |
23 | use strict; |
24 | use warnings; |
25 | |
26 | use base qw/Test::Builder::Module Exporter/; |
27 | |
2564f119 |
28 | use Scalar::Util qw(looks_like_number blessed reftype); |
949172b0 |
29 | use Data::Dumper; |
ce3b4eb9 |
30 | use Test::Builder; |
31 | use Test::Deep qw(eq_deeply); |
949172b0 |
32 | |
33 | our $tb = __PACKAGE__->builder; |
34 | |
35 | sub is_same_sql_bind |
36 | { |
37 | my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; |
38 | |
39 | my $same_sql = eq_sql($sql1, $sql2); |
40 | my $same_bind = eq_bind($bind_ref1, $bind_ref2); |
41 | |
42 | $tb->ok($same_sql && $same_bind, $msg); |
43 | |
44 | if (!$same_sql) { |
6ffb5be5 |
45 | _sql_differ_diag($sql1, $sql2); |
949172b0 |
46 | } |
47 | if (!$same_bind) { |
6ffb5be5 |
48 | _bind_differ_diag($bind_ref1, $bind_ref2); |
949172b0 |
49 | } |
50 | } |
51 | |
6ffb5be5 |
52 | sub is_same_sql |
53 | { |
54 | my ($sql1, $sql2, $msg) = @_; |
55 | |
56 | my $same_sql = eq_sql($sql1, $sql2); |
57 | |
58 | $tb->ok($same_sql, $msg); |
59 | |
60 | if (!$same_sql) { |
61 | _sql_differ_diag($sql1, $sql2); |
62 | } |
63 | } |
64 | |
65 | sub is_same_bind |
66 | { |
67 | my ($bind_ref1, $bind_ref2, $msg) = @_; |
68 | |
69 | my $same_bind = eq_bind($bind_ref1, $bind_ref2); |
70 | |
71 | $tb->ok($same_bind, $msg); |
72 | |
73 | if (!$same_bind) { |
74 | _bind_differ_diag($bind_ref1, $bind_ref2); |
75 | } |
76 | } |
77 | |
78 | sub _sql_differ_diag |
79 | { |
80 | my ($sql1, $sql2) = @_; |
81 | |
82 | $tb->diag("SQL expressions differ\n" |
83 | . " got: $sql1\n" |
84 | . "expected: $sql2\n" |
85 | ); |
86 | } |
87 | |
88 | sub _bind_differ_diag |
89 | { |
90 | my ($bind_ref1, $bind_ref2) = @_; |
91 | |
92 | $tb->diag("BIND values differ\n" |
93 | . " got: " . Dumper($bind_ref1) |
94 | . "expected: " . Dumper($bind_ref2) |
95 | ); |
96 | } |
97 | |
949172b0 |
98 | sub eq_sql |
99 | { |
100 | my ($left, $right) = @_; |
101 | |
102 | $left =~ s/\s+//g; |
103 | $right =~ s/\s+//g; |
104 | |
105 | return $left eq $right; |
106 | } |
107 | |
108 | sub eq_bind |
109 | { |
110 | my ($bind_ref1, $bind_ref2) = @_; |
111 | |
ce3b4eb9 |
112 | return eq_deeply($bind_ref1, $bind_ref2); |
949172b0 |
113 | } |
6ffb5be5 |
114 | |
115 | sub eq_sql_bind |
116 | { |
117 | my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_; |
118 | |
119 | return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2); |
120 | } |
949172b0 |
121 | } |
122 | |
123 | eval "use SQL::Abstract::Test;"; |
124 | if ($@ eq '') { |
125 | # SQL::Abstract::Test available |
126 | |
127 | *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind; |
6ffb5be5 |
128 | *is_same_sql = \&SQL::Abstract::Test::is_same_sql; |
129 | *is_same_bind = \&SQL::Abstract::Test::is_same_bind; |
949172b0 |
130 | *eq_sql = \&SQL::Abstract::Test::eq_sql; |
131 | *eq_bind = \&SQL::Abstract::Test::eq_bind; |
6ffb5be5 |
132 | *eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind; |
949172b0 |
133 | } else { |
134 | # old SQL::Abstract |
135 | |
136 | *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind; |
6ffb5be5 |
137 | *is_same_sql = \&DBIC::SqlMakerTest::SQLATest::is_same_sql; |
138 | *is_same_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_bind; |
949172b0 |
139 | *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql; |
140 | *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind; |
6ffb5be5 |
141 | *eq_sql_bind = \&DBIC::SqlMakerTest::SQLATest::eq_sql_bind; |
949172b0 |
142 | } |
143 | |
144 | |
145 | 1; |
146 | |
147 | __END__ |
148 | |
149 | |
150 | =head1 NAME |
151 | |
152 | DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC |
153 | |
154 | =head1 SYNOPSIS |
155 | |
156 | use Test::More; |
157 | use DBIC::SqlMakerTest; |
158 | |
159 | my ($sql, @bind) = $schema->storage->sql_maker->select(%args); |
160 | is_same_sql_bind( |
161 | $sql, \@bind, |
162 | $expected_sql, \@expected_bind, |
163 | 'foo bar works' |
164 | ); |
165 | |
166 | =head1 DESCRIPTION |
167 | |
168 | Exports functions that can be used to compare generated SQL and bind values. |
169 | |
170 | If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and |
171 | above) is available, then it is used to perform the comparisons (all functions |
172 | are delegated to id). Otherwise uses simple string comparison for the SQL |
173 | statements and simple L<Data::Dumper>-like recursive stringification for |
174 | comparison of bind values. |
175 | |
176 | |
177 | =head1 FUNCTIONS |
178 | |
179 | =head2 is_same_sql_bind |
180 | |
181 | is_same_sql_bind( |
182 | $given_sql, \@given_bind, |
183 | $expected_sql, \@expected_bind, |
184 | $test_msg |
185 | ); |
186 | |
187 | Compares given and expected pairs of C<($sql, \@bind)>, and calls |
188 | L<Test::Builder/ok> on the result, with C<$test_msg> as message. |
189 | |
6ffb5be5 |
190 | =head2 is_same_sql |
191 | |
192 | is_same_sql( |
193 | $given_sql, |
194 | $expected_sql, |
195 | $test_msg |
196 | ); |
197 | |
198 | Compares given and expected SQL statement, and calls L<Test::Builder/ok> on the |
199 | result, with C<$test_msg> as message. |
200 | |
201 | =head2 is_same_bind |
202 | |
203 | is_same_bind( |
204 | \@given_bind, |
205 | \@expected_bind, |
206 | $test_msg |
207 | ); |
208 | |
209 | Compares given and expected bind value lists, and calls L<Test::Builder/ok> on |
210 | the result, with C<$test_msg> as message. |
211 | |
949172b0 |
212 | =head2 eq_sql |
213 | |
214 | my $is_same = eq_sql($given_sql, $expected_sql); |
215 | |
216 | Compares the two SQL statements. Returns true IFF they are equivalent. |
217 | |
218 | =head2 eq_bind |
219 | |
220 | my $is_same = eq_sql(\@given_bind, \@expected_bind); |
221 | |
222 | Compares two lists of bind values. Returns true IFF their values are the same. |
223 | |
6ffb5be5 |
224 | =head2 eq_sql_bind |
225 | |
226 | my $is_same = eq_sql_bind( |
227 | $given_sql, \@given_bind, |
228 | $expected_sql, \@expected_bind |
229 | ); |
230 | |
231 | Compares the two SQL statements and the two lists of bind values. Returns true |
232 | IFF they are equivalent and the bind values are the same. |
233 | |
949172b0 |
234 | |
235 | =head1 SEE ALSO |
236 | |
237 | L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>. |
238 | |
239 | =head1 AUTHOR |
240 | |
241 | Norbert Buchmuller, <norbi@nix.hu> |
242 | |
243 | =head1 COPYRIGHT AND LICENSE |
244 | |
245 | Copyright 2008 by Norbert Buchmuller. |
246 | |
247 | This library is free software; you can redistribute it and/or modify |
248 | it under the same terms as Perl itself. |