t/lib/DBIC/SqlMakerTest.pm

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