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