Cleanup regexes / reduce captures a bit

[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract / Converter.pm

diff --git a/lib/SQL/Abstract/Converter.pm b/lib/SQL/Abstract/Converter.pm
index 5e6f0cb..c4c8295 100644 (file)
--- a/lib/SQL/Abstract/Converter.pm
+++ b/lib/SQL/Abstract/Converter.pm
@@ -162,7 +162,7 @@ sub _mutation_rhs_to_dq {
     my ($op, $arg, @rest) = %$v;
 
     die 'Operator calls in update/insert must be in the form { -op => $arg }'
-      if (@rest or not $op =~ /^\-(.+)/);
+      if (@rest or not $op =~ /^\-/);
   }
   return $self->_expr_to_dq($v);
 }
@@ -268,6 +268,18 @@ sub _where_to_dq {
   return $self->_expr_to_dq($where, $logic);
 }
 
+my %op_conversions = (
+  '==' => '=',
+  'eq' => '=',
+  'ne' => '!=',
+  '!' => 'NOT',
+  'gt' => '>',
+  'ge' => '>=',
+  'lt' => '<',
+  'le' => '<=',
+  'defined' => 'IS NOT NULL',
+);
+
 sub _expr_to_dq {
   my ($self, $where, $logic) = @_;
 
@@ -281,7 +293,20 @@ sub _expr_to_dq {
   ) {
     return $self->_literal_to_dq($$where);
   } elsif (ref($where) eq 'REF' and ref($$where) eq 'HASH') {
-    return $$where;
+    return map_dq_tree {
+      if (
+        is_Operator
+        and not $_->{operator}{'SQL.Naive'}
+        and my $op = $_->{operator}{'Perl'}
+      ) {
+        my $sql_op = $op_conversions{$op} || uc($op);
+        return +{
+          %{$_},
+          operator => { 'SQL.Naive' => $sql_op }
+        };
+      }
+      return $_;
+    } $$where;
   } elsif (!ref($where) or Scalar::Util::blessed($where)) {
     return $self->_value_to_dq($where);
   }
@@ -440,7 +465,7 @@ sub _where_hashpair_to_dq {
         }
         my ($op, $value) = %$v;
         s/^-//, s/_/ /g for $op;
-        if ($op =~ /^(and|or)$/i) {
+        if ($op =~ /^(?:and|or)$/i) {
           return $self->_expr_to_dq({ $k => $value }, $op);
         } elsif (
           my $special_op = List::Util::first {$op =~ $_->{regex}}
@@ -448,7 +473,7 @@ sub _where_hashpair_to_dq {
         ) {
           return $self->_literal_to_dq(
             [ $special_op->{handler}->($k, $op, $value) ]
-          );;
+          );
         } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
           die "Use of [and|or|nest]_N modifiers is no longer supported";
         }
@@ -458,25 +483,45 @@ sub _where_hashpair_to_dq {
       }
     };
     if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
+      die "Argument passed to the '$op' operator can not be undefined" unless defined $rhs;
+      $rhs = [$rhs] unless ref $rhs;
       if (ref($rhs) ne 'ARRAY') {
-        if ($op =~ /IN$/) {
+        if ($op =~ /^(?:NOT )?IN$/) {
           # have to add parens if none present because -in => \"SELECT ..."
           # got documented. mst hates everything.
           if (ref($rhs) eq 'SCALAR') {
             my $x = $$rhs;
             1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
             $rhs = \$x;
-          } else {
-            my ($x, @rest) = @{$$rhs};
-            1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
-            $rhs = \[ $x, @rest ];
+          } elsif (ref($rhs) eq 'REF') {
+            if (ref($$rhs) eq 'ARRAY') {
+              my ($x, @rest) = @{$$rhs};
+              1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
+              $rhs = \[ $x, @rest ];
+            } elsif (ref($$rhs) eq 'HASH') {
+              return $self->_op_to_dq($op, $self->_ident_to_dq($k), $$rhs);
+            }
           }
         }
         return $self->_op_to_dq(
           $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
         );
       }
-      return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
+      if (grep !defined, @$rhs) {
+        my ($inop, $logic, $nullop) = $op =~ /^NOT/
+          ? (-not_in => AND => { '!=' => undef })
+          : (-in => OR => undef);
+        if (my @defined = grep defined, @$rhs) {
+          return $self->_expr_to_dq_ARRAYREF([
+            { $k => { $inop => \@defined } },
+            { $k => $nullop },
+          ], $logic);
+        }
+        return $self->_expr_to_dq_HASHREF({ $k => $nullop });
+      }
+      return $self->_literal_to_dq(
+        $op =~ /^NOT/ ? $self->{sqltrue} : $self->{sqlfalse}
+      ) unless @$rhs;
       return $self->_op_to_dq(
         $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
       )
@@ -492,9 +537,9 @@ sub _where_hashpair_to_dq {
       );
     } elsif (!defined($rhs)) {
       my $null_op = do {
-        if ($op eq '=' or $op eq 'LIKE') {
+        if ($op eq '=' or $op eq 'LIKE' or $op eq 'IS') {
           'IS NULL'
-        } elsif ($op eq '!=') {
+        } elsif ($op eq '!=' or $op eq 'NOT LIKE' or $op eq 'IS NOT') {
           'IS NOT NULL'
         } else {
           die "Can't do undef -> NULL transform for operator ${op}";
@@ -532,7 +577,7 @@ sub _order_by_to_dq {
   my $dq = Order(
     undef,
     (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
-    (defined($nulls) ? ($nulls =~ /first/i ? 1 : -1) : undef),
+    $nulls,
     ($from ? ($from) : undef),
   );
 
@@ -590,7 +635,7 @@ sub _order_by_to_dq {
         $val = $arg->{$key};
       } elsif ($key =~ /^-nulls$/i)  {
         $nulls = $arg->{$key};
-        die "invalid value for -nulls" unless $nulls =~ /^(?:first|last)$/i;
+        die "invalid value for -nulls" unless $nulls =~ /^(?:first|last|none)$/i;
       } else {
         die "invalid key ${key} in hash passed to _order_by_to_dq";
       }