ORDER BY, HAVING, GROUP BY and WHERE clauses on select
[dbsrgits/SQL-Abstract-2.0-ish.git] / lib / SQL / Abstract / AST / v1.pm
index 3de8b66..ae2e05c 100644 (file)
@@ -32,62 +32,89 @@ 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->{$_});
+    # Default to requiring columns and from.
+    # DB specific ones (i.e. mysql/Pg) can not require the FROM part with a bit
+    # of refactoring
+    
+    for (qw/columns tablespec/) {
+      confess "'$_' is required in select AST with " . dump ($ast)
+        unless exists $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';
+    confess "'columns' should be an array ref, not " . dump($ast->{columns})
+      unless is_ArrayRef($ast->{columns});
+
+    my $cols = $self->_list({-type => 'list', args => $ast->{columns} });
 
     my @output = (
-      "SELECT", 
-      $self->dispatch($ast->{columns}),
-      "FROM",
-      $self->dispatch($ast->{from})
+      SELECT => $cols
     );
 
-    for (qw/join/) {
+    push @output, FROM => $self->dispatch($ast->{tablespec})
+      if exists $ast->{tablespec};
+
+    if (exists $ast->{where}) {
+      my $sub_ast = $ast->{where};
+
+      confess "$_ option is not an AST: " . dump($sub_ast)
+        unless is_AST($sub_ast);
+
+      push @output, "WHERE", $self->_expr($sub_ast);
+    }
+
+    for (qw/group_by having order_by/) {
       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);
+        confess "$_ option is not an AST or an ArrayRef: " . dump($sub_ast)
+          unless is_AST($sub_ast) || is_ArrayRef($sub_ast);;
+
+        my $meth = "__$_";
+        push @output, $self->$meth($sub_ast);
       }
     }
 
     return join(' ', @output);
   }
 
-  method _where(ArrayAST $ast) {
-    my (undef, @clauses) = @$ast;
+  method _join(HashRef $ast) {
+
+    # TODO: Validate join type
+    my $type = $ast->{join_type} || "";
   
-    return 'WHERE ' . $self->_recurse_where(\@clauses);
+    my @output = $self->dispatch($ast->{lhs});
+
+    push @output, uc $type if $type;
+    push @output, "JOIN", $self->dispatch($ast->{rhs});
+
+    push @output, 
+        exists $ast->{on}
+      ? ('ON', '(' . $self->_expr( $ast->{on} ) . ')' )
+      : ('USING', '(' .$self->dispatch($ast->{using} 
+                        || croak "No 'on' or 'uinsg' clause passed to join cluase: " .
+                                 dump($ast) 
+                        ) .
+                  ')' );
+
+    return join(" ", @output);
+      
   }
 
-  method _order_by(AST $ast) {
-    my @clauses = @{$ast->{order_by}};
-  
-    my @output;
-   
-    for (@clauses) {
-      if (is_ArrayRef($_) && $_->[0] =~ /^-(asc|desc)$/) {
-        my $o = $1;
-        push @output, $self->dispatch($_->[1]) . " " . uc($o);
-        next;
-      }
-      push @output, $self->dispatch($_);
-    }
+  method _ordering(AST $ast) {
+    my $output = $self->_expr($ast->{expr});
+
+    $output .= " " . uc $1
+      if $ast->{direction} && 
+         ( $ast->{direction} =~ /^(asc|desc)$/i 
+           || confess "Unknown ordering direction " . dump($ast)
+         );
 
-    return "ORDER BY " . join(", ", @output);
+    return $output;
   }
 
-  method _name(AST $ast) {
+  method _name(HashAST $ast) {
     my @names = @{$ast->{args}};
 
     my $sep = $self->name_separator;
@@ -112,27 +139,18 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return $ret;
   }
 
-  method _join(HashRef $ast) {
-  
-    my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
-
-    $output .= exists $ast->{on}
-             ? ' ON (' . $self->_recurse_where( $ast->{on} )
-             : ' USING (' .$self->dispatch($ast->{using} || croak "No 'on' or 'join' clause passed to -join");
-
-    $output .= ")";
-    return $output;
-      
-  }
 
   method _list(AST $ast) {
-    my @items = @{$ast->{args}};
+    my @items = is_ArrayRef($ast->{args})
+              ? @{$ast->{args}}
+              : $ast->{args};
 
     return join(
       $self->list_separator,
       map { $self->dispatch($_) } @items);
   }
 
+  # TODO: I think i want to parameterized AST type to get better validation
   method _alias(AST $ast) {
     
     # TODO: Maybe we want qq{ AS "$as"} here
@@ -146,6 +164,20 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return "?";
   }
 
+  # Not dispatchable to.
+  method __having($args) {
+    return "HAVING " . $self->_list({-type => 'list', args => $args});
+  }
+
+  method __group_by($args) {
+    return "GROUP BY " . $self->_list({-type => 'list', args => $args});
+  }
+
+  method __order_by($args) {
+    return "ORDER BY " . $self->_list({-type => 'list', args => $args});
+  }
+
+
   # Perhaps badly named. handles 'and' and 'or' clauses
   method _recurse_where(HashAST $ast) {