From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 26 Dec 2013 08:23:06 +0000 (+0100)
Subject: Reintroduce handling of IS( NOT) ops
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b9b5a0b15e324b820975e789abdacb0e4285f4b9;p=scpubgit%2FQ-Branch.git

Reintroduce handling of IS( NOT) ops

This is undocumented syntax, but it is very likely someone is using it in
the wild, and the previous inequality op handler rewrite broke this
---

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 6e6bd5a..78ff2b3 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -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' },
 );
 
 #======================================================================
@@ -758,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;
 
@@ -831,7 +835,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) = @_;
diff --git a/t/01generate.t b/t/01generate.t
index e81e3d4..833b2e3 100644
--- a/t/01generate.t
+++ b/t/01generate.t
@@ -583,6 +583,19 @@ my @tests = (
       },
 );
 
+# check is( not) => undef
+for my $op (qw( is is_not), 'is not' ) {
+  (my $sop = uc $op) =~ s/_/ /gi;
+
+  push @tests, {
+    func => 'where',
+    args => [{ a => { "$_$op" => undef } }],
+    stmt => "WHERE a $sop NULL",
+    stmt_q => "WHERE `a` $sop NULL",
+    bind => [],
+  } for ('', '-');  # with and without -
+}
+
 # check single-element inequality ops for no warnings
 for my $op ( qw(!= <>) ) {
   for my $val (undef, 42) {