X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=0bcc7d5f76429243d5a441c57e0376deeb33d74d;hb=4c120a34df5e6fb6e2a8f1668d9ea4df2bd8639a;hp=6dabd39fe2c029dc01fa29bd2bf48fa06d547bfa;hpb=46dc2f3e47d514cd376003cea2df63222c492b0b;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 6dabd39..0bcc7d5 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -10,7 +10,7 @@ use Scalar::Util (); # GLOBALS #====================================================================== -our $VERSION = '1.74'; +our $VERSION = '1.77'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -24,6 +24,7 @@ my @BUILTIN_SPECIAL_OPS = ( {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'}, {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'}, {regex => qr/^ value $/ix, handler => '_where_op_VALUE'}, + {regex => qr/^ is (?: \s+ not )? $/ix, handler => '_where_field_IS'}, ); # unaryish operators - key maps to handler @@ -34,7 +35,7 @@ my @BUILTIN_UNARY_OPS = ( { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' }, { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' }, { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' }, - { regex => qr/^ value $/ix, handler => '_where_op_VALUE' }, + { regex => qr/^ value $/xi, handler => '_where_op_VALUE' }, ); #====================================================================== @@ -80,9 +81,12 @@ sub new { $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'; @@ -755,6 +759,9 @@ sub _where_hashpair_HASHREF { $self->_assert_pass_injection_guard($op); + # fixup is_not + $op =~ s/^is_not/IS NOT/i; + # so that -not_foo works correctly $op =~ s/^not_/NOT /i; @@ -797,9 +804,14 @@ sub _where_hashpair_HASHREF { }, 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 =~ /^not$/i ? 'is not' # legacy + : $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"); }, @@ -824,7 +836,22 @@ sub _where_hashpair_HASHREF { return ($all_sql, @all_bind); } +sub _where_field_IS { + my ($self, $k, $op, $v) = @_; + + my ($s) = $self->_SWITCH_refkind($v, { + UNDEF => sub { + join ' ', + $self->_convert($self->_quote($k)), + map { $self->_sqlcase($_)} ($op, 'null') + }, + FALLBACK => sub { + puke "$op can only take undef as argument"; + }, + }); + $s; +} sub _where_field_op_ARRAYREF { my ($self, $k, $op, $vals) = @_; @@ -844,27 +871,35 @@ sub _where_field_op_ARRAYREF { 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')"; } }