negation expansion

[scpubgit/Q-Branch.git] / lib / SQL / Abstract.pm

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 03b5a93..9364128 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -552,21 +552,35 @@ sub _expand_expr {
 
 sub _expand_expr_hashpair {
   my ($self, $k, $v, $logic) = @_;
-  if (!ref($v)) {
-    if ($k !~ /^-/) {
+  if ($k =~ /^-/) {
+    if ($k eq '-nest') {
+      return $self->_expand_expr($v);
+    }
+    if (my ($rest) = $k =~/^-not[_ ](.*)$/) {
+      return $self->_expand_expr({ -not => { "-${rest}", $v } }, $logic);
+    }
+  } else {
+    if (!ref($v)) {
       return +{ $k => { $self->{cmp} => $v } };
     }
-  }
-  if ($k eq '-nest') {
-    return $self->_expand_expr($v);
-  }
-  if ($k !~ /^-/ and my $literal = is_literal_value($v)) {
-    unless (length $k) {
-      belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
-      return \$literal;
+    if (ref($v) eq 'ARRAY') {
+      return $self->{sqlfalse} unless @$v;
+      $self->_debug("ARRAY($k) means distribute over elements");
+      my $this_logic = (
+        $v->[0] =~ /^-((?:and|or))$/i
+          ? ($v = [ @{$v}[1..$#$v] ], $1)
+          : ($self->{logic} || 'or')
+      );
+      return +{ "-${this_logic}" => [ map $self->_expand_expr({ $k => $_ }, $this_logic), @$v ] };
+    }
+    if (my $literal = is_literal_value($v)) {
+      unless (length $k) {
+        belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
+        return \$literal;
+      }
+      my ($sql, @bind) = @$literal;
+      return \[ $self->_quote($k).' '.$sql, @bind ];
     }
-    my ($sql, @bind) = @$literal;
-    return \[ $self->_quote($k).' '.$sql, @bind ];
   }
   return { $k => $v };
 }