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 2ebccc7..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 ] };
@@ -865,10 +868,10 @@ sub _render_expr {
   my ($self, $expr) = @_;
   my ($k, $v, @rest) = %$expr;
   die "No" if @rest;
-  my %op = map +("-$_" => '_where_op_'.uc($_)),
+  my %op = map +("-$_" => '_render_'.$_),
     qw(op func value bind ident literal);
   if (my $meth = $op{$k}) {
-    return $self->$meth(undef, $v);
+    return $self->$meth($v);
   }
   die "notreached: $k";
 }
@@ -900,19 +903,22 @@ sub _recurse_where {
   }
 }
 
-sub _where_op_IDENT {
-  my ($self, undef, $ident) = @_;
+sub _render_ident {
+  my ($self, $ident) = @_;
 
   return $self->_convert($self->_quote($ident));
 }
 
-sub _where_op_VALUE {
-  my ($self, undef, $value) = @_;
+sub _render_value {
+  my ($self, $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 {
@@ -960,12 +966,11 @@ my %special = (
   }), 'in', 'not in'),
 );
 
-sub _where_op_OP {
-  my ($self, undef, $v) = @_;
+sub _render_op {
+  my ($self, $v) = @_;
   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);
   }
@@ -998,8 +1003,8 @@ sub _where_op_OP {
   die "unhandled";
 }
 
-sub _where_op_FUNC {
-  my ($self, undef, $rest) = @_;
+sub _render_func {
+  my ($self, $rest) = @_;
   my ($func, @args) = @$rest;
   my @arg_sql;
   my @bind = map {
@@ -1010,13 +1015,13 @@ sub _where_op_FUNC {
   return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
 }
 
-sub _where_op_BIND {
-  my ($self, undef, $bind) = @_;
+sub _render_bind {
+  my ($self,  $bind) = @_;
   return ($self->_convert('?'), $self->_bindtype(@$bind));
 }
 
-sub _where_op_LITERAL {
-  my ($self, undef, $literal) = @_;
+sub _render_literal {
+  my ($self, $literal) = @_;
   $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
   return @$literal;
 }
@@ -1059,13 +1064,16 @@ sub _open_outer_paren {
 sub _order_by {
   my ($self, $arg) = @_;
 
-  my (@sql, @bind);
-  for my $c ($self->_order_by_chunks($arg) ) {
-    $self->_SWITCH_refkind($c, {
-      SCALAR => sub { push @sql, $c },
-      ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
-    });
-  }
+  return '' unless defined($arg);
+
+  my @chunks = $self->_order_by_chunks($arg);
+
+  my @sql;
+  my @bind = map {
+    my ($s, @b) = $self->_render_expr($_);
+    push @sql, $s;
+    @b;
+  } @chunks;
 
   my $sql = @sql
     ? sprintf('%s %s',
@@ -1081,57 +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);
-      [ $s, @b ];
-    },
-
-    SCALAR    => sub {$self->_quote($arg)},
-
-    UNDEF     => sub {return () },
-
-    SCALARREF => sub {$$arg}, # literal SQL, no quoting
-
-    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);
+    return () unless $key;
 
-        $self->_SWITCH_refkind($c, {
-          SCALAR => sub {
-            $sql = $c;
-          },
-          ARRAYREF => sub {
-            ($sql, @bind) = @$c;
-          },
-        });
+    if (@rest or not $key =~ /^-(desc|asc)/i) {
+      puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+    }
 
-        $sql = $sql . ' ' . $self->_sqlcase($direction);
+    my $dir = $1;
 
-        push @ret, [ $sql, @bind];
-      }
-
-      return @ret;
-    },
-  });
+    map +{ -op => [ $dir, $_ ] }, $self->_order_by_chunks($val);
+  };
 }