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