Get select sort of working again

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 3d6bd73..d3b517c 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -11,6 +11,7 @@ class SQL::Abstract {
   use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
   use MooseX::AttributeHelpers;
   use SQL::Abstract::Types qw/NameSeparator QuoteChars AST HashAST ArrayAST/;
+  use Devel::PartialDump qw/dump/;
 
   clean;
 
@@ -140,7 +141,7 @@ class SQL::Abstract {
     # I want multi methods!
     my $tag;
     if (is_ArrayAST($ast)) {
-      ($tag = $ast->[0]) =~ s/^-/_/;
+      confess "FIX: " . dump($ast); 
     } else {
       $tag = "_" . $ast->{-type};
     }

diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
index 3de8b66..3914388 100644 (file)
--- a/lib/SQL/Abstract/AST/v1.pm
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -32,25 +32,29 @@ 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 = join ($self->list_separator, map { $self->dispatch($_) } @{ $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};
+
+    for (qw//) {
       if (exists $ast->{$_}) {
         my $sub_ast = $ast->{$_};
         $sub_ast->{-type} = "$_" if is_HashRef($sub_ast);
@@ -87,7 +91,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return "ORDER BY " . join(", ", @output);
   }
 
-  method _name(AST $ast) {
+  method _name(HashAST $ast) {
     my @names = @{$ast->{args}};
 
     my $sep = $self->name_separator;
@@ -117,7 +121,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
 
     $output .= exists $ast->{on}
-             ? ' ON (' . $self->_recurse_where( $ast->{on} )
+             ? ' ON (' . $self->_expr( $ast->{on} )
              : ' USING (' .$self->dispatch($ast->{using} || croak "No 'on' or 'join' clause passed to -join");
 
     $output .= ")";
@@ -133,6 +137,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
       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

diff --git a/t/200_join.t b/t/200_join.t
index 176ab81..7095518 100644 (file)
--- a/t/200_join.t
+++ b/t/200_join.t
@@ -10,16 +10,23 @@ my $sqla = SQL::Abstract->create(1);
 
 is $sqla->dispatch(
   { -type => 'join',
-    tablespec => [-name => qw/foo/],
-    on => [ '==', [-name => qw/foo id/], [ -name => qw/me foo_id/ ] ],
+    tablespec => {-type => name => args => [qw/foo/]},
+    on => { 
+      -type => 'expr',
+      op => '==',
+      args => [
+        { -type => 'name', args => [qw/foo id/] },
+        { -type => 'name', args => [qw/me foo_id/] },
+      ]
+    }
   }
 ), "JOIN foo ON (foo.id = me.foo_id)", 
    "simple join clause";
 
 is $sqla->dispatch(
   { -type => 'join',
-    tablespec => [-alias => [-name => qw/foo/], 'bar' ],
-    using => [ -name => qw/foo_id/ ]
+    tablespec => {-type => 'alias', ident => {-type => name => args => [qw/foo/]}, as => 'bar' },
+    using => { -type => 'name', args => [qw/foo_id/] },
   }
 ), "JOIN foo AS bar USING (foo_id)", 
    "using join clause";

diff --git a/t/201_select.t b/t/201_select.t
index 5ea9c38..61b57d0 100644 (file)
--- a/t/201_select.t
+++ b/t/201_select.t
@@ -10,17 +10,28 @@ my $sqla = SQL::Abstract->create(1);
 
 is $sqla->dispatch(
   { -type => 'select',
-    from => [-alias => [-name => 'foo'] => 'me' ],
-    columns => [ -list => 
-        [ -name => qw/me id/ ],
-        [ -alias => [ -name => qw/me foo_id/ ], 'foo' ],
+    tablespec => {-type => 'alias', ident => {-type => 'name', args => [qw/foo/]}, as => 'me' },
+    columns => [
+      { -type => 'name', args => [qw/me id/] },
+      { -type => 'alias', ident => { -type => 'name', args => [qw/me foo_id/] }, as => 'foo' },
     ]
   }
 ), "SELECT me.id, me.foo_id AS foo FROM foo AS me",
    "simple select clause";
 
+__END__
 is $sqla->dispatch(
   { -type => 'select',
+    tablespec => {-type => 'alias', ident => {-type => 'name', args => [qw/foo/]}, as => 'me' },
+    columns => [
+      { -type => 'name', args => [qw/me id/] },
+      { -type => 'alias', ident => { -type => 'name', args => [qw/me foo_id/] }, as => 'foo' },
+      { -type => 'name', args => [qw/bar name/] },
+    ]
+  }
+
+
+  { -type => 'select',
     from => [-alias => [-name => 'foo'] => 'me' ],
     columns => [ -list => 
         [ -name => qw/me id/ ],

diff --git a/t/900_errors.t b/t/900_errors.t
index dbddb1c..f5a6fef 100644 (file)
--- a/t/900_errors.t
+++ b/t/900_errors.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 5;
 use Test::Exception;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
@@ -23,5 +23,19 @@ throws_ok {
   $sqla->dispatch(
     { -type => 'expr', op => '~' }
   )
-} qr/^'~' is not a valid operator in an expression/
+} qr/^'~' is not a valid operator in an expression/;
+
+local $TODO = "Work out how to get nice errors for these";
+
+throws_ok {
+  $sqla->dispatch(
+    { -type => 'alias', ident => 2 } # no as, inavlid ident
+  )
+} qr/foobar/, "alias: no as, invalid ident";
+
+throws_ok {
+  $sqla->dispatch(
+    { -type => 'alias', iden => { -type => 'name', args => ['id'] }, as => 'foo' } # iden not ident
+  )
+} qr/foobar/, "alias: iden instead of ident";