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