Port more stuff to use HashAST

[dbsrgits/SQL-Abstract-2.0-ish.git] / lib / SQL / Abstract / AST / v1.pm

diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
index 5a2ccc9..7aa1711 100644 (file)
--- a/lib/SQL/Abstract/AST/v1.pm
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -16,9 +16,9 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   override _build_where_dispatch_table {
     return { 
       %{super()},
-      -in => $self->can('_in'),
-      -not_in => $self->can('_in'),
-      map { +"-$_" => $self->can("_$_") } qw/
+      in => $self->can('_in'),
+      not_in => $self->can('_in'),
+      map { +"$_" => $self->can("_$_") } qw/
         value
         name
         true
@@ -28,7 +28,36 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   }
 
   method _select(HashAST $ast) {
-    
+    # Default to requiring columns and from
+    # Once TCs give better errors, make this a SelectAST type
+    for (qw/columns from/) {
+      confess "$_ key is required (and must be an AST) to select"
+        unless is_ArrayAST($ast->{$_});
+    }
+   
+    # Check that columns is a -list
+    confess "columns key should be a -list AST, not " . $ast->{columns}[0]
+      unless $ast->{columns}[0] eq '-list';
+
+    my @output = (
+      "SELECT", 
+      $self->dispatch($ast->{columns}),
+      "FROM",
+      $self->dispatch($ast->{from})
+    );
+
+    for (qw/join/) {
+      if (exists $ast->{$_}) {
+        my $sub_ast = $ast->{$_};
+        $sub_ast->{-type} = "$_" if is_HashRef($sub_ast);
+        confess "$_ option is not an AST"
+          unless is_AST($sub_ast);
+
+        push @output, $self->dispatch($sub_ast);
+      }
+    }
+
+    return join(' ', @output);
   }
 
   method _where(ArrayAST $ast) {
@@ -37,13 +66,13 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return 'WHERE ' . $self->_recurse_where(\@clauses);
   }
 
-  method _order_by(ArrayAST $ast) {
-    my (undef, @clauses) = @$ast;
-
+  method _order_by(AST $ast) {
+    my @clauses = @{$ast->{order_by}};
+  
     my @output;
    
     for (@clauses) {
-      if ($_->[0] =~ /^-(asc|desc)$/) {
+      if (is_ArrayRef($_) && $_->[0] =~ /^-(asc|desc)$/) {
         my $o = $1;
         push @output, $self->dispatch($_->[1]) . " " . uc($o);
         next;
@@ -54,20 +83,32 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return "ORDER BY " . join(", ", @output);
   }
 
-  method _name(ArrayAST $ast) {
-    my (undef, @names) = @$ast;
+  method _name(AST $ast) {
+    my @names = @{$ast->{args}};
 
     my $sep = $self->name_separator;
+    my $quote = $self->is_quoting 
+              ? $self->quote_chars
+              : [ '' ];
+
+    my $join = $quote->[-1] . $sep . $quote->[0];
+
+    # We dont want to quote * in [qw/me */]: `me`.* is the desired output there
+    # This means you can't have a field called `*`. I am willing to accept this
+    # situation, cos thats a really stupid thing to want.
+    my $post;
+    $post = pop @names if $names[-1] eq '*';
 
-    return $sep->[0] . 
-           join( $sep->[1] . $sep->[0], @names ) . 
-           $sep->[1]
-              if (@$sep > 1);
+    my $ret = 
+      $quote->[0] . 
+      join( $join, @names ) . 
+      $quote->[-1];
 
-    return join($sep->[0], @names);
+    $ret .= $sep . $post if defined $post;
+    return $ret;
   }
 
-  method _join(HashAST $ast) {
+  method _join(HashRef $ast) {
   
     my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
 
@@ -80,25 +121,24 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
       
   }
 
-  method _list(ArrayAST $ast) {
-    my (undef, @items) = @$ast;
+  method _list(AST $ast) {
+    my @items = @{$ast->{args}};
 
     return join(
       $self->list_separator,
       map { $self->dispatch($_) } @items);
   }
 
-  method _alias(ArrayAST $ast) {
-    my (undef, $alias, $as) = @$ast;
-
-    return $self->dispatch($alias) . " AS $as";
+  method _alias(AST $ast) {
+    
+    # TODO: Maybe we want qq{ AS "$as"} here
+    return $self->dispatch($ast->{ident}) . " AS " . $ast->{as};
 
   }
 
-  method _value(ArrayAST $ast) {
-    my ($undef, $value) = @$ast;
+  method _value(HashAST $ast) {
 
-    $self->add_bind($value);
+    $self->add_bind($ast->{value});
     return "?";
   }
 
@@ -143,8 +183,8 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return join(" $OP ", @output);
   }
 
-  method _where_component(ArrayRef $ast) {
-    my $op = $ast->[0];
+  method _where_component(HashAST $ast) {
+    my $op = $ast->{-type};
 
     if (my $code = $self->lookup_where_dispatch($op)) { 
       
@@ -158,9 +198,16 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
    
   }
 
+  method _expr(HashAST $ast) {
+    my $op = $ast->{op};
+    my $meth = $self->lookup_where_dispatch($op) || confess "Invalid operator '$op'";
+   
+    $meth->($self, $ast);
+  }
 
-  method _binop(ArrayRef $ast) {
-    my ($op, $lhs, $rhs) = @$ast;
+  method _binop(HashAST $ast) {
+    my ($lhs, $rhs) = @{$ast->{args}};
+    my $op = $ast->{op};
 
     join (' ', $self->_where_component($lhs), 
                $self->binop_mapping($op) || croak("Unknown binary operator $op"),