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