[Bast-commits] r5373 - in DBIx-Class/0.08: branches/stopgap/t/lib
branches/stopgap/t/lib/DBIC trunk/t/lib/DBIC
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Thu Jan 29 18:45:46 GMT 2009
Author: ribasushi
Date: 2009-01-29 18:45:46 +0000 (Thu, 29 Jan 2009)
New Revision: 5373
Added:
DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/
DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/DebugObj.pm
DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/SqlMakerTest.pm
Modified:
DBIx-Class/0.08/trunk/t/lib/DBIC/DebugObj.pm
Log:
Add the sqla test harness to the stopgap branch
Added: DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/DebugObj.pm
===================================================================
--- DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/DebugObj.pm (rev 0)
+++ DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/DebugObj.pm 2009-01-29 18:45:46 UTC (rev 5373)
@@ -0,0 +1,50 @@
+package DBIC::DebugObj;
+
+use strict;
+use warnings;
+
+use Class::C3;
+
+use base qw/DBIx::Class::Storage::Statistics Exporter Class::Accessor::Fast/;
+
+__PACKAGE__->mk_accessors( qw/dbictest_sql_ref dbictest_bind_ref/ );
+
+
+=head2 new(PKG, SQL_REF, BIND_REF, ...)
+
+Creates a new instance that on subsequent queries will store
+the generated SQL to the scalar pointed to by SQL_REF and bind
+values to the array pointed to by BIND_REF.
+
+=cut
+
+sub new {
+ my $pkg = shift;
+ my $sql_ref = shift;
+ my $bind_ref = shift;
+
+ my $self = $pkg->SUPER::new(@_);
+
+ $self->debugfh(undef);
+
+ $self->dbictest_sql_ref($sql_ref);
+ $self->dbictest_bind_ref($bind_ref || []);
+
+ return $self;
+}
+
+sub query_start {
+ my $self = shift;
+
+ (${$self->dbictest_sql_ref}, @{$self->dbictest_bind_ref}) = @_;
+}
+
+sub query_end { }
+
+sub txn_start { }
+
+sub txn_commit { }
+
+sub txn_rollback { }
+
+1;
Added: DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/SqlMakerTest.pm
===================================================================
--- DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/SqlMakerTest.pm (rev 0)
+++ DBIx-Class/0.08/branches/stopgap/t/lib/DBIC/SqlMakerTest.pm 2009-01-29 18:45:46 UTC (rev 5373)
@@ -0,0 +1,160 @@
+package DBIC::SqlMakerTest;
+
+use strict;
+use warnings;
+
+use base qw/Test::Builder::Module Exporter/;
+
+our @EXPORT = qw/
+ &is_same_sql_bind
+ &eq_sql
+ &eq_bind
+/;
+
+
+{
+ package 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;
+ use Test::Builder;
+ use Test::Deep qw(eq_deeply);
+
+ 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);
+
+ if (!$same_sql) {
+ $tb->diag("SQL expressions differ\n"
+ . " got: $sql1\n"
+ . "expected: $sql2\n"
+ );
+ }
+ if (!$same_bind) {
+ $tb->diag("BIND values differ\n"
+ . " got: " . Dumper($bind_ref1)
+ . "expected: " . Dumper($bind_ref2)
+ );
+ }
+ }
+
+ sub eq_sql
+ {
+ my ($left, $right) = @_;
+
+ $left =~ s/\s+//g;
+ $right =~ s/\s+//g;
+
+ return $left eq $right;
+ }
+
+ sub eq_bind
+ {
+ my ($bind_ref1, $bind_ref2) = @_;
+
+ return eq_deeply($bind_ref1, $bind_ref2);
+ }
+}
+
+eval "use SQL::Abstract::Test;";
+if ($@ eq '') {
+ # SQL::Abstract::Test available
+
+ *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
+
+ *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;
+}
+
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use DBIC::SqlMakerTest;
+
+ my ($sql, @bind) = $schema->storage->sql_maker->select(%args);
+ is_same_sql_bind(
+ $sql, \@bind,
+ $expected_sql, \@expected_bind,
+ 'foo bar works'
+ );
+
+=head1 DESCRIPTION
+
+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.
+
+
+=head1 FUNCTIONS
+
+=head2 is_same_sql_bind
+
+ 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 eq_sql
+
+ my $is_same = eq_sql($given_sql, $expected_sql);
+
+Compares the two SQL statements. Returns true IFF they are equivalent.
+
+=head2 eq_bind
+
+ my $is_same = eq_sql(\@given_bind, \@expected_bind);
+
+Compares two lists of bind values. Returns true IFF their values are the same.
+
+
+=head1 SEE ALSO
+
+L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>.
+
+=head1 AUTHOR
+
+Norbert Buchmuller, <norbi at nix.hu>
+
+=head1 COPYRIGHT AND LICENSE
+
+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.
Modified: DBIx-Class/0.08/trunk/t/lib/DBIC/DebugObj.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBIC/DebugObj.pm 2009-01-29 15:47:33 UTC (rev 5372)
+++ DBIx-Class/0.08/trunk/t/lib/DBIC/DebugObj.pm 2009-01-29 18:45:46 UTC (rev 5373)
@@ -28,7 +28,7 @@
$self->debugfh(undef);
$self->dbictest_sql_ref($sql_ref);
- $self->dbictest_bind_ref($bind_ref);
+ $self->dbictest_bind_ref($bind_ref || []);
return $self;
}
More information about the Bast-commits
mailing list