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 use Exporter;
   9
  10 our @EXPORT = qw/
  11   &is_same_sql_bind
  12   &eq_sql
  13   &eq_bind
  14 /;
  15
  16
  17 {
  18   package DBIC::SqlMakerTest::SQLATest;
  19
  20   # replacement for SQL::Abstract::Test if not available
  21
  22   use strict;
  23   use warnings;
  24
  25   use base qw/Test::Builder::Module Exporter/;
  26
  27   use Scalar::Util qw(looks_like_number blessed reftype);
  28   use Data::Dumper;
  29   use Test::Builder;
  30   use Test::Deep qw(eq_deeply);
  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 eq_deeply($bind_ref1, $bind_ref2);
  72   }
  73 }
  74
  75 eval "use SQL::Abstract::Test;";
  76 if ($@ eq '') {
  77   # SQL::Abstract::Test available
  78
  79   *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
  80   *eq_sql = \&SQL::Abstract::Test::eq_sql;
  81   *eq_bind = \&SQL::Abstract::Test::eq_bind;
  82 } else {
  83   # old SQL::Abstract
  84
  85   *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
  86   *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
  87   *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
  88 }
  89
  90
  91 1;
  92
  93 __END__
  94
  95
  96 =head1 NAME
  97
  98 DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC
  99
 100 =head1 SYNOPSIS
 101
 102   use Test::More;
 103   use DBIC::SqlMakerTest;
 104
 105   my ($sql, @bind) = $schema->storage->sql_maker->select(%args);
 106   is_same_sql_bind(
 107     $sql, \@bind,
 108     $expected_sql, \@expected_bind,
 109     'foo bar works'
 110   );
 111
 112 =head1 DESCRIPTION
 113
 114 Exports functions that can be used to compare generated SQL and bind values.
 115
 116 If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and
 117 above) is available, then it is used to perform the comparisons (all functions
 118 are delegated to id). Otherwise uses simple string comparison for the SQL
 119 statements and simple L<Data::Dumper>-like recursive stringification for
 120 comparison of bind values.
 121
 122
 123 =head1 FUNCTIONS
 124
 125 =head2 is_same_sql_bind
 126
 127   is_same_sql_bind(
 128     $given_sql, \@given_bind,
 129     $expected_sql, \@expected_bind,
 130     $test_msg
 131   );
 132
 133 Compares given and expected pairs of C<($sql, \@bind)>, and calls
 134 L<Test::Builder/ok> on the result, with C<$test_msg> as message.
 135
 136 =head2 eq_sql
 137
 138   my $is_same = eq_sql($given_sql, $expected_sql);
 139
 140 Compares the two SQL statements. Returns true IFF they are equivalent.
 141
 142 =head2 eq_bind
 143
 144   my $is_same = eq_sql(\@given_bind, \@expected_bind);
 145
 146 Compares two lists of bind values. Returns true IFF their values are the same.
 147
 148
 149 =head1 SEE ALSO
 150
 151 L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>.
 152
 153 =head1 AUTHOR
 154
 155 Norbert Buchmuller, <norbi@nix.hu>
 156
 157 =head1 COPYRIGHT AND LICENSE
 158
 159 Copyright 2008 by Norbert Buchmuller.
 160
 161 This library is free software; you can redistribute it and/or modify
 162 it under the same terms as Perl itself.