Require -ast_version to generate (and un-dual life it. Now is class method only)

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 7c89615..dafa646 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,11 +8,11 @@ class SQL::Abstract {
   use Data::Dump qw/pp/;
 
   use Moose::Util::TypeConstraints;
-  use MooseX::Types -declare => ['NameSeparator'];
-  use MooseX::Types::Moose qw/ArrayRef Str/;
+  use MooseX::Types -declare => [qw/NameSeparator/];
+  use MooseX::Types::Moose qw/ArrayRef Str Int/;
   use MooseX::AttributeHelpers;
 
-  use namespace::clean -except => ['meta'];
+  clean;
 
   subtype NameSeparator,
     as ArrayRef[Str];
@@ -25,6 +25,25 @@ class SQL::Abstract {
 
   our $AST_VERSION = '1';
 
+  # Operator precedence for bracketing
+  our %PRIO = (
+    and => 10,
+    or  => 50
+  );
+
+  our %OP_MAP = (
+    '>' => '>',
+    '<' => '<',
+    '==' => '=',
+    '!=' => '!=',
+  );
+
+  has ast_version => (
+    is => 'ro',
+    isa => Int,
+    required => 1
+  );
+
   has name_separator => ( 
     is => 'rw', 
     isa => NameSeparator,
@@ -42,19 +61,36 @@ class SQL::Abstract {
 
   has binds => (
     isa => ArrayRef,
+    is => 'ro',
     default => sub { [ ] },
     metaclass => 'Collection::Array',
     provides => {
       push => 'add_bind',
-      get => 'binds'
+      clear => '_clear_binds',
     }
   );
 
-  method generate (ArrayRef $ast) {
-    $self = new $self unless blessed($self);
+  method BUILD( $ast ) {
+    croak "AST version @{[$self->ast_version]} is greater than supported version of $AST_VERSION"
+      if $self->ast_version > $AST_VERSION;
+  }
+
+  # Main entry point
+  method generate(ClassName $class: ArrayRef $ast) {
+    croak "SQL::Abstract AST version not specified"
+      unless ($ast->[0] eq '-ast_version');
+
+    my (undef, $ver) = splice(@$ast, 0, 2);
+
+    my $self = $class->new(ast_version => $ver);
+
+    return ($self->dispatch($ast), $self->binds);
+  }
+
+  method dispatch (ArrayRef $ast) {
 
     local $_ = $ast->[0];
-    s/^-/_/ or croak "Unknown type tag '$_'";
+    s/^-/_/g or croak "Unknown type tag '$_'";
     my $meth = $self->can($_) || \&_generic_func;
     return $meth->($self, $ast);
   }
@@ -63,6 +99,29 @@ class SQL::Abstract {
     
   }
 
+  method _where(ArrayRef $ast) {
+    my (undef, @clauses) = @$ast;
+  
+    return 'WHERE ' . $self->_recurse_where(\@clauses);
+  }
+
+  method _order_by(ArrayRef $ast) {
+    my (undef, @clauses) = @$ast;
+
+    my @output;
+   
+    for (@clauses) {
+      if ($_->[0] =~ /^-(asc|desc)$/) {
+        my $o = $1;
+        push @output, $self->dispatch($_->[1]) . " " . uc($o);
+        next;
+      }
+      push @output, $self->dispatch($_);
+    }
+
+    return "ORDER BY " . join(", ", @output);
+  }
+
   method _name(ArrayRef $ast) {
     my (undef, @names) = @$ast;
 
@@ -76,18 +135,22 @@ class SQL::Abstract {
     return join($sep->[0], @names);
   }
 
+  method _join(ArrayRef $ast) {
+    
+  }
+
   method _list(ArrayRef $ast) {
     my (undef, @items) = @$ast;
 
     return join(
       $self->list_separator,
-      map { $self->generate($_) } @items);
+      map { $self->dispatch($_) } @items);
   }
 
   method _alias(ArrayRef $ast) {
     my (undef, $alias, $as) = @$ast;
 
-    return $self->generate($alias) . " AS $as";
+    return $self->dispatch($alias) . " AS $as";
 
   }
 
@@ -98,26 +161,58 @@ class SQL::Abstract {
     return "?";
   }
 
-  method _where(ArrayRef $ast) {
-    my (undef, @clauses) = @$ast;
+  method _recurse_where($clauses) {
 
-    my @output;
+    my $OP = 'AND';
+    my $prio = $PRIO{and};
+    my $first = $clauses->[0];
+
+    if (!ref $first && $first =~ /^-(and|or)$/) {
+      $OP = uc($1);
+      $prio = $PRIO{$1};
+      shift @$clauses;
+    }
 
-    foreach (@clauses) {
+    my @output;
+    foreach (@$clauses) {
+      croak "invalid component in where clause" unless ArrayRef->check($_);
       my $op = $_->[0];
 
       unless (substr($op, 0, 1) eq '-') {
         # A simple comparison op (==, >, etc.)
-        croak "Binary operator $op expects 2 children, got " . $#$_
-          if @{$_} > 3;
-
-        push @output, $self->generate($_->[1]), 
-                      $op,
-                      $self->generate($_->[2]);
+        
+        push @output, $self->_binop(@$_);
+        
+      } elsif ($op =~ /^-(and|or)$/) {
+        my $sub_prio = $PRIO{$1}; 
+
+        if ($sub_prio <= $prio) {
+          push @output, $self->_recurse_where($_);
+        } else {
+          push @output, '(' . $self->_recurse_where($_) . ')';
+        }
+      } else {
+        push @output, $self->dispatch($_);
       }
     }
 
-    return join(' ', 'WHERE', @output);
+    return join(" $OP ", @output);
+  }
+
+  method _binop($op, $lhs, $rhs) {
+    join (' ', $self->dispatch($lhs), 
+               $OP_MAP{$op} || croak("Unknown binary operator $op"),
+               $self->dispatch($rhs)
+    );
+  }
+
+  method _in($ast) {
+    my (undef, $field, @values) = @$ast;
+
+    return $self->dispatch($field) .
+           " IN (" .
+           join(", ", map { $self->dispatch($_) } @values ) .
+           ")";
   }
 
   method _generic_func(ArrayRef $ast) {