set values in update via expand/render

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 6666ace..71021e3 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -224,12 +224,12 @@ sub _returning {
 
   my $f = $options->{returning};
 
-  my $fieldlist = $self->_SWITCH_refkind($f, {
-    ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$f;},
-    SCALAR       => sub {$self->_quote($f)},
-    SCALARREF    => sub {$$f},
-  });
-  return $self->_sqlcase(' returning ') . $fieldlist;
+  my ($sql, @bind) = $self->_render_expr(
+    $self->_expand_maybe_list_expr($f, undef, -ident)
+  );
+  return wantarray
+    ? $self->_sqlcase(' returning ') . $sql
+    : ($self->_sqlcase(' returning ').$sql, @bind);
 }
 
 sub _insert_HASHREF { # explicit list of fields and then values
@@ -295,50 +295,33 @@ sub _insert_values {
 sub _insert_value {
   my ($self, $column, $v) = @_;
 
-  my (@values, @all_bind);
-  $self->_SWITCH_refkind($v, {
-
-    ARRAYREF => sub {
-      if ($self->{array_datatypes}) { # if array datatype are activated
-        push @values, '?';
-        push @all_bind, $self->_bindtype($column, $v);
-      }
-      else {                  # else literal SQL with bind
-        my ($sql, @bind) = @$v;
-        $self->_assert_bindval_matches_bindtype(@bind);
-        push @values, $sql;
-        push @all_bind, @bind;
-      }
-    },
-
-    ARRAYREFREF => sub {        # literal SQL with bind
-      my ($sql, @bind) = @${$v};
-      $self->_assert_bindval_matches_bindtype(@bind);
-      push @values, $sql;
-      push @all_bind, @bind;
-    },
-
-    # THINK: anything useful to do with a HASHREF ?
-    HASHREF => sub {       # (nothing, but old SQLA passed it through)
-      #TODO in SQLA >= 2.0 it will die instead
-      belch "HASH ref as bind value in insert is not supported";
-      push @values, '?';
-      push @all_bind, $self->_bindtype($column, $v);
-    },
-
-    SCALARREF => sub {          # literal SQL without bind
-      push @values, $$v;
-    },
-
-    SCALAR_or_UNDEF => sub {
-      push @values, '?';
-      push @all_bind, $self->_bindtype($column, $v);
-    },
+  return $self->_render_expr(
+    $self->_expand_insert_value($column, $v)
+  );
+}
 
-  });
+sub _expand_insert_value {
+  my ($self, $column, $v) = @_;
 
-  my $sql = join(", ", @values);
-  return ($sql, @all_bind);
+  if (ref($v) eq 'ARRAY') {
+    if ($self->{array_datatypes}) {
+      return +{ -bind => [ $column, $v ] };
+    }
+    my ($sql, @bind) = @$v;
+    $self->_assert_bindval_matches_bindtype(@bind);
+    return +{ -literal => $v };
+  }
+  if (ref($v) eq 'HASH') {
+    if (grep !/^-/, keys %$v) {
+      belch "HASH ref as bind value in insert is not supported";
+      return +{ -bind => [ $column, $v ] };
+    }
+  }
+  if (!defined($v)) {
+    return +{ -bind => [ $column, undef ] };
+  }
+  local our $Cur_Col_Meta = $column;
+  return $self->_expand_expr($v);
 }
 
 
@@ -381,59 +364,32 @@ sub update {
 sub _update_set_values {
   my ($self, $data) = @_;
 
-  my (@set, @all_bind);
-  for my $k (sort keys %$data) {
-    my $v = $data->{$k};
-    my $r = ref $v;
-    my $label = $self->_quote($k);
-
-    $self->_SWITCH_refkind($v, {
-      ARRAYREF => sub {
-        if ($self->{array_datatypes}) { # array datatype
-          push @set, "$label = ?";
-          push @all_bind, $self->_bindtype($k, $v);
-        }
-        else {                          # literal SQL with bind
-          my ($sql, @bind) = @$v;
-          $self->_assert_bindval_matches_bindtype(@bind);
-          push @set, "$label = $sql";
-          push @all_bind, @bind;
-        }
-      },
-      ARRAYREFREF => sub { # literal SQL with bind
-        my ($sql, @bind) = @${$v};
-        $self->_assert_bindval_matches_bindtype(@bind);
-        push @set, "$label = $sql";
-        push @all_bind, @bind;
-      },
-      SCALARREF => sub {  # literal SQL without bind
-        push @set, "$label = $$v";
-      },
-      HASHREF => sub {
-        my ($op, $arg, @rest) = %$v;
-
-        puke 'Operator calls in update must be in the form { -op => $arg }'
-          if (@rest or not $op =~ /^\-(.+)/);
-
-        local our $Cur_Col_Meta = $k;
-        my ($sql, @bind) = $self->_render_expr(
-          $self->_expand_expr_hashpair($op, $arg)
-        );
-
-        push @set, "$label = $sql";
-        push @all_bind, @bind;
-      },
-      SCALAR_or_UNDEF => sub {
-        push @set, "$label = ?";
-        push @all_bind, $self->_bindtype($k, $v);
-      },
-    });
-  }
-
-  # generate sql
-  my $sql = join ', ', @set;
+  return $self->_render_expr(
+    $self->_expand_update_set_values($data),
+  );
+}
 
-  return ($sql, @all_bind);
+sub _expand_update_set_values {
+  my ($self, $data) = @_;
+  $self->_expand_maybe_list_expr( [
+    map {
+      my ($k, $set) = @$_;
+      +{ -op => [ '=', { -ident => $k }, $set ] };
+    }
+    map {
+      my $k = $_;
+      my $v = $data->{$k};
+      (ref($v) eq 'ARRAY'
+        ? ($self->{array_datatypes}
+            ? [ $k, +{ -bind => [ $k, $v ] } ]
+            : [ $k, +{ -literal => $v } ])
+        : do {
+            local our $Cur_Col_Meta = $k;
+            [ $k, $self->_expand_expr($v) ]
+          }
+      );
+    } sort keys %$data
+  ] );
 }
 
 # So that subclasses can override UPDATE ... RETURNING separately from
@@ -468,8 +424,9 @@ sub select {
 
 sub _select_fields {
   my ($self, $fields) = @_;
-  return ref $fields eq 'ARRAY' ? join ', ', map { $self->_quote($_) } @$fields
-                                : $fields;
+  return $self->_render_expr(
+    $self->_expand_maybe_list_expr($fields, undef, '-ident')
+  );
 }
 
 #======================================================================
@@ -1112,11 +1069,17 @@ sub _table  {
 
 sub _expand_maybe_list_expr {
   my ($self, $expr, $logic, $default) = @_;
-  return ref($expr) eq 'ARRAY'
-    ? { -op => [
+  my $e = do {
+    if (ref($expr) eq 'ARRAY') {
+      return { -op => [
         ',', map $self->_expand_expr($_, $logic, $default), @$expr
-      ] }
-    : $self->_expand_expr($expr, $logic, $default);
+      ] } if @$expr > 1;
+      $expr->[0]
+    } else {
+      $expr
+    }
+  };
+  return $self->_expand_expr($e, $logic, $default);
 }
 
 # highly optimized, as it's called way too often