r43707 - in /trunk/libsql-abstract-perl: Changes META.yml debian/changelog lib/SQL/Abstract.pm lib/SQL/Abstract/Test.pm t/02where.t t/10test.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Sep 4 15:57:11 UTC 2009
Author: jawnsy-guest
Date: Fri Sep 4 15:56:33 2009
New Revision: 43707
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43707
Log:
Integrating new upstream release. Only test changes.
Modified:
trunk/libsql-abstract-perl/Changes
trunk/libsql-abstract-perl/META.yml
trunk/libsql-abstract-perl/debian/changelog
trunk/libsql-abstract-perl/lib/SQL/Abstract.pm
trunk/libsql-abstract-perl/lib/SQL/Abstract/Test.pm
trunk/libsql-abstract-perl/t/02where.t
trunk/libsql-abstract-perl/t/10test.t
Modified: trunk/libsql-abstract-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/Changes?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/Changes (original)
+++ trunk/libsql-abstract-perl/Changes Fri Sep 4 15:56:33 2009
@@ -1,4 +1,9 @@
Revision history for SQL::Abstract
+
+revision 1.58 2009-09-04 15:20 (UTC)
+----------------------------
+ - expanded the scope of -bool and -not_bool operators
+ - added proper testing support
revision 1.57 2009-09-03 20:18 (UTC)
----------------------------
Modified: trunk/libsql-abstract-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/META.yml?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/META.yml (original)
+++ trunk/libsql-abstract-perl/META.yml Fri Sep 4 15:56:33 2009
@@ -29,4 +29,4 @@
perl: 5.6.1
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 1.57
+version: 1.58
Modified: trunk/libsql-abstract-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/debian/changelog?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/debian/changelog (original)
+++ trunk/libsql-abstract-perl/debian/changelog Fri Sep 4 15:56:33 2009
@@ -1,4 +1,6 @@
-libsql-abstract-perl (1.57-1) UNRELEASED; urgency=low
+libsql-abstract-perl (1.58-1) UNRELEASED; urgency=low
+
+ WAITS for advice from ribasushi (upstream author)
[ Jonathan Yu ]
* New upstream release
@@ -13,7 +15,7 @@
perl (>= 5.6.0-{12,16}) with an unversioned dependency on perl (as
permitted by Debian Policy 3.8.3).
- -- Jonathan Yu <jawnsy at cpan.org> Thu, 03 Sep 2009 19:36:15 -0400
+ -- Jonathan Yu <jawnsy at cpan.org> Fri, 04 Sep 2009 07:45:43 -0400
libsql-abstract-perl (1.56-1) unstable; urgency=low
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=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/lib/SQL/Abstract.pm (original)
+++ trunk/libsql-abstract-perl/lib/SQL/Abstract.pm Fri Sep 4 15:56:33 2009
@@ -15,7 +15,7 @@
# GLOBALS
#======================================================================
-our $VERSION = '1.57';
+our $VERSION = '1.58';
# This would confuse some packagers
#$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -553,14 +553,35 @@
sub _where_op_BOOL {
my ($self, $op, $v) = @_;
- my $prefix = ($op =~ /\bnot\b/i) ? 'NOT ' : '';
+ my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
+ ? ( '(NOT ', ')' )
+ : ( '', '' );
$self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ my ( $sql, @bind ) = $self->_where_ARRAYREF($v, '');
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ ARRAYREFREF => sub {
+ my ( $sql, @bind ) = @{ ${$v} };
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ HASHREF => sub {
+ my ( $sql, @bind ) = $self->_where_HASHREF($v);
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
SCALARREF => sub { # literal SQL
- return ($prefix . $$v);
+ return ($prefix . $$v . $suffix);
},
SCALAR => sub { # interpreted as SQL column
- return ($prefix . $self->_convert($self->_quote($v)));
+ return ($prefix . $self->_convert($self->_quote($v)) . $suffix);
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
},
});
}
Modified: trunk/libsql-abstract-perl/lib/SQL/Abstract/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/lib/SQL/Abstract/Test.pm?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/lib/SQL/Abstract/Test.pm (original)
+++ trunk/libsql-abstract-perl/lib/SQL/Abstract/Test.pm Fri Sep 4 15:56:33 2009
@@ -53,6 +53,7 @@
# These are binary operator keywords always a single LHS and RHS
# * AND/OR are handled separately as they are N-ary
+# * so is NOT as being unary
# * BETWEEN without paranthesis around the ANDed arguments (which
# makes it a non-binary op) is detected and accomodated in
# _recurse_parse()
@@ -63,7 +64,7 @@
);
my $tokenizer_re_str = join("\n\t|\n",
- ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR' ),
+ ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR', 'NOT'),
( map { q! (?<= [\w\s\`\'\)] ) ! . $_ . q! (?= [\w\s\`\'\(] ) ! } @binary_op_keywords ),
);
@@ -261,7 +262,7 @@
or
($state == PARSE_IN_EXPR && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords ) )
or
- ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR' ) )
+ ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR', 'NOT' ) )
) {
return $left;
}
@@ -309,6 +310,14 @@
my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
$left = $left ? [@$left, [$op => [$right] ]]
: [[ $op => [$right] ]];
+ }
+ # NOT (last as to allow all other NOT X pieces first)
+ elsif ( $token =~ /^ not $/ix ) {
+ my $op = uc $token;
+ my $right = _recurse_parse ($tokens, PARSE_RHS);
+ $left = $left ? [ @$left, [$op => [$right] ]]
+ : [[ $op => [$right] ]];
+
}
# leaf expression
else {
@@ -353,6 +362,14 @@
# if the parent operator explcitly allows it nuke the parenthesis
elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) {
+ push @children, $child->[1][0];
+ $changes++;
+ }
+
+ # only one EXPR element in the parenthesis
+ elsif (
+ @{$child->[1]} == 1 && $child->[1][0][0] eq 'EXPR'
+ ) {
push @children, $child->[1][0];
$changes++;
}
Modified: trunk/libsql-abstract-perl/t/02where.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/t/02where.t?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/t/02where.t (original)
+++ trunk/libsql-abstract-perl/t/02where.t Fri Sep 4 15:56:33 2009
@@ -255,14 +255,50 @@
{
where => { -and => [-not_bool => 'foo', -not_bool => 'bar'] },
- stmt => " WHERE NOT foo AND NOT bar",
+ stmt => " WHERE (NOT foo) AND (NOT bar)",
bind => [],
},
{
where => { -or => [-not_bool => 'foo', -not_bool => 'bar'] },
- stmt => " WHERE NOT foo OR NOT bar",
- bind => [],
+ stmt => " WHERE (NOT foo) OR (NOT bar)",
+ bind => [],
+ },
+
+ {
+ where => { -bool => \['function(?)', 20] },
+ stmt => " WHERE function(?)",
+ bind => [20],
+ },
+
+ {
+ where => { -not_bool => \['function(?)', 20] },
+ stmt => " WHERE NOT function(?)",
+ bind => [20],
+ },
+
+ {
+ where => { -bool => { a => 1, b => 2} },
+ stmt => " WHERE a = ? AND b = ?",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -bool => [ a => 1, b => 2] },
+ stmt => " WHERE a = ? OR b = ?",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -not_bool => { a => 1, b => 2} },
+ stmt => " WHERE NOT (a = ? AND b = ?)",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -not_bool => [ a => 1, b => 2] },
+ stmt => " WHERE NOT ( a = ? OR b = ? )",
+ bind => [1, 2],
},
);
Modified: trunk/libsql-abstract-perl/t/10test.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsql-abstract-perl/t/10test.t?rev=43707&op=diff
==============================================================================
--- trunk/libsql-abstract-perl/t/10test.t (original)
+++ trunk/libsql-abstract-perl/t/10test.t Fri Sep 4 15:56:33 2009
@@ -133,6 +133,30 @@
q/SELECT foo FROM bar WHERE (a = 1) AND (b = 1 OR c = 1 OR d = 1) AND (e = 1 AND f = 1)/,
q/SELECT foo FROM bar WHERE a = 1 AND (b = 1 OR c = 1 OR d = 1) AND e = 1 AND (f = 1)/,
q/SELECT foo FROM bar WHERE ( ((a = 1) AND ( b = 1 OR (c = 1 OR d = 1) )) AND ((e = 1)) AND f = 1) /,
+ ]
+ },
+ {
+ equal => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE (a) AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (a AND b = 2)/,
+ q/SELECT foo FROM bar WHERE (a AND (b = 2))/,
+ q/SELECT foo FROM bar WHERE a AND (b = 2)/,
+ ]
+ },
+ {
+ equal => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE ((NOT a) AND b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT a) AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT (a)) AND b = 2/,
+ ],
+ },
+ {
+ equal => 0,
+ statements => [
+ q/SELECT foo FROM bar WHERE NOT a AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT a) AND (b = 2)/,
]
},
{
More information about the Pkg-perl-cvs-commits
mailing list