Commit | Line | Data |
949172b0 |
1 | package # hide from PAUSE |
2 | DBIC::SqlMakerTest; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use base qw/Test::Builder::Module Exporter/; |
8 | |
9 | use Exporter; |
949172b0 |
10 | |
11 | our @EXPORT = qw/ |
12 | &is_same_sql_bind |
13 | &eq_sql |
14 | &eq_bind |
15 | /; |
16 | |
17 | |
18 | { |
19 | package # hide from PAUSE |
20 | DBIC::SqlMakerTest::SQLATest; |
21 | |
22 | # replacement for SQL::Abstract::Test if not available |
23 | |
24 | use strict; |
25 | use warnings; |
26 | |
27 | use base qw/Test::Builder::Module Exporter/; |
28 | |
2564f119 |
29 | use Scalar::Util qw(looks_like_number blessed reftype); |
949172b0 |
30 | use Data::Dumper; |
ce3b4eb9 |
31 | use Test::Builder; |
32 | use Test::Deep qw(eq_deeply); |
949172b0 |
33 | |
34 | our $tb = __PACKAGE__->builder; |
35 | |
36 | sub is_same_sql_bind |
37 | { |
38 | my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; |
39 | |
40 | my $same_sql = eq_sql($sql1, $sql2); |
41 | my $same_bind = eq_bind($bind_ref1, $bind_ref2); |
42 | |
43 | $tb->ok($same_sql && $same_bind, $msg); |
44 | |
45 | if (!$same_sql) { |
46 | $tb->diag("SQL expressions differ\n" |
47 | . " got: $sql1\n" |
48 | . "expected: $sql2\n" |
49 | ); |
50 | } |
51 | if (!$same_bind) { |
52 | $tb->diag("BIND values differ\n" |
53 | . " got: " . Dumper($bind_ref1) |
54 | . "expected: " . Dumper($bind_ref2) |
55 | ); |
56 | } |
57 | } |
58 | |
59 | sub eq_sql |
60 | { |
61 | my ($left, $right) = @_; |
62 | |
63 | $left =~ s/\s+//g; |
64 | $right =~ s/\s+//g; |
65 | |
66 | return $left eq $right; |
67 | } |
68 | |
2564f119 |
69 | # lifted from SQL::Abstract::Test |
949172b0 |
70 | sub eq_bind |
71 | { |
72 | my ($bind_ref1, $bind_ref2) = @_; |
73 | |
ce3b4eb9 |
74 | return eq_deeply($bind_ref1, $bind_ref2); |
949172b0 |
75 | } |
76 | } |
77 | |
78 | eval "use SQL::Abstract::Test;"; |
79 | if ($@ eq '') { |
80 | # SQL::Abstract::Test available |
81 | |
82 | *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind; |
83 | *eq_sql = \&SQL::Abstract::Test::eq_sql; |
84 | *eq_bind = \&SQL::Abstract::Test::eq_bind; |
85 | } else { |
86 | # old SQL::Abstract |
87 | |
88 | *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind; |
89 | *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql; |
90 | *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind; |
91 | } |
92 | |
93 | |
94 | 1; |
95 | |
96 | __END__ |
97 | |
98 | |
99 | =head1 NAME |
100 | |
101 | DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC |
102 | |
103 | =head1 SYNOPSIS |
104 | |
105 | use Test::More; |
106 | use DBIC::SqlMakerTest; |
107 | |
108 | my ($sql, @bind) = $schema->storage->sql_maker->select(%args); |
109 | is_same_sql_bind( |
110 | $sql, \@bind, |
111 | $expected_sql, \@expected_bind, |
112 | 'foo bar works' |
113 | ); |
114 | |
115 | =head1 DESCRIPTION |
116 | |
117 | Exports functions that can be used to compare generated SQL and bind values. |
118 | |
119 | If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and |
120 | above) is available, then it is used to perform the comparisons (all functions |
121 | are delegated to id). Otherwise uses simple string comparison for the SQL |
122 | statements and simple L<Data::Dumper>-like recursive stringification for |
123 | comparison of bind values. |
124 | |
125 | |
126 | =head1 FUNCTIONS |
127 | |
128 | =head2 is_same_sql_bind |
129 | |
130 | is_same_sql_bind( |
131 | $given_sql, \@given_bind, |
132 | $expected_sql, \@expected_bind, |
133 | $test_msg |
134 | ); |
135 | |
136 | Compares given and expected pairs of C<($sql, \@bind)>, and calls |
137 | L<Test::Builder/ok> on the result, with C<$test_msg> as message. |
138 | |
139 | =head2 eq_sql |
140 | |
141 | my $is_same = eq_sql($given_sql, $expected_sql); |
142 | |
143 | Compares the two SQL statements. Returns true IFF they are equivalent. |
144 | |
145 | =head2 eq_bind |
146 | |
147 | my $is_same = eq_sql(\@given_bind, \@expected_bind); |
148 | |
149 | Compares two lists of bind values. Returns true IFF their values are the same. |
150 | |
151 | |
152 | =head1 SEE ALSO |
153 | |
154 | L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>. |
155 | |
156 | =head1 AUTHOR |
157 | |
158 | Norbert Buchmuller, <norbi@nix.hu> |
159 | |
160 | =head1 COPYRIGHT AND LICENSE |
161 | |
162 | Copyright 2008 by Norbert Buchmuller. |
163 | |
164 | This library is free software; you can redistribute it and/or modify |
165 | it under the same terms as Perl itself. |