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