-package # hide from PAUSE
- DBIC::SqlMakerTest;
+package DBIC::SqlMakerTest;
use strict;
use warnings;
-use base qw/Test::Builder::Module Exporter/;
+use base qw/Exporter/;
-use Exporter;
+use Carp;
+use SQL::Abstract::Test;
our @EXPORT = qw/
- &is_same_sql_bind
- &eq_sql
- &eq_bind
+ is_same_sql_bind
+ is_same_sql
+ is_same_bind
+/;
+our @EXPORT_OK = qw/
+ eq_sql
+ eq_bind
+ eq_sql_bind
/;
+sub is_same_sql_bind {
+ # unroll possible as_query arrayrefrefs
+ my @args;
-{
- package # hide from PAUSE
- DBIC::SqlMakerTest::SQLATest;
-
- # replacement for SQL::Abstract::Test if not available
-
- use strict;
- use warnings;
-
- use base qw/Test::Builder::Module Exporter/;
-
- use Scalar::Util qw(looks_like_number blessed reftype);
- use Data::Dumper;
-
- our $tb = __PACKAGE__->builder;
-
- sub is_same_sql_bind
- {
- my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
-
- my $same_sql = eq_sql($sql1, $sql2);
- my $same_bind = eq_bind($bind_ref1, $bind_ref2);
-
- $tb->ok($same_sql && $same_bind, $msg);
+ for (1,2) {
+ my $chunk = shift @_;
- if (!$same_sql) {
- $tb->diag("SQL expressions differ\n"
- . " got: $sql1\n"
- . "expected: $sql2\n"
- );
+ if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) {
+ my ($sql, @bind) = @$$chunk;
+ push @args, ($sql, \@bind);
}
- if (!$same_bind) {
- $tb->diag("BIND values differ\n"
- . " got: " . Dumper($bind_ref1)
- . "expected: " . Dumper($bind_ref2)
- );
+ else {
+ push @args, $chunk, shift @_;
}
- }
-
- sub eq_sql
- {
- my ($left, $right) = @_;
- $left =~ s/\s+//g;
- $right =~ s/\s+//g;
-
- return $left eq $right;
}
- # lifted from SQL::Abstract::Test
- sub eq_bind
- {
- my ($bind_ref1, $bind_ref2) = @_;
-
- my $ref1 = ref $bind_ref1;
- my $ref2 = ref $bind_ref2;
-
- return 0 if $ref1 ne $ref2;
-
- if ($ref1 eq 'SCALAR' || $ref1 eq 'REF') {
- return eq_bind($$bind_ref1, $$bind_ref2);
- } elsif ($ref1 eq 'ARRAY') {
- return 0 if scalar @$bind_ref1 != scalar @$bind_ref2;
- for (my $i = 0; $i < @$bind_ref1; $i++) {
- return 0 if !eq_bind($bind_ref1->[$i], $bind_ref2->[$i]);
- }
- return 1;
- } elsif ($ref1 eq 'HASH') {
- return
- eq_bind(
- [sort keys %$bind_ref1],
- [sort keys %$bind_ref2]
- )
- && eq_bind(
- [map { $bind_ref1->{$_} } sort keys %$bind_ref1],
- [map { $bind_ref2->{$_} } sort keys %$bind_ref2]
- );
- } else {
- if (!defined $bind_ref1 || !defined $bind_ref2) {
- return !(defined $bind_ref1 ^ defined $bind_ref2);
- } elsif (blessed($bind_ref1) || blessed($bind_ref2)) {
- return 0 if (blessed($bind_ref1) || "") ne (blessed($bind_ref2) || "");
- return 1 if $bind_ref1 == $bind_ref2; # uses overloaded '=='
- # fallback: compare the guts of the object
- my $reftype1 = reftype $bind_ref1;
- my $reftype2 = reftype $bind_ref2;
- return 0 if $reftype1 ne $reftype2;
- if ($reftype1 eq 'SCALAR' || $reftype1 eq 'REF') {
- $bind_ref1 = $$bind_ref1;
- $bind_ref2 = $$bind_ref2;
- } elsif ($reftype1 eq 'ARRAY') {
- $bind_ref1 = [@$bind_ref1];
- $bind_ref2 = [@$bind_ref2];
- } elsif ($reftype1 eq 'HASH') {
- $bind_ref1 = {%$bind_ref1};
- $bind_ref2 = {%$bind_ref2};
- } else {
- return 0;
- }
- return eq_bind($bind_ref1, $bind_ref2);
- } elsif (looks_like_number($bind_ref1) && looks_like_number($bind_ref2)) {
- return $bind_ref1 == $bind_ref2;
- } else {
- return $bind_ref1 eq $bind_ref2;
- }
- }
- }
-}
-
-eval "use SQL::Abstract::Test;";
-if ($@ eq '') {
- # SQL::Abstract::Test available
+ push @args, shift @_;
- *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
- *eq_sql = \&SQL::Abstract::Test::eq_sql;
- *eq_bind = \&SQL::Abstract::Test::eq_bind;
-} else {
- # old SQL::Abstract
+ croak "Unexpected argument(s) supplied to is_same_sql_bind: " . join ('; ', @_)
+ if @_;
- *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
- *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
- *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
+ @_ = @args;
+ goto &SQL::Abstract::Test::is_same_sql_bind;
}
+*is_same_sql = \&SQL::Abstract::Test::is_same_sql;
+*is_same_bind = \&SQL::Abstract::Test::is_same_bind;
+*eq_sql = \&SQL::Abstract::Test::eq_sql;
+*eq_bind = \&SQL::Abstract::Test::eq_bind;
+*eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind;
1;
use Test::More;
use DBIC::SqlMakerTest;
-
+
my ($sql, @bind) = $schema->storage->sql_maker->select(%args);
is_same_sql_bind(
- $sql, \@bind,
+ $sql, \@bind,
$expected_sql, \@expected_bind,
'foo bar works'
);
Exports functions that can be used to compare generated SQL and bind values.
-If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and
-above) is available, then it is used to perform the comparisons (all functions
-are delegated to id). Otherwise uses simple string comparison for the SQL
-statements and simple L<Data::Dumper>-like recursive stringification for
-comparison of bind values.
-
+This is a thin wrapper around L<SQL::Abstract::Test>, which makes it easier
+to compare as_query sql/bind arrayrefrefs directly.
=head1 FUNCTIONS
=head2 is_same_sql_bind
is_same_sql_bind(
- $given_sql, \@given_bind,
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind,
+ $test_msg
+ );
+
+ is_same_sql_bind(
+ $rs->as_query
+ $expected_sql, \@expected_bind,
+ $test_msg
+ );
+
+ is_same_sql_bind(
+ \[$given_sql, @given_bind],
$expected_sql, \@expected_bind,
$test_msg
);
Compares given and expected pairs of C<($sql, \@bind)>, and calls
L<Test::Builder/ok> on the result, with C<$test_msg> as message.
+=head2 is_same_sql
+
+ is_same_sql(
+ $given_sql,
+ $expected_sql,
+ $test_msg
+ );
+
+Compares given and expected SQL statement, and calls L<Test::Builder/ok> on the
+result, with C<$test_msg> as message.
+
+=head2 is_same_bind
+
+ is_same_bind(
+ \@given_bind,
+ \@expected_bind,
+ $test_msg
+ );
+
+Compares given and expected bind value lists, and calls L<Test::Builder/ok> on
+the result, with C<$test_msg> as message.
+
=head2 eq_sql
my $is_same = eq_sql($given_sql, $expected_sql);
Compares two lists of bind values. Returns true IFF their values are the same.
+=head2 eq_sql_bind
+
+ my $is_same = eq_sql_bind(
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind
+ );
+
+Compares the two SQL statements and the two lists of bind values. Returns true
+IFF they are equivalent and the bind values are the same.
+
=head1 SEE ALSO
Copyright 2008 by Norbert Buchmuller.
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself.
projects / dbsrgits/DBIx-Class.git / blobdiff