add Perl operator conversion support

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

diff --git a/lib/SQL/Abstract/Converter.pm b/lib/SQL/Abstract/Converter.pm
index d2a3741..d3cce0a 100644 (file)
--- a/lib/SQL/Abstract/Converter.pm
+++ b/lib/SQL/Abstract/Converter.pm
@@ -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);
   }
@@ -466,10 +491,14 @@ sub _where_hashpair_to_dq {
             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(
@@ -532,7 +561,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),
   );
 
@@ -554,6 +583,8 @@ sub _order_by_to_dq {
     return $outer;
   } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
     $dq->{by} = $self->_literal_to_dq($$arg);
+  } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'HASH') {
+    $dq->{by} = $$arg;
   } elsif (ref($arg) eq 'SCALAR') {
 
     # < mst> right, but if it doesn't match that, it goes "ok, right, not sure, 
@@ -566,7 +597,11 @@ sub _order_by_to_dq {
     #        dbihacks crack combined with old literal order_by crack
     # < ribasushi> heh :)
 
-    if (my ($ident, $dir) = $$arg =~ /^(\w+)(?:\s+(desc|asc))?$/i) {
+    # this should take into account our quote char and name sep
+
+    my $match_ident = '\w+(?:\.\w+)*';
+
+    if (my ($ident, $dir) = $$arg =~ /^(${match_ident})(?:\s+(desc|asc))?$/i) {
       $dq->{by} = $self->_ident_to_dq($ident);
       $dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
     } else {
@@ -584,9 +619,9 @@ 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 in hash passed to _order_by_to_dq";
+        die "invalid key ${key} in hash passed to _order_by_to_dq";
       }
     }