add default for ident vs. value

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 5389c92..d4c8c04 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -528,7 +528,8 @@ sub where {
 }
 
 sub _expand_expr {
-  my ($self, $expr, $logic) = @_;
+  my ($self, $expr, $logic, $default_scalar_to) = @_;
+  local our $Default_Scalar_To = $default_scalar_to if $default_scalar_to;
   return undef unless defined($expr);
   if (ref($expr) eq 'HASH') {
     if (keys %$expr > 1) {
@@ -572,6 +573,9 @@ sub _expand_expr {
     return +{ -literal => $literal };
   }
   if (!ref($expr) or Scalar::Util::blessed($expr)) {
+    if (my $d = $Default_Scalar_To) {
+      return +{ $d => $expr };
+    }
     if (my $m = our $Cur_Col_Meta) {
       return +{ -bind => [ $m, $expr ] };
     }
@@ -628,8 +632,7 @@ sub _expand_expr_hashpair {
     
       # top level special ops are illegal in general
       puke "Illegal use of top-level '-$op'"
-        if !(defined $self->{_nested_func_lhs})
-        and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
+        if List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
     }
     if ($k eq '-value' and my $m = our $Cur_Col_Meta) {
       return +{ -bind => [ $m, $v ] };
@@ -912,7 +915,10 @@ sub _render_value {
   return ($self->_convert('?'), $self->_bindtype(undef, $value));
 }
 
-my %unop_postfix = map +($_ => 1), 'is null', 'is not null';
+my %unop_postfix = map +($_ => 1),
+  'is null', 'is not null',
+  'asc', 'desc',
+;
 
 my %special = (
   (map +($_ => do {
@@ -965,7 +971,6 @@ sub _render_op {
   my ($op, @args) = @$v;
   $op =~ s/^-// if length($op) > 1;
   $op = lc($op);
-  local $self->{_nested_func_lhs};
   if (my $h = $special{$op}) {
     return $self->$h(\@args);
   }
@@ -1059,6 +1064,8 @@ sub _open_outer_paren {
 sub _order_by {
   my ($self, $arg) = @_;
 
+  return '' unless defined($arg);
+
   my @chunks = $self->_order_by_chunks($arg);
 
   my @sql;
@@ -1082,48 +1089,28 @@ sub _order_by {
 sub _order_by_chunks {
   my ($self, $arg) = @_;
 
-  return $self->_SWITCH_refkind($arg, {
-
-    ARRAYREF => sub {
-      map { $self->_order_by_chunks($_ ) } @$arg;
-    },
-
-    ARRAYREFREF => sub {
-      my ($s, @b) = @$$arg;
-      $self->_assert_bindval_matches_bindtype(@b);
-      +{ -literal => [ $s, @b ] };
-    },
-
-    SCALAR    => sub { +{ -ident => $arg } },
-
-    UNDEF     => sub {return () },
-
-    SCALARREF => sub { +{ -literal => [ $$arg ] } },
-
-    HASHREF   => sub {
-      # get first pair in hash
-      my ($key, $val, @rest) = %$arg;
-
-      return () unless $key;
-
-      if (@rest or not $key =~ /^-(desc|asc)/i) {
-        puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
-      }
-
-      my $direction = $1;
+  if (ref($arg) eq 'ARRAY') {
+    return map $self->_order_by_chunks($_), @$arg;
+  }
+  if (my $l = is_literal_value($arg)) {
+    return +{ -literal => $l };
+  }
+  if (!ref($arg)) {
+    return +{ -ident => $arg };
+  }
+  if (ref($arg) eq 'HASH') {
+    my ($key, $val, @rest) = %$arg;
 
-      my @ret;
-      for my $c ($self->_order_by_chunks($val)) {
-        my ($sql, @bind) = $self->_render_expr($c);
+    return () unless $key;
 
-        $sql = $sql . ' ' . $self->_sqlcase($direction);
+    if (@rest or not $key =~ /^-(desc|asc)/i) {
+      puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+    }
 
-        push @ret, { -literal => [ $sql, @bind ] };
-      }
+    my $dir = $1;
 
-      return @ret;
-    },
-  });
+    map +{ -op => [ $dir, $_ ] }, $self->_order_by_chunks($val);
+  };
 }