refactor DELETE and add UPDATE

[dbsrgits/Data-Query.git] / lib / Data / Query / Renderer / SQL / Naive.pm

diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm
index c20e610..a3e681c 100644 (file)
--- a/lib/Data/Query/Renderer/SQL/Naive.pm
+++ b/lib/Data/Query/Renderer/SQL/Naive.pm
@@ -1,9 +1,12 @@
 package Data::Query::Renderer::SQL::Naive;
 
 use strictures 1;
+
+sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i }
+
 use SQL::ReservedWords;
 use Data::Query::Constants qw(
-  DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS DQ_ORDER
+  DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS DQ_ORDER DQ_LITERAL
 );
 
 sub new {
@@ -61,12 +64,16 @@ sub _flatten_structure {
   ];
 }
 
-# I present this to permit strange people to easily supply a patch to lc()
+# I presented this to permit strange people to easily supply a patch to lc()
 # their keywords, as I have heard many desire to do, lest they infect me
 # with whatever malady caused this desire by their continued proximity for
 # want of such a feature.
+#
+# Then I realised that SQL::Abstract compatibility work required it.
+#
+# FEH.
 
-sub _format_keyword { $_[1] }
+sub _format_keyword { $_[0]->{lc_keywords} ? lc($_[1]) : $_[1] }
 
 sub _render {
   $_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
@@ -120,8 +127,14 @@ sub _render_operator {
   } elsif (my $meth = $self->can("_handle_op_special_${op_name}")) {
     return $self->$meth($dq);
   }
-  #die "Couldn't render operator ".$op->{$self->_operator_type};
-  $self->_handle_op_type_binop($op_name, $dq);
+  if (my $argc = @{$dq->{args}}) {
+    if ($argc == 1) {
+      return $self->_handle_op_type_unop($op_name, $dq);
+    } elsif ($argc == 2) {
+      return $self->_handle_op_type_binop($op_name, $dq);
+    }
+  }
+  die "Unsure how to handle ${op_name}";
 }
 
 sub _handle_op_type_binop {
@@ -197,8 +210,16 @@ sub _handle_op_type_in {
 
 sub _handle_op_type_between {
   my ($self, $op_name, $dq) = @_;
-  my ($lhs, $rhs1, $rhs2) = (map $self->_render($_), @{$dq->{args}});
-  [ $lhs, $op_name, $rhs1, 'AND', $rhs2 ];
+  my @args = @{$dq->{args}};
+  if (@args == 3) {
+    my ($lhs, $rhs1, $rhs2) = (map $self->_render($_), @args);
+    [ '(', $lhs, $op_name, $rhs1, 'AND', $rhs2, ')' ];
+  } elsif (@args == 2 and $args[1]->{type} eq DQ_LITERAL) {
+    my ($lhs, $rhs) = (map $self->_render($_), @args);
+    [ '(', $lhs, $op_name, $rhs, ')' ];
+  } else {
+    die "Invalid args for between: ${\scalar @args} given";
+  }
 }
 
 sub _handle_op_type_apply {
@@ -206,7 +227,14 @@ sub _handle_op_type_apply {
   my ($func, @args) = @{$dq->{args}};
   die "Function name must be identifier"
     unless $func->{type} eq DQ_IDENTIFIER;
-  my $ident = $self->_render($func)->[0];
+  my $ident = do {
+    # The problem we have here is that built-ins can't be quoted, generally.
+    # I rather wonder if things like MAX(...) need to -not- be handled as
+    # an apply and instead of something else, maybe a parenop type - but
+    # as an explicitly Naive renderer this seems like a reasonable answer.
+    local @{$self}{qw(reserved_ident_parts always_quote)};
+    $self->_render_identifier($func)->[0];
+  };
   [
     "$ident(",
     (map $self->_render($_), @args),
@@ -281,9 +309,15 @@ sub _render_literal {
   unless ($dq->{subtype} eq 'SQL') {
     die "Can't render non-SQL literal";
   }
-  return [
-    $dq->{literal}, @{$dq->{values}||[]}
-  ];
+  if ($dq->{literal}) {
+    return [
+      $dq->{literal}, @{$dq->{values}||[]}
+    ];
+  } elsif ($dq->{parts}) {
+    return [ map $self->_render($_), @{$dq->{parts}} ];
+  } else {
+    die "Invalid SQL literal - neither 'literal' nor 'parts' found";
+  }
 }
 
 sub _render_join {
@@ -325,4 +359,31 @@ sub _render_order {
   \@ret;
 }
 
+sub _render_delete {
+  my ($self, $dq) = @_;
+  my ($target, $where) = @{$dq}{qw(target where)};
+  [ $self->_format_keyword('DELETE FROM'), 
+    $self->_render($target),
+    ($where
+      ? ($self->_format_keyword('WHERE'), $self->_render($where))
+      : ())
+  ];
+}
+
+sub _render_update {
+  my ($self, $dq) = @_;
+  my ($target, $set, $where) = @{$dq}{qw(target set where)};
+  my @rendered_set = intersperse(
+    ',', map [ intersperse('=', map $self->_render($_), @$_) ], @{$set}
+  );
+  [ $self->_format_keyword('UPDATE'),
+    $self->_render($target),
+    $self->_format_keyword('SET'),
+    @rendered_set,
+    ($where
+      ? ($self->_format_keyword('WHERE'), $self->_render($where))
+      : ())
+  ];
+}
+
 1;