r36908 - in /trunk/libsql-abstract-perl: ./ debian/ inc/Module/ inc/Module/Install/ lib/SQL/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun May 31 10:24:46 UTC 2009
Author: ansgar-guest
Date: Sun May 31 10:24:40 2009
New Revision: 36908
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=36908
Log:
* New upstream release.
* Bump debhelper build-dep to 7.2.13 since this package uses
Module::Install.
* Use tiny debian/rules.
Modified:
trunk/libsql-abstract-perl/Changes
trunk/libsql-abstract-perl/META.yml
trunk/libsql-abstract-perl/debian/changelog
trunk/libsql-abstract-perl/debian/control
trunk/libsql-abstract-perl/debian/rules
trunk/libsql-abstract-perl/inc/Module/Install.pm
trunk/libsql-abstract-perl/inc/Module/Install/Base.pm
trunk/libsql-abstract-perl/inc/Module/Install/Can.pm
trunk/libsql-abstract-perl/inc/Module/Install/Fetch.pm
trunk/libsql-abstract-perl/inc/Module/Install/Makefile.pm
trunk/libsql-abstract-perl/inc/Module/Install/Metadata.pm
trunk/libsql-abstract-perl/inc/Module/Install/Win32.pm
trunk/libsql-abstract-perl/inc/Module/Install/WriteAll.pm
trunk/libsql-abstract-perl/lib/SQL/Abstract.pm
trunk/libsql-abstract-perl/t/06order_by.t
Modified: trunk/libsql-abstract-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/Changes?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/Changes (original)
+++ trunk/libsql-abstract-perl/Changes Sun May 31 10:24:40 2009
@@ -1,4 +1,9 @@
Revision history for SQL::Abstract
+
+revision 1.56 2009-05-30 16:31 (UTC)
+----------------------------
+ - support for \[$sql, @bind] in order_by clauses e.g.:
+ { -desc => \['colA LIKE ?', 'somestring'] }
revision 1.55 2009-05-17 22:54 (UTC)
----------------------------
Modified: trunk/libsql-abstract-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/META.yml?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/META.yml (original)
+++ trunk/libsql-abstract-perl/META.yml Sun May 31 10:24:40 2009
@@ -13,7 +13,7 @@
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.88'
+generated_by: 'Module::Install version 0.90'
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -29,4 +29,4 @@
perl: 5.6.1
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 1.55
+version: 1.56
Modified: trunk/libsql-abstract-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/debian/changelog?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/debian/changelog (original)
+++ trunk/libsql-abstract-perl/debian/changelog Sun May 31 10:24:40 2009
@@ -1,3 +1,12 @@
+libsql-abstract-perl (1.56-1) unstable; urgency=low
+
+ * New upstream release.
+ * Bump debhelper build-dep to 7.2.13 since this package uses
+ Module::Install.
+ * Use tiny debian/rules.
+
+ -- Ansgar Burchardt <ansgar at 43-1.org> Sun, 31 May 2009 12:24:08 +0200
+
libsql-abstract-perl (1.55-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libsql-abstract-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/debian/control?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/debian/control (original)
+++ trunk/libsql-abstract-perl/debian/control Sun May 31 10:24:40 2009
@@ -4,7 +4,7 @@
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Krzysztof Krzyżaniak (eloy) <eloy at debian.org>,
gregor herrmann <gregoa at debian.org>, Ansgar Burchardt <ansgar at 43-1.org>
-Build-Depends: debhelper (>= 7)
+Build-Depends: debhelper (>= 7.2.13)
Build-Depends-Indep: perl (>= 5.6.0-16), libtest-deep-perl,
libtest-exception-perl, libtest-warn-perl, libclone-perl (>=0.31)
Standards-Version: 3.8.1
Modified: trunk/libsql-abstract-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/debian/rules?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/debian/rules (original)
+++ trunk/libsql-abstract-perl/debian/rules Sun May 31 10:24:40 2009
@@ -1,23 +1,3 @@
#!/usr/bin/make -f
-
-build: build-stamp
-build-stamp:
- dh build
- touch $@
-
-clean:
+%:
dh $@
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
Modified: trunk/libsql-abstract-perl/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install.pm Sun May 31 10:24:40 2009
@@ -28,7 +28,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.88';
+ $VERSION = '0.90';
# Storage for the pseudo-singleton
$MAIN = undef;
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Base.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Base.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Base.pm Sun May 31 10:24:40 2009
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.90';
}
# Suspend handler for "redefined" warnings
@@ -13,42 +13,34 @@
$SIG{__WARN__} = sub { $w };
}
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 45
+#line 42
sub new {
- my ($class, %args) = @_;
-
- foreach my $method ( qw(call load) ) {
- next if defined &{"$class\::$method"};
- *{"$class\::$method"} = sub {
- shift()->_top->$method(@_);
- };
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
}
-
- bless( \%args, $class );
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
}
-#line 66
+#line 61
sub AUTOLOAD {
- my $self = shift;
local $@;
- my $autoload = eval {
- $self->_top->autoload
- } or return;
- goto &$autoload;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
}
-#line 83
+#line 75
sub _top {
$_[0]->{_top};
}
-#line 98
+#line 90
sub admin {
$_[0]->_top->{admin}
@@ -56,7 +48,7 @@
Module::Install::Base::FakeAdmin->new;
}
-#line 114
+#line 106
sub is_admin {
$_[0]->admin->VERSION;
@@ -83,4 +75,4 @@
1;
-#line 162
+#line 154
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Can.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Can.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Can.pm Sun May 31 10:24:40 2009
@@ -2,16 +2,16 @@
package Module::Install::Can;
use strict;
-use Module::Install::Base;
-use Config ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.90';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
# check if we can load some module
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Fetch.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Fetch.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Fetch.pm Sun May 31 10:24:40 2009
@@ -2,13 +2,13 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.90';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub get_file {
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Makefile.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Makefile.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Makefile.pm Sun May 31 10:24:40 2009
@@ -2,14 +2,14 @@
package Module::Install::Makefile;
use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION $ISCORE @ISA};
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.90';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Metadata.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Metadata.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Metadata.pm Sun May 31 10:24:40 2009
@@ -2,18 +2,17 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '0.90';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
- mymeta
};
my @scalar_keys = qw{
@@ -440,21 +439,21 @@
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
+ 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s{\s+}{\\s+}g;
@@ -516,7 +515,8 @@
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
- $v = $v + 0; # Numify
+ # Numify
+ $v = $v + 0;
}
return $v;
}
@@ -526,21 +526,56 @@
######################################################################
-# MYMETA.yml Support
+# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
-sub write_mymeta {
- my $self = shift;
-
- # If there's no existing META.yml there is nothing we can do
- return unless -f 'META.yml';
+sub write_mymeta_yaml {
+ my $self = shift;
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
}
# Merge the perl version into the dependencies
@@ -558,7 +593,7 @@
}
# Load the advisory META.yml file
- my @yaml = YAML::Tiny::LoadFile('META.yml');
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
@@ -572,9 +607,7 @@
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+ return $meta;
}
1;
Modified: trunk/libsql-abstract-perl/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/Win32.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/Win32.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/Win32.pm Sun May 31 10:24:40 2009
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '0.90';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libsql-abstract-perl/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/inc/Module/Install/WriteAll.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/inc/Module/Install/WriteAll.pm (original)
+++ trunk/libsql-abstract-perl/inc/Module/Install/WriteAll.pm Sun May 31 10:24:40 2009
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.90';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -41,8 +41,18 @@
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
- $self->Meta->write if $args{meta};
- $self->Meta->write_mymeta if $self->mymeta;
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
return 1;
}
Modified: trunk/libsql-abstract-perl/lib/SQL/Abstract.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/lib/SQL/Abstract.pm?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/lib/SQL/Abstract.pm (original)
+++ trunk/libsql-abstract-perl/lib/SQL/Abstract.pm Sun May 31 10:24:40 2009
@@ -15,7 +15,7 @@
# GLOBALS
#======================================================================
-our $VERSION = '1.55';
+our $VERSION = '1.56';
# This would confuse some packagers
#$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -813,48 +813,76 @@
sub _order_by {
my ($self, $arg) = @_;
- # construct list of ordering instructions
- my @order = $self->_SWITCH_refkind($arg, {
+ my (@sql, @bind);
+ for my $c ($self->_order_by_chunks ($arg) ) {
+ $self->_SWITCH_refkind ($c, {
+ SCALAR => sub { push @sql, $c },
+ ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
+ });
+ }
+
+ my $sql = @sql
+ ? sprintf ('%s %s',
+ $self->_sqlcase(' order by'),
+ join (', ', @sql)
+ )
+ : ''
+ ;
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+sub _order_by_chunks {
+ my ($self, $arg) = @_;
+
+ return $self->_SWITCH_refkind($arg, {
ARRAYREF => sub {
- map {$self->_SWITCH_refkind($_, {
- SCALAR => sub {$self->_quote($_)},
- UNDEF => sub {},
- SCALARREF => sub {$$_}, # literal SQL, no quoting
- HASHREF => sub {$self->_order_by_hash($_)}
- }) } @$arg;
+ map { $self->_order_by_chunks ($_ ) } @$arg;
},
+ ARRAYREFREF => sub { [ @$$arg ] },
+
SCALAR => sub {$self->_quote($arg)},
- UNDEF => sub {},
+
+ UNDEF => sub {return () },
+
SCALARREF => sub {$$arg}, # literal SQL, no quoting
- HASHREF => sub {$self->_order_by_hash($arg)},
-
+
+ HASHREF => sub {
+ # get first pair in hash
+ my ($key, $val) = each %$arg;
+
+ return () unless $key;
+
+ if ( (keys %$arg) > 1 or not $key =~ /^-(desc|asc)/i ) {
+ puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+ }
+
+ my $direction = $1;
+
+ my @ret;
+ for my $c ($self->_order_by_chunks ($val)) {
+ my ($sql, @bind);
+
+ $self->_SWITCH_refkind ($c, {
+ SCALAR => sub {
+ $sql = $c;
+ },
+ ARRAYREF => sub {
+ ($sql, @bind) = @$c;
+ },
+ });
+
+ $sql = $sql . ' ' . $self->_sqlcase($direction);
+
+ push @ret, [ $sql, @bind];
+ }
+
+ return @ret;
+ },
});
-
- # build SQL
- my $order = join ', ', @order;
- return $order ? $self->_sqlcase(' order by')." $order" : '';
-}
-
-
-sub _order_by_hash {
- my ($self, $hash) = @_;
-
- # get first pair in hash
- my ($key, $val) = each %$hash;
-
- # check if one pair was found and no other pair in hash
- $key && !(each %$hash)
- or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
-
- my ($order) = ($key =~ /^-(desc|asc)/i)
- or puke "invalid key in _order_by hash : $key";
-
- $val = ref $val eq 'ARRAY' ? $val : [$val];
- return join ', ', map { $self->_quote($_) . ' ' . $self->_sqlcase($order) } @$val;
-}
-
+}
#======================================================================
Modified: trunk/libsql-abstract-perl/t/06order_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/t/06order_by.t?rev=36908&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/t/06order_by.t (original)
+++ trunk/libsql-abstract-perl/t/06order_by.t Sun May 31 10:24:40 2009
@@ -86,6 +86,24 @@
expects => ' ORDER BY colA ASC, colB DESC, colC ASC, colD ASC',
expects_quoted => ' ORDER BY `colA` ASC, `colB` DESC, `colC` ASC, `colD` ASC',
},
+ {
+ given => { -desc => \['colA LIKE ?', 'test'] },
+ expects => ' ORDER BY colA LIKE ? DESC',
+ expects_quoted => ' ORDER BY colA LIKE ? DESC',
+ bind => ['test'],
+ },
+ {
+ given => \['colA LIKE ? DESC', 'test'],
+ expects => ' ORDER BY colA LIKE ? DESC',
+ expects_quoted => ' ORDER BY colA LIKE ? DESC',
+ bind => ['test'],
+ },
+ {
+ given => [ { -asc => \['colA'] }, { -desc => \['colB LIKE ?', 'test'] }, { -asc => \['colC LIKE ?', 'tost'] }],
+ expects => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+ expects_quoted => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+ bind => [qw/test tost/],
+ },
);
@@ -94,9 +112,24 @@
my $sql = SQL::Abstract->new;
my $sqlq = SQL::Abstract->new({quote_char => '`'});
-for my $case( @cases){
- is($sql->_order_by($case->{given}), $case->{expects});
- is($sqlq->_order_by($case->{given}), $case->{expects_quoted});
+for my $case( @cases) {
+ my ($stat, @bind);
+
+ ($stat, @bind) = $sql->_order_by($case->{given});
+ is_same_sql_bind (
+ $stat,
+ \@bind,
+ $case->{expects},
+ $case->{bind} || [],
+ );
+
+ ($stat, @bind) = $sqlq->_order_by($case->{given});
+ is_same_sql_bind (
+ $stat,
+ \@bind,
+ $case->{expects_quoted},
+ $case->{bind} || [],
+ );
}
throws_ok (
More information about the Pkg-perl-cvs-commits
mailing list