From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 17 Jul 2011 02:08:43 +0000 (+0000)
Subject: sanify alias/SELECT list rendering
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bdb576cb80d2f6fb1e07bd2a91acb31ec251fdbf;p=dbsrgits%2FData-Query.git

sanify alias/SELECT list rendering
---

diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm
index aeb98d4..c35da5c 100644
--- a/lib/Data/Query/Renderer/SQL/Naive.pm
+++ b/lib/Data/Query/Renderer/SQL/Naive.pm
@@ -2,7 +2,9 @@ package Data::Query::Renderer::SQL::Naive;
 
 use strictures 1;
 use SQL::ReservedWords;
-use Data::Query::Constants qw(DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE);
+use Data::Query::Constants qw(
+  DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS
+);
 
 sub new {
   bless({ %{$_[1]||{}} }, (ref($_[0])||$_[0]))->BUILDALL;
@@ -35,17 +37,24 @@ sub render {
 sub _flatten_structure {
   my ($self, $struct) = @_;
   my @bind;
-  [ (join ' ', map {
-    my $r = ref;
-    if (!$r) { $_ }
-    elsif ($r eq 'ARRAY') {
-      my ($sql, @b) = @{$self->_flatten_structure($_)};
-      push @bind, @b;
-      $sql;
-    }
-    elsif ($r eq 'HASH') { push @bind, $_; () }
-    else { die "_flatten_structure can't handle ref type $r for $_" }
-  } @$struct), @bind ];
+  [ do {
+      my @p = map {
+        my $r = ref;
+        if (!$r) { $_ }
+        elsif ($r eq 'ARRAY') {
+          my ($sql, @b) = @{$self->_flatten_structure($_)};
+          push @bind, @b;
+          $sql;
+        }
+        elsif ($r eq 'HASH') { push @bind, $_; () }
+        else { die "_flatten_structure can't handle ref type $r for $_" }
+      } @$struct;
+      join '', map {
+        ($p[$_], (($p[$_+1]||',') eq ',') ? () : (' '))
+      } 0 .. $#p;
+    },
+    @bind
+  ];
 }
 
 # I present this to permit strange people to easily supply a patch to lc()
@@ -56,7 +65,13 @@ sub _flatten_structure {
 sub _format_keyword { $_[1] }
 
 sub _render {
-  $_[0]->${\"_render_${\lc($_[1]->{type})}"}($_[1]);
+  $_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
+}
+
+sub _render_broken {
+  my ($self, $dq) = @_;
+  require Data::Dumper::Concise;
+  die "Broken DQ entry: ".Data::Dumper::Concise::Dumper($dq);
 }
 
 sub _render_identifier {
@@ -169,17 +184,16 @@ sub _render_select {
   # it is, in fact, completely valid for there to be nothing for us
   # to project from since many databases handle 'SELECT 1;' fine
 
-  my @select = map {
-    # we should perhaps validate that what we've been handed
-    # is an expression and possibly an identifier - at least a
-    # debugging mode that does such is almost certainly worthwhile;
-    # but for present I'm focusing on making this work.
-    my $e = $self->_render($_->{expr});
-    $_->{name} ? [ $e, 'AS', $self->_render($_->{name}), ',' ] : [ $e, ',' ]
-  } @{$dq->{select}};
+  my @select = map [
+    ($_->{type} eq DQ_ALIAS
+      ? $self->_render_alias($_, 'AS')
+      : $self->_render($_)
+    ),
+   ','
+  ], @{$dq->{select}};
 
   # we put the commas inside the [] for each entry as a hint to the pretty
-  # printer downstreamso now we need to eliminate the comma from the last
+  # printer downstream so now we need to eliminate the comma from the last
   # entry - we know there always is one due to the die guard at the top
 
   pop @{$select[-1]};
@@ -197,7 +211,7 @@ sub _render_select {
 }
 
 sub _render_alias {
-  my ($self, $dq) = @_;
+  my ($self, $dq, $as) = @_;
   # FROM foo foo -> FROM foo
   # FROM foo.bar bar -> FROM foo.bar
   if ($dq->{alias}{type} eq DQ_IDENTIFIER) {
@@ -207,7 +221,7 @@ sub _render_alias {
   }
   return [
     $self->_render($dq->{alias}),
-    ' ',
+    $as || ' ',
     $self->_render_identifier({ elements => [ $dq->{as} ] })
   ];
 }
@@ -222,4 +236,12 @@ 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) ];
+}
+
 1;
diff --git a/t/expr.include b/t/expr.include
index 74adb47..beaff7c 100644
--- a/t/expr.include
+++ b/t/expr.include
@@ -30,10 +30,15 @@ sub SELECT (&;@) {
   my @final;
   while (@select) {
     my $e = shift @select;
-    push @final, my $res = { expr => $e->{expr} };
-    if (ref($select[0]) eq 'LIES::AS') {
-      $res->{name} = identifier(${shift @select});
-    }
+    push @final,
+      (ref($select[0]) eq 'LIES::AS'
+        ? +{
+             type => DQ_ALIAS,
+             alias => $e->{expr},
+             as => ${shift(@select)}
+          }
+        : $e->{expr}
+     );
   }
       
   return +{
diff --git a/t/sql.t b/t/sql.t
index 1a02abc..f22a921 100644
--- a/t/sql.t
+++ b/t/sql.t
@@ -54,13 +54,13 @@ expr_sql_is { SELECT { $_->foo } }
 expr_sql_is { SELECT { $_->foo, 1 } }
   # the extra space here is a little icky but Naive's _flatten_structure
   # will need rewriting to fix it - commit bits available if you do it first
-  [ "SELECT foo , ?", binding(1) ],
+  [ "SELECT foo, ?", binding(1) ],
   "Identifier and literal";
 
 expr_sql_is { SELECT { $_->foo => AS("foom"), 1 } }
-  [ "SELECT foo AS foom , ?", binding(1) ],
+  [ "SELECT foo AS foom, ?", binding(1) ],
   "AS with parens";
 
 expr_sql_is { SELECT { $_->foo => AS "foom", 1 } }
-  [ "SELECT foo AS foom , ?", binding(1) ],
+  [ "SELECT foo AS foom, ?", binding(1) ],
   "AS without parens";