ORDER BY never generates ASC

[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 6cfce82..42ee8b4 100644 (file)
--- a/lib/Data/Query/Renderer/SQL/Naive.pm
+++ b/lib/Data/Query/Renderer/SQL/Naive.pm
@@ -7,6 +7,7 @@ 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_LITERAL
+  DQ_GROUP DQ_SELECT DQ_SLICE
 );
 
 use Moo;
@@ -27,6 +28,8 @@ has lc_keywords => (is => 'ro', default => sub { 0 });
 
 has always_quote => (is => 'ro', default => sub { 0 });
 
+has collapse_aliases => (is => 'ro', default => sub { 1 });
+
 sub _default_simple_ops {
   +{
     (map +($_ => 'binop'), qw(= > < >= <= != LIKE), 'NOT LIKE' ),
@@ -284,7 +287,7 @@ sub _render_select {
     ($dq->{from}
        ? ($self->_format_keyword('FROM'), @{$self->_render($dq->{from})})
        : ()
-    )
+    ),
   ];
 }
 
@@ -292,15 +295,20 @@ sub _render_alias {
   my ($self, $dq, $as) = @_;
   # FROM foo foo -> FROM foo
   # FROM foo.bar bar -> FROM foo.bar
-  if ($dq->{alias}{type} eq DQ_IDENTIFIER) {
-    if ($dq->{alias}{elements}[-1] eq $dq->{as}) {
-      return $self->_render($dq->{alias});
+  if ($self->collapse_aliases) {
+    if ($dq->{from}{type} eq DQ_IDENTIFIER) {
+      if ($dq->{from}{elements}[-1] eq $dq->{to}) {
+        return $self->_render($dq->{from});
+      }
     }
   }
-  return [
-    $self->_render($dq->{alias}),
+  my %parenthesise = map +($_ => 1), DQ_SELECT, DQ_SLICE;
+  return [ # XXX not sure this is the right place to detect this
+    ($parenthesise{$dq->{from}{type}}
+      ? [ '(', $self->_render($dq->{from}), ')' ]
+      : $self->_render($dq->{from})),
     $as || ' ',
-    $self->_render_identifier({ elements => [ $dq->{as} ] })
+    $self->_render_identifier({ elements => [ $dq->{to} ] })
   ];
 }
 
@@ -309,7 +317,7 @@ sub _render_literal {
   unless ($dq->{subtype} eq 'SQL') {
     die "Can't render non-SQL literal";
   }
-  if ($dq->{literal}) {
+  if (defined($dq->{literal})) {
     return [
       $dq->{literal}, @{$dq->{values}||[]}
     ];
@@ -322,18 +330,33 @@ sub _render_literal {
 
 sub _render_join {
   my ($self, $dq) = @_;
-  my ($left, $right) = @{$dq->{join}};
-  die "No support for ON yet" if $dq->{on};
-  die "No support for LEFT/RIGHT yet" if $dq->{outer};
-  [ $self->_render($left), ',', $self->_render($right) ];
+  my ($left, $right) = @{$dq}{qw(left right)};
+  my $join = do {
+    if ($dq->{outer}) {
+      $self->_format_keyword(uc($dq->{outer}).' JOIN');
+    } elsif ($dq->{on}) {
+      $self->_format_keyword('JOIN');
+    } else {
+      ','
+    }
+  };
+  my $rhs = $self->_render($right);
+  [
+    $self->_render($left), $join,
+    ($right->{type} eq DQ_JOIN ? ('(', $rhs, ')') : $rhs),
+    ($dq->{on}
+      ? ($self->_format_keyword('ON'), $self->_render($dq->{on}))
+      : ())
+  ];
 }
 
 sub _render_where {
   my ($self, $dq) = @_;
   my ($from, $where) = @{$dq}{qw(from where)};
+  my $keyword = ($from && $from->{type} eq DQ_GROUP) ? 'HAVING' : 'WHERE';
   [
     ($from ? $self->_render($from) : ()),
-    $self->_format_keyword('WHERE'),
+    $self->_format_keyword($keyword),
     $self->_render($where)
   ]
 }
@@ -343,7 +366,9 @@ sub _render_order {
   my @ret = (
     $self->_format_keyword('ORDER BY'),
     $self->_render($dq->{by}),
-    ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+    ($dq->{reverse}
+      ? $self->_format_keyword('DESC')
+      : ())
   );
   my $from;
   while ($from = $dq->{from}) {
@@ -352,13 +377,31 @@ sub _render_order {
     push @ret, (
       ',',
       $self->_render($dq->{by}),
-      ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+      ($dq->{reverse}
+        ? $self->_format_keyword('DESC')
+        : ())
     );
   }
   unshift @ret, $self->_render($from) if $from;
   \@ret;
 }
 
+sub _render_group {
+  my ($self, $dq) = @_;
+  # this could also squash like order does. but I dunno whether that should
+  # move somewhere else just yet.
+  my @ret = (
+    ($dq->{from} ? $self->_render($dq->{from}) : ()),
+    (@{$dq->{by}}
+      ? (
+          $self->_format_keyword('GROUP BY'),
+          intersperse(',', map $self->_render($_), @{$dq->{by}})
+         )
+      : ())
+  );
+  \@ret;
+}
+
 sub _render_delete {
   my ($self, $dq) = @_;
   my ($target, $where) = @{$dq}{qw(target where)};