Refactor more things to fully hash based AST
Ash Berlin [Thu, 12 Mar 2009 22:57:27 +0000 (22:57 +0000)]
lib/SQL/Abstract.pm
lib/SQL/Abstract/AST/v1.pm
t/100_where_basic.t

index d689e58..b7c1565 100644 (file)
@@ -10,7 +10,7 @@ class SQL::Abstract {
   use MooseX::Types -declare => [qw/NameSeparator/];
   use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
   use MooseX::AttributeHelpers;
-  use SQL::Abstract::Types qw/NameSeparator QuoteChars AST ArrayAST/;
+  use SQL::Abstract::Types qw/NameSeparator QuoteChars AST HashAST ArrayAST/;
 
   clean;
 
@@ -121,11 +121,10 @@ class SQL::Abstract {
   }
 
   # Main entry point
-  method generate(ClassName $class: AST $ast) {
+  method generate(ClassName $class: HashAST $ast) {
+    my $ver = $ast->{-ast_version};
     croak "SQL::Abstract AST version not specified"
-      unless ($ast->[0] eq '-ast_version');
-
-    my (undef, $ver) = splice(@$ast, 0, 2);
+      unless defined $ver;
 
     # TODO: once MXMS supports %args, use that here
     my $self = $class->create($ver);
index 7aa1711..3135086 100644 (file)
@@ -18,6 +18,8 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
       %{super()},
       in => $self->can('_in'),
       not_in => $self->can('_in'),
+      and => $self->can('_recurse_where'),
+      or => $self->can('_recurse_where'),
       map { +"$_" => $self->can("_$_") } qw/
         value
         name
@@ -142,28 +144,17 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return "?";
   }
 
-  method _recurse_where(ArrayRef $clauses) {
+  method _recurse_where(HashAST $ast) {
 
-    my $OP = 'AND';
-    my $prio = $SQL::Abstract::PRIO{and};
-    my $first = $clauses->[0];
+    my $op = $ast->{op};
 
-    if (!ref $first) {
-      if ($first =~ /^-(and|or)$/) {
-        $OP = uc($1);
-        $prio = $SQL::Abstract::PRIO{$1};
-        shift @$clauses;
-      } else {
-        # If first is not a ref, and its not -and or -or, then $clauses
-        # contains just a single clause
-        $clauses = [ $clauses ];
-      }
-    }
+    my $OP = uc $op;
+    my $prio = $SQL::Abstract::PRIO{$op};
 
     my $dispatch_table = $self->where_dispatch_table;
 
     my @output;
-    foreach (@$clauses) {
+    foreach ( @{$ast->{args}} ) {
       croak "invalid component in where clause: $_" unless is_ArrayRef($_);
       my $op = $_->[0];
 
@@ -215,16 +206,18 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     );
   }
 
-  method _in(ArrayAST $ast) {
-    my ($tag, $field, @values) = @$ast;
+  method _in(HashAST $ast) {
+  
+    my ($field,$values) = @{$ast->{args}};
+
+    my $not = ($ast->{op} =~ /^-not/) ? " NOT" : "";
 
-    my $not = $tag =~ /^-not/ ? " NOT" : "";
+    return $self->_false if !defined $values || @$values == 0;
 
-    return $self->_false if @values == 0;
     return $self->_where_component($field) .
            $not. 
            " IN (" .
-           join(", ", map { $self->dispatch($_) } @values ) .
+           join(", ", map { $self->dispatch($_) } @$values ) .
            ")";
   }
 
index 2012ed8..e175912 100644 (file)
@@ -18,32 +18,59 @@ is $sqla->dispatch(
   }
 ), "me.id > ?", 
    "simple where clause";
-__END__
+
 is $sqla->dispatch(
-  [ -in => [  ] ]
+  { -type => 'expr', op => 'in', args => [  ] }
 ), "0 = 1", "emtpy -in";
 
 is $sqla->dispatch(
-  [ -where =>
-      [ '>', [-name => qw/me id/], [-value => 500 ] ]
-  ]
-), "WHERE me.id > ?", 
-   "simple where clause";
+  { -type => 'expr', 
+    op => 'in', 
+    args => [ { -type => 'name', args => ['foo'] } ],
+  }
+), "0 = 1", "emtpy -in";
 
-eq_or_diff( [ SQL::Abstract->generate(
-    [ -ast_version => 1,
-      -where =>
-        [ '>', [-name => qw/me id/], [-value => 500 ] ],
-        [ '==', [-name => qw/me name/], [-value => '200' ] ]
+is $sqla->dispatch(
+  { -type => 'expr',
+    op => '>',
+    args => [
+      {-type => 'name', args => [qw/me id/]}, 
+      {-type => 'value', value => 500 }
     ]
+  }
+), "me.id > ?", 
+   "simple expr clause";
+
+eq_or_diff( [ SQL::Abstract->generate(
+    { -ast_version => 1,
+      -type => 'expr',
+      op => 'and',
+      args => [
+        { -type => 'expr',
+          op => '>',
+          args => [
+            {-type => 'name', args => [qw/me id/]}, 
+            {-type => 'value', value => 500 }
+          ]
+        },
+        { -type => 'expr',
+          op => '==',
+          args => [
+            {-type => 'name', args => [qw/me name/]}, 
+            {-type => 'value', value => '200' }
+          ]
+        },
+      ]
+    }
   ) ], 
-  [ "WHERE me.id > ? AND me.name = ?",
+  [ "me.id > ? AND me.name = ?",
     [ 500,
       '200'
     ]
   ],
   "Where with binds"
 );
+__END__
 
 
 is $sqla->dispatch(