r28570 - in /branches/upstream/libsql-abstract-limit-perl/current: ./ lib/SQL/Abstract/ t/ t/lib/ t/lib/SQL/ t/lib/SQL/Abstract/ t/lib/SQL/Abstract/Limit/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Tue Dec 23 14:24:55 UTC 2008
Author: eloy
Date: Tue Dec 23 14:24:52 2008
New Revision: 28570
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28570
Log:
[svn-upgrade] Integrating new upstream version, libsql-abstract-limit-perl (0.14)
Added:
branches/upstream/libsql-abstract-limit-perl/current/t/lib/
branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/
branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/
branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/
branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/Test.pm
Modified:
branches/upstream/libsql-abstract-limit-perl/current/Build.PL
branches/upstream/libsql-abstract-limit-perl/current/Changes
branches/upstream/libsql-abstract-limit-perl/current/MANIFEST
branches/upstream/libsql-abstract-limit-perl/current/META.yml
branches/upstream/libsql-abstract-limit-perl/current/Makefile.PL
branches/upstream/libsql-abstract-limit-perl/current/lib/SQL/Abstract/Limit.pm
branches/upstream/libsql-abstract-limit-perl/current/t/01.sql.t
branches/upstream/libsql-abstract-limit-perl/current/t/02.syntax.t
Modified: branches/upstream/libsql-abstract-limit-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/Build.PL?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/Build.PL (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/Build.PL Tue Dec 23 14:24:52 2008
@@ -9,6 +9,11 @@
dist_version_from => 'lib/SQL/Abstract/Limit.pm',
requires => { 'Test::More' => 0,
'Test::Exception' => 0,
+ 'Test::Builder' => 0,
+ 'Test::Deep' => 0,
+ 'SQL::Abstract' => '1.2',
+ 'Scalar::Util' => 0,
+ 'Data::Dumper' => 0,
'DBI' => 0, # for DBI::Const::GetInfoType
'SQL::Abstract' => 1.2,
},
Modified: branches/upstream/libsql-abstract-limit-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/Changes?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/Changes (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/Changes Tue Dec 23 14:24:52 2008
@@ -4,8 +4,15 @@
** indicates API changes
+0.14 22nd December 2008, 14:48
+ - added support for Informix, provided by Paul Falbe.
+
+0.13 21st December 2008, 23:20
+ - updated test suite to play with the latest release of SQL::Abstract.
+ Patches supplied by the SQL::Abstract dev team.
+
0.12 19th December 2005, 23:20
- - removed hidden dependency on Class::DBI ?the test suite.
+ - removed hidden dependency on Class::DBI in the test suite.
0.11 11th October 2005, 12:40
- re-arranged order of tests in _find_syntax() to avoid the eval
Modified: branches/upstream/libsql-abstract-limit-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/MANIFEST?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/MANIFEST (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/MANIFEST Tue Dec 23 14:24:52 2008
@@ -13,3 +13,4 @@
t/test_data.csv
t/pod-coverage.t
t/pod.t
+t/lib/SQL/Abstract/Limit/Test.pm
Modified: branches/upstream/libsql-abstract-limit-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/META.yml?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/META.yml (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/META.yml Tue Dec 23 14:24:52 2008
@@ -1,8 +1,18 @@
---- #YAML:1.0
-name: SQL-Abstract-Limit
-version: 0.12
-author:
- - David Baird <cpan at riverside-cms.co.uk>
-abstract: portable LIMIT emulation
-license: perl
-generated_by: Module::Build version 0.2611, without YAML.pm
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: SQL-Abstract-Limit
+version: 0.14
+version_from: lib/SQL/Abstract/Limit.pm
+installdirs: site
+requires:
+ Data::Dumper: 0
+ DBI: 0
+ Scalar::Util: 0
+ SQL::Abstract: 1.2
+ Test::Builder: 0
+ Test::Deep: 0
+ Test::Exception: 0
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: branches/upstream/libsql-abstract-limit-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/Makefile.PL?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/Makefile.PL (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/Makefile.PL Tue Dec 23 14:24:52 2008
@@ -2,15 +2,19 @@
use ExtUtils::MakeMaker;
WriteMakefile
(
- 'PL_FILES' => {},
- 'INSTALLDIRS' => 'site',
'NAME' => 'SQL::Abstract::Limit',
'VERSION_FROM' => 'lib/SQL/Abstract/Limit.pm',
'PREREQ_PM' => {
- 'Test::More' => 0,
+ 'DBI' => '0',
+ 'Data::Dumper' => '0',
'SQL::Abstract' => '1.2',
- 'Test::Exception' => 0,
- 'DBI' => 0
- }
+ 'Scalar::Util' => '0',
+ 'Test::Builder' => '0',
+ 'Test::Deep' => '0',
+ 'Test::Exception' => '0',
+ 'Test::More' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'PL_FILES' => {}
)
;
Modified: branches/upstream/libsql-abstract-limit-perl/current/lib/SQL/Abstract/Limit.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/lib/SQL/Abstract/Limit.pm?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/lib/SQL/Abstract/Limit.pm (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/lib/SQL/Abstract/Limit.pm Tue Dec 23 14:24:52 2008
@@ -15,7 +15,7 @@
=cut
-our $VERSION = '0.12';
+our $VERSION = '0.14';
# additions / error reports welcome !
our %SyntaxMap = ( mssql => 'Top',
@@ -25,7 +25,7 @@
db2 => 'FetchFirst',
ingres => '',
adabasd => '',
- informix => 'First',
+ informix => 'Skip',
# asany => '',
@@ -110,7 +110,7 @@
Top SQL/Server, MS Access
RowNum Oracle
FetchFirst DB2
- First Informix # not implemented yet
+ Skip Informix
GenericSubQ Sybase, plus any databases not recognised by this module
$dbh a DBI database handle
@@ -953,6 +953,9 @@
=end notes
+
+=notes
+
=item First
=over 8
@@ -968,7 +971,6 @@
=back
-=cut
sub _First {
my ( $self, $sql, $order, $rows, $offset ) = @_;
@@ -979,6 +981,43 @@
# might need to add to regex in 'where' method
}
+
+=end notes
+
+=cut
+
+=item Skip
+
+=over 8
+
+=item Syntax
+
+ select skip 5 limit 5 * from customer
+
+which will take rows 6 through 10 in the select.
+
+=item Databases
+
+Informix
+
+=back
+
+=cut
+
+sub _Skip {
+ my ( $self, $sql, $order, $rows, $offset ) = @_;
+
+ my $last = $rows + $offset;
+
+ my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
+
+ $sql =~ s/^\s*(SELECT|select)//;
+
+ $sql = "select skip $offset limit $rows ".$sql." ".$self->_order_by( $order );
+
+ return $sql;
+}
+
1;
@@ -1060,6 +1099,8 @@
Thanks to Aaron Johnson for the Top syntax model (SQL/Server and MS Access).
Thanks to Emanuele Zeppieri for the IBM DB2 syntax model.
+
+Thanks to Paul Falbe for the Informix implementation.
=head1 TODO
Modified: branches/upstream/libsql-abstract-limit-perl/current/t/01.sql.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/t/01.sql.t?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/t/01.sql.t (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/t/01.sql.t Tue Dec 23 14:24:52 2008
@@ -3,8 +3,13 @@
use strict;
use warnings;
-use Test::More tests => 22;
+use Test::More tests => 17;
use Test::Exception;
+
+use lib qw(t/lib);
+
+# dynamically load SQL::Abstract::Test;
+eval "use SQL::Abstract::Limit::Test; 1" or die $@;
=for notes
@@ -44,71 +49,101 @@
my $base_sql = 'requestor, worker, colC, colH FROM TheTable WHERE ( requestor = ? AND status != ? AND ( ( worker = ? ) OR ( worker = ? ) OR ( worker = ? ) ) )';
+my @expected_bind = qw/inna completed nwiger rcwe sfz/;
+
my $sql_ab = SQL::Abstract::Limit->new( limit_dialect => 'LimitOffset' );
my ( $stmt, @bind );
# LimitOffset
lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset) } 'select LimitOffset';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
-like( $stmt, qr~^\QSELECT $base_sql ORDER BY pay, age LIMIT $limit OFFSET $offset\E$~, 'complete SQL' );
+
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT $base_sql ORDER BY pay, age LIMIT $limit OFFSET $offset", \@expected_bind,
+ 'LimitOffset SQL',
+);
# LimitXY
lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'LimitXY' ) } 'select LimitXY';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
-like( $stmt, qr~^\QSELECT $base_sql ORDER BY pay, age LIMIT $offset, $limit\E$~, 'complete SQL' );
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT $base_sql ORDER BY pay, age LIMIT $offset, $limit", \@expected_bind,
+ 'LimitXY SQL',
+);
# RowsTo
-lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'RowsTo' ) } 'select LimitXY';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
-like( $stmt, qr~^\QSELECT $base_sql ORDER BY pay, age ROWS $offset TO $last\E$~, 'complete SQL' );
+lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'RowsTo' ) } 'select RowsTo';
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT $base_sql ORDER BY pay, age ROWS $offset TO $last", \@expected_bind,
+ 'RowsTo SQL',
+);
-
-### TODO - regexes to match full query ###
# Top
lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'Top' ) } 'select Top';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
-TODO: {
- local $TODO = 'need regex for complex query';
- like( $stmt, qr~^\Qcomplete SQL\E$~, 'complete SQL' );
-}
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT * FROM ("
+ . "SELECT TOP $limit * FROM ("
+ . "SELECT TOP $last $base_sql ORDER BY pay ASC, age ASC"
+ . ") AS foo ORDER BY pay DESC, age DESC"
+ .") AS bar ORDER BY pay ASC, age ASC", \@expected_bind,
+ 'Top SQL',
+);
+
+
# RowNum
lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'RowNum' ) } 'select RowNum';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
-TODO: {
- local $TODO = 'need regex for complex query';
- like( $stmt, qr~^\Qcomplete SQL\E$~, 'complete SQL' );
-}
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT * FROM ("
+ . "SELECT A.*, ROWNUM r FROM ("
+ . "SELECT $base_sql ORDER BY pay, age"
+ . ") A WHERE ROWNUM < @{[$last + 1]}"
+ .") B WHERE r >= @{[$offset + 1]}", \@expected_bind,
+ 'RowNum SQL',
+);
+
+
# GenericSubQ
lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'GenericSubQ' ) } 'select GenericSubQ';
-my $gen_q_base_sql = $base_sql;
-$gen_q_base_sql =~ s/TheTable/TheTable X/;
-like( $stmt, qr~\Q$gen_q_base_sql\E~, 'GenericSubQ SQL' );
+(my $gen_q_base_sql = $base_sql) =~ s/TheTable/TheTable X/;
-TODO: {
- local $TODO = 'need regex for complex query';
- like( $stmt, qr~^\Qcomplete SQL\E$~, 'complete SQL' );
-}
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT $gen_q_base_sql AND"
+ . "(SELECT COUNT(*) FROM TheTable WHERE requestor > X.requestor)"
+ . " BETWEEN $offset AND $last ORDER BY requestor DESC", \@expected_bind,
+ 'GenericSubQ SQL',
+);
+
# FetchFirst
-lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'FetchFirst' ) } 'select GenericSubQ';
-like( $stmt, qr~\Q$base_sql\E~, 'base SQL' );
+lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'FetchFirst' ) } 'select FetchFirst';
-TODO: {
- local $TODO = 'need regex for complex query';
- like( $stmt, qr~^\Qcomplete SQL\E$~, 'complete SQL' );
-}
+is_same_sql_bind(
+ $stmt, \@bind,
+ "SELECT * FROM ("
+ . "SELECT * FROM ("
+ . "SELECT $base_sql ORDER BY pay ASC, age ASC FETCH FIRST $last ROWS ONLY"
+ . ") foo ORDER BY pay DESC, age DESC FETCH FIRST $limit ROWS ONLY"
+ . ") bar ORDER BY pay ASC, age ASC", \@expected_bind,
+ 'FetchFirst SQL',
+);
+
+# Skip
+lives_ok { ( $stmt, @bind ) = $sql_ab->select( $table, $fields, $where, $order, $limit, $offset, 'Skip' ) } 'select Skip';
+
+is_same_sql_bind(
+ $stmt, \@bind,
+ "select skip $offset limit $limit $base_sql ORDER BY pay, age", \@expected_bind,
+ 'Skip SQL',
+);
-
-
-#warn "\n\n" . $stmt;
-#warn join( ', ', @bind ) . "\n\n";
-#
-#
-warn " *** not yet testing subquery LIMIT emulations\n";
Modified: branches/upstream/libsql-abstract-limit-perl/current/t/02.syntax.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/t/02.syntax.t?rev=28570&op=diff
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/t/02.syntax.t (original)
+++ branches/upstream/libsql-abstract-limit-perl/current/t/02.syntax.t Tue Dec 23 14:24:52 2008
@@ -24,7 +24,7 @@
Top SQL/Server, MS Access
RowNum Oracle
FetchFirst DB2 # not implemented yet
- First Informix # not implemented yet
+ Skip Informix
GenericSubQ Sybase, plus any databases not recognised by this module
$dbh a DBI database handle
Added: branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/Test.pm?rev=28570&op=file
==============================================================================
--- branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/Test.pm (added)
+++ branches/upstream/libsql-abstract-limit-perl/current/t/lib/SQL/Abstract/Limit/Test.pm Tue Dec 23 14:24:52 2008
@@ -1,0 +1,164 @@
+package SQL::Abstract::Limit::Test;
+
+# Lifted from DBIx::Class, originally was DBIC::SqlMakerTest.
+
+use strict;
+use warnings;
+
+use base qw/Test::Builder::Module Exporter/;
+
+use 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
+
+SQL::Abstract::Limit::Test - Helper package for testing generated SQL and bind values
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use SQL::Abstract::Limit::Test;
+
+ 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.
More information about the Pkg-perl-cvs-commits
mailing list