on undef-containing lists fed to -in and -not_in. An exception will
be raised for a while before properly fixing this, to avoid quiet
but subtle changes to query results in production
+ - Deprecate and warn when supplying an empty arrayref to like/not_like
+ operators (likely to be removed before 2.0)
+ - Warn when using an inequality operator with a multi-value array to
+ arrive at what amounts to a 1=1 condition (no pre-2.0 plans to fix
+ this behavior due to backwards comp concerns)
- Fix false negative comparison of ORDER BY <function> ASC
- More improvements of incorrect parsing (literal at end of list elt)
- Fix typos in POD and comments (RT#87776)
$opt{cmp} ||= '=';
# try to recognize which are the 'equality' and 'inequality' ops
- # (temporary quickfix, should go through a more seasoned API)
- $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
- $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
+ # (temporary quickfix (in 2007), should go through a more seasoned API)
+ $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
+ $opt{inequality_op} = qr/^( != | <> )$/ix;
+
+ $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
+ $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
# SQL booleans
$opt{sqltrue} ||= '1=1';
},
UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
- my $is = ($op =~ $self->{equality_op}) ? 'is' :
- ($op =~ $self->{inequality_op}) ? 'is not' :
- puke "unexpected operator '$orig_op' with undef operand";
+ my $is =
+ $op =~ $self->{equality_op} ? 'is'
+ : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
+ : $op =~ $self->{inequality_op} ? 'is not'
+ : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
+ : puke "unexpected operator '$orig_op' with undef operand";
+
$sql = $self->_quote($k) . $self->_sqlcase(" $is null");
},
shift @vals;
}
+ # a long standing API wart - an attempt to change this behavior during
+ # the 1.50 series failed *spectacularly*. Warn instead and leave the
+ # behavior as is
+ if (
+ @vals > 1
+ and
+ (!$logic or $logic eq 'OR')
+ and
+ ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
+ ) {
+ my $o = uc($op);
+ belch "A multi-element arrayref as an argument to the inequality op '$o' "
+ . 'is technically equivalent to an always-true 1=1 (you probably wanted '
+ . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
+ ;
+ }
+
# distribute $op over each remaining member of @vals, append logic if exists
return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
- # LDNOTE : had planned to change the distribution logic when
- # $op =~ $self->{inequality_op}, because of Morgan laws :
- # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
- # WHERE field != 22 OR field != 33 : the user probably means
- # WHERE field != 22 AND field != 33.
- # To do this, replace the above to roughly :
- # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
- # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
-
}
else {
# try to DWIM on equality operators
- # LDNOTE : not 100% sure this is the correct thing to do ...
- return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
- return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
-
- # otherwise
- puke "operator '$op' applied on an empty array (field '$k')";
+ return
+ $op =~ $self->{equality_op} ? $self->{sqlfalse}
+ : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
+ : $op =~ $self->{inequality_op} ? $self->{sqltrue}
+ : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
+ : puke "operator '$op' applied on an empty array (field '$k')";
}
}
use strict;
use warnings;
use Test::More;
+use Test::Warn;
use SQL::Abstract::Test import => ['is_same_sql'];
use SQL::Abstract;
{ a => [qw/b c d/],
e => { '!=', [qw(f g)] },
q => { 'not in', [14..20] } } ],
+ warns => qr/\QA multi-element arrayref as an argument to the inequality op '!=' is technically equivalent to an always-true 1=1/,
},
);
for (@handle_tests) {
my $sqla = SQL::Abstract->new($_->{args});
- my($stmt) = $sqla->select(
- 'test',
- '*',
- $_->{where} || { a => 4, b => 0}
- );
+ my $stmt;
+ warnings_exist {
+ $stmt = $sqla->select(
+ 'test',
+ '*',
+ $_->{where} || { a => 4, b => 0}
+ );
+ } $_->{warns} || [];
is_same_sql($stmt, $_->{stmt});
}
use Test::Warn;
use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test import => [qw( is_same_sql_bind diag_where dumper )];
use SQL::Abstract;
tasty => { '!=', [qw(yes YES)] },
-nest => [ face => [ -or => {'=', 'mr.happy'}, {'=', undef} ] ] },
],
+ warns => qr/\QA multi-element arrayref as an argument to the inequality op '!=' is technically equivalent to an always-true 1=1/,
+
stmt => 'UPDATE taco_punches SET one = ?, three = ? WHERE ( ( ( ( ( face = ? ) OR ( face IS NULL ) ) ) )'
. ' AND ( ( bland != ? ) AND ( bland != ? ) ) AND ( ( tasty != ? ) OR ( tasty != ? ) ) )',
stmt_q => 'UPDATE `taco_punches` SET `one` = ?, `three` = ? WHERE ( ( ( ( ( `face` = ? ) OR ( `face` IS NULL ) ) ) )'
},
);
+# check single-element inequality ops for no warnings
+for my $op ( qw(!= <>) ) {
+ for my $val (undef, 42) {
+ push @tests, {
+ func => 'where',
+ args => [ { x => { "$_$op" => [ $val ] } } ],
+ stmt => "WHERE x " . ($val ? "$op ?" : 'IS NOT NULL'),
+ stmt_q => "WHERE `x` " . ($val ? "$op ?" : 'IS NOT NULL'),
+ bind => [ $val || () ],
+ } for ('', '-'); # with and without -
+ }
+}
+
+# check single-element not-like ops for no warnings, and NULL exception
+# (the last two "is not X" are a weird syntax, but mebbe a dialect...)
+for my $op (qw(not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') {
+ (my $sop = uc $op) =~ s/_/ /gi;
+
+ for my $val (undef, 42) {
+ push @tests, {
+ func => 'where',
+ args => [ { x => { "$_$op" => [ $val ] } } ],
+ $val ? (
+ stmt => "WHERE x $sop ?",
+ stmt_q => "WHERE `x` $sop ?",
+ bind => [ $val ],
+ ) : (
+ stmt => "WHERE x IS NOT NULL",
+ stmt_q => "WHERE `x` IS NOT NULL",
+ bind => [],
+ warns => qr/\QSupplying an undefined argument to '$sop' is deprecated/,
+ ),
+ } for ('', '-'); # with and without -
+ }
+}
+
+# check all multi-element inequality/not-like ops for warnings
+for my $op ( qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') {
+ (my $sop = uc $op) =~ s/_/ /gi;
+
+ push @tests, {
+ func => 'where',
+ args => [ { x => { "$_$op" => [ 42, 69 ] } } ],
+ stmt => "WHERE x $sop ? OR x $sop ?",
+ stmt_q => "WHERE `x` $sop ? OR `x` $sop ?",
+ bind => [ 42, 69 ],
+ warns => qr/\QA multi-element arrayref as an argument to the inequality op '$sop' is technically equivalent to an always-true 1=1/,
+ } for ('', '-'); # with and without -
+}
+
+# check all like/not-like ops for empty-arrayref warnings
+for my $op ( qw(like rlike not_like not_rlike), 'not like', 'not rlike', 'is like', 'is not like', 'is rlike', 'is not rlike') {
+ (my $sop = uc $op) =~ s/_/ /gi;
+
+ push @tests, {
+ func => 'where',
+ args => [ { x => { "$_$op" => [] } } ],
+ stmt => ( $sop =~ /NOT/ ? "WHERE 1=1" : "WHERE 0=1" ),
+ stmt_q => ( $sop =~ /NOT/ ? "WHERE 1=1" : "WHERE 0=1" ),
+ bind => [],
+ warns => qr/\QSupplying an empty arrayref to '$sop' is deprecated/,
+ } for ('', '-'); # with and without -
+}
+
for my $t (@tests) {
my $new = $t->{new} || {};
throws_ok(
sub { $cref->() },
$e,
- );
+ ) || diag dumper ({ args => $t->{args}, result => $stmt });
}
else {
warnings_exist(
use strict;
use warnings;
use Test::More;
+use Test::Warn;
use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where) ];
use SQL::Abstract;
order => \'requestor, ticket',
stmt => " WHERE ( ( priority BETWEEN ? AND ? ) AND requestor IS NULL ) ORDER BY requestor, ticket",
bind => [qw/1 3/],
+ warns => qr/Supplying an undefined argument to 'LIKE' is deprecated/,
},
},
stmt => " WHERE ( ( ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) ) AND ( ( fum LIKE ? ) OR ( fum LIKE ? ) ) AND ( nix BETWEEN ? AND ? ) AND ( nox NOT BETWEEN ? AND ? ) AND wix IN ( ?, ? ) AND wux NOT IN ( ?, ? ) )",
bind => [7,8,9,'a','b',100,200,150,160,'zz','yy','30','40'],
+ warns => qr/\QA multi-element arrayref as an argument to the inequality op 'NOT LIKE' is technically equivalent to an always-true 1=1/,
},
{
for my $case (@handle_tests) {
my $sql = SQL::Abstract->new;
- my ($stmt, @bind) = $sql->where($case->{where}, $case->{order});
+ my ($stmt, @bind);
+ warnings_exist {
+ ($stmt, @bind) = $sql->where($case->{where}, $case->{order});
+ } $case->{warns} || [];
+
is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
|| diag_where ( $case->{where} );
}
projects / dbsrgits/SQL-Abstract.git / commitdiff