t/lib/DBIC/SqlMakerTest.pm

   1 package DBIC::SqlMakerTest;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Test::Builder::Module Exporter/;
   7
   8 our @EXPORT = qw/
   9   &is_same_sql_bind
  10   &is_same_sql
  11   &is_same_bind
  12   &eq_sql
  13   &eq_bind
  14   &eq_sql_bind
  15 /;
  16
  17
  18 {
  19   package DBIC::SqlMakerTest::SQLATest;
  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
  28   use Scalar::Util qw(looks_like_number blessed reftype);
  29   use Data::Dumper;
  30   use Test::Builder;
  31   use Test::Deep qw(eq_deeply);
  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) {
  45       _sql_differ_diag($sql1, $sql2);
  46     }
  47     if (!$same_bind) {
  48       _bind_differ_diag($bind_ref1, $bind_ref2);
  49     }
  50   }
  51
  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
  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
 112     return eq_deeply($bind_ref1, $bind_ref2);
 113   }
 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   }
 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;
 128   *is_same_sql = \&SQL::Abstract::Test::is_same_sql;
 129   *is_same_bind = \&SQL::Abstract::Test::is_same_bind;
 130   *eq_sql = \&SQL::Abstract::Test::eq_sql;
 131   *eq_bind = \&SQL::Abstract::Test::eq_bind;
 132   *eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind;
 133 } else {
 134   # old SQL::Abstract
 135
 136   *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
 137   *is_same_sql = \&DBIC::SqlMakerTest::SQLATest::is_same_sql;
 138   *is_same_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_bind;
 139   *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
 140   *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
 141   *eq_sql_bind = \&DBIC::SqlMakerTest::SQLATest::eq_sql_bind;
 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
 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
 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
 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
 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.