From: Ash Berlin <ash_github@firemirror.com>
Date: Tue, 10 Mar 2009 09:36:26 +0000 (+0000)
Subject: Create ArrayAST, HashAST and AST types in a type library so that some constructs... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cbcfedc1e28bc756373605ec2854dc43c31be53b;p=dbsrgits%2FSQL-Abstract-2.0-ish.git

Create ArrayAST, HashAST and AST types in a type library so that some constructs can use hashrefs
---

diff --git a/.gitignore b/.gitignore
index 38677d1..4359afb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,6 +2,6 @@
 Makefile
 META.yml
 .*.sw[op]
-blib/
+/blib/
 pm_to_blib
 Makefile.old
diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index f077979..e95b8b8 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -10,16 +10,10 @@ 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 AST ArrayAST/;
 
   clean;
 
-  subtype NameSeparator,
-    as ArrayRef[Str];
-    #where { @$_ == 1 ||| @$_ == 2 },
-    #message { "Name separator must be one or two elements" };
-
-  coerce NameSeparator, from Str, via { [ $_ ] };
-
   our $VERSION = '2.000000';
 
   our $AST_VERSION = '1';
@@ -116,7 +110,7 @@ class SQL::Abstract {
   }
 
   # Main entry point
-  method generate(ClassName $class: ArrayRef $ast) {
+  method generate(ClassName $class: AST $ast) {
     croak "SQL::Abstract AST version not specified"
       unless ($ast->[0] eq '-ast_version');
 
@@ -132,12 +126,16 @@ class SQL::Abstract {
     $self->_clear_binds();
   }
 
-  method dispatch (ArrayRef $ast) {
-
-    local $_ = $ast->[0];
-    s/^-/_/ or croak "Unknown type tag '$_'";
+  method dispatch (AST $ast) {
+    # I want multi methods!
+    my $tag;
+    if (is_ArrayAST($ast)) {
+      ($tag = $ast->[0]) =~ s/^-/_/;
+    } else {
+      $tag = "_" . $ast->{-type};
+    }
     
-    my $meth = $self->can($_) || croak "Unknown tag '$_'";
+    my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
     return $meth->($self, $ast);
   }
 
diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
index f0ed698..7d269e4 100644
--- a/lib/SQL/Abstract/AST/v1.pm
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -6,9 +6,9 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   use Data::Dump qw/pp/;
 
   use Moose::Util::TypeConstraints;
-  use MooseX::Types -declare => [qw/NameSeparator/];
-  use MooseX::Types::Moose qw/ArrayRef Str Int/;
+  use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
   use MooseX::AttributeHelpers;
+  use SQL::Abstract::Types qw/AST ArrayAST HashAST/;
 
   clean;
 
@@ -27,17 +27,17 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     };
   }
 
-  method _select(ArrayRef $ast) {
+  method _select(HashAST $ast) {
     
   }
 
-  method _where(ArrayRef $ast) {
+  method _where(ArrayAST $ast) {
     my (undef, @clauses) = @$ast;
   
     return 'WHERE ' . $self->_recurse_where(\@clauses);
   }
 
-  method _order_by(ArrayRef $ast) {
+  method _order_by(ArrayAST $ast) {
     my (undef, @clauses) = @$ast;
 
     my @output;
@@ -54,7 +54,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return "ORDER BY " . join(", ", @output);
   }
 
-  method _name(ArrayRef $ast) {
+  method _name(ArrayAST $ast) {
     my (undef, @names) = @$ast;
 
     my $sep = $self->name_separator;
@@ -67,20 +67,20 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return join($sep->[0], @names);
   }
 
-  method _join(ArrayRef $ast) {
-    my (undef, @items) = @$ast;
+  method _join(HashAST $ast) {
   
-    croak "invalid component in JOIN: $_" unless ArrayRef->check($items[0]);
-    my @output = 'JOIN';
+    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");
 
-    # TODO: Validation of inputs
-    return 'JOIN '. $self->dispatch(shift @items) .
-                  ' ON (' .
-                  $self->_recurse_where( \@items ) . ')';
+    $output .= ")";
+    return $output;
       
   }
 
-  method _list(ArrayRef $ast) {
+  method _list(ArrayAST $ast) {
     my (undef, @items) = @$ast;
 
     return join(
@@ -88,37 +88,41 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
       map { $self->dispatch($_) } @items);
   }
 
-  method _alias(ArrayRef $ast) {
+  method _alias(ArrayAST $ast) {
     my (undef, $alias, $as) = @$ast;
 
     return $self->dispatch($alias) . " AS $as";
 
   }
 
-  method _value(ArrayRef $ast) {
+  method _value(ArrayAST $ast) {
     my ($undef, $value) = @$ast;
 
     $self->add_bind($value);
     return "?";
   }
 
-  method _recurse_where($clauses) {
+  method _recurse_where(ArrayRef $clauses) {
 
     my $OP = 'AND';
     my $prio = $SQL::Abstract::PRIO{and};
     my $first = $clauses->[0];
 
-    if (!ref $first && $first =~ /^-(and|or)$/) {
-      $OP = uc($1);
-      $prio = $SQL::Abstract::PRIO{$1};
-      shift @$clauses;
+    if (!ref $first) {
+      if ($first =~ /^-(and|or)$/) {
+        $OP = uc($1);
+        $prio = $SQL::Abstract::PRIO{$1};
+        shift @$clauses;
+      } else {
+        $clauses = [ $clauses ];
+      }
     }
 
     my $dispatch_table = $self->where_dispatch_table;
 
     my @output;
     foreach (@$clauses) {
-      croak "invalid component in where clause: $_" unless ArrayRef->check($_);
+      croak "invalid component in where clause: $_" unless is_ArrayRef($_);
       my $op = $_->[0];
 
       if ($op =~ /^-(and|or)$/) {
@@ -137,7 +141,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     return join(" $OP ", @output);
   }
 
-  method _where_component($ast) {
+  method _where_component(ArrayRef $ast) {
     my $op = $ast->[0];
 
     if (my $code = $self->lookup_where_dispatch($op)) { 
@@ -153,7 +157,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   }
 
 
-  method _binop($ast) {
+  method _binop(ArrayRef $ast) {
     my ($op, $lhs, $rhs) = @$ast;
 
     join (' ', $self->_where_component($lhs), 
@@ -162,7 +166,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     );
   }
 
-  method _in($ast) {
+  method _in(ArrayAST $ast) {
     my ($tag, $field, @values) = @$ast;
 
     my $not = $tag =~ /^-not/ ? " NOT" : "";
@@ -175,19 +179,6 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
            ")";
   }
 
-  method _like($ast) {
-    my ($tag, $field, @values) = @$ast;
-
-    my $not = $tag =~ /^-not/ ? " NOT" : "";
-
-    return $self->_false if @values == 0;
-    return $self->_where_component($field) .
-           $not. 
-           " LIKE " .
-           join(", ", map { $self->_where_component($_) } @values ) .
-           "";
-  }
-
   method _generic_func(ArrayRef $ast) {
   }
 
diff --git a/lib/SQL/Abstract/Types.pm b/lib/SQL/Abstract/Types.pm
new file mode 100644
index 0000000..272584d
--- /dev/null
+++ b/lib/SQL/Abstract/Types.pm
@@ -0,0 +1,26 @@
+use MooseX::Declare;
+class SQL::Abstract::Types {
+  use Moose::Util::TypeConstraints;
+  use MooseX::Types -declare => [qw/NameSeparator AST ArrayAST HashAST/];
+  use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
+
+  subtype ArrayAST, as ArrayRef,
+    where { is_Str($_->[0]) && substr($_->[0],0,1) eq '-' },
+    message { "First key of arrayref must be a string starting with '-'"; };
+
+  subtype HashAST, as HashRef,
+    where { exists $_->{-type} && is_Str($_->{-type}) },
+    message { "No '-type' key, or it is not a string" };
+
+  subtype AST, as ArrayAST|HashAST; 
+
+  subtype NameSeparator,
+    as ArrayRef[Str];
+    #where { @$_ == 1 ||| @$_ == 2 },
+    #message { "Name separator must be one or two elements" };
+
+  coerce NameSeparator, from Str, via { [ $_ ] };
+
+}
+
+1;
diff --git a/t/002_types.t b/t/002_types.t
new file mode 100644
index 0000000..e4b7486
--- /dev/null
+++ b/t/002_types.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
+use SQL::Abstract::Types ':all';
+
+is(ArrayAST->validate( [ -foo => 'bar' ] ), undef, "is_ArrayAST with valid" );
+ok(!is_ArrayAST( [ foo => 'bar' ] ), "is_ArrayAST with invalid" );
+
+
+is(HashAST->validate( { -type => 'select', select => [] } ), undef, "is_HashAST with valid" );
+ok(!is_HashAST( { foo => 'bar' } ), "is_HashAST with invalid" );
+
+
+is(AST->validate( { -type => 'select', select => [] } ), undef, "is_AST with valid hash" );
+is(AST->validate( [ -name => 1, 2 ] ), undef, "is_AST with valid array" );
+
+is(is_AST([ -name => qw/me id/]), 1);
diff --git a/t/200_join.t b/t/200_join.t
index 2e89ebc..176ab81 100644
--- a/t/200_join.t
+++ b/t/200_join.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+use Test::More tests => 3;
 use Test::Differences;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
@@ -9,10 +9,17 @@ use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
 my $sqla = SQL::Abstract->create(1);
 
 is $sqla->dispatch(
-  [ -join =>
-      [-name => qw/foo/],
-      [ '==', [-name => qw/foo id/], [ -name => qw/me foo_id/ ] ]
-  ]
+  { -type => 'join',
+    tablespec => [-name => qw/foo/],
+    on => [ '==', [-name => qw/foo id/], [ -name => 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/ ]
+  }
+), "JOIN foo AS bar USING (foo_id)", 
+   "using join clause";