Port more stuff to use HashAST

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 03e2ff6..d689e58 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,18 +8,12 @@ class SQL::Abstract {
 
   use Moose::Util::TypeConstraints;
   use MooseX::Types -declare => [qw/NameSeparator/];
-  use MooseX::Types::Moose qw/ArrayRef Str Int HashRef/;
+  use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
   use MooseX::AttributeHelpers;
+  use SQL::Abstract::Types qw/NameSeparator QuoteChars 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';
@@ -36,18 +30,25 @@ class SQL::Abstract {
     '==' => '=',
     '!=' => '!=',
     # LIKE is always "field LIKE <value>"
-    '-like' => 'IN',
+    '-like' => 'LIKE',
     '-not_like' => 'NOT LIKE',
   );
 
   has where_dispatch_table => (
     is => 'ro',
-    lazy_build => 1,
+    lazy => 1,
+    builder => '_build_where_dispatch_table',
+    isa => HashRef[CodeRef],
+    metaclass => 'Collection::ImmutableHash',
+    provides => {
+      get => 'lookup_where_dispatch'
+    }
   );
 
   has binop_map => (
     is => 'ro',
-    lazy_build => 1,
+    lazy => 1,
+    builder => '_build_binops',
     isa => HashRef,
     metaclass => 'Collection::ImmutableHash',
     provides => {
@@ -57,10 +58,11 @@ class SQL::Abstract {
     }
   );
 
-  sub _build_binop_map { return {%BINOP_MAP} };
+  # List of default binary operators (for in where clauses)
+  sub _build_binops { return {%BINOP_MAP} };
 
   method _build_where_dispatch_table {
-    my $binop = $self->can('_binop');
+    my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!";
     return {
       map { $_ => $binop } $self->binary_operators
     }
@@ -75,7 +77,7 @@ class SQL::Abstract {
   has name_separator => ( 
     is => 'rw', 
     isa => NameSeparator,
-    default => sub { ['.'] },
+    default => '.',
     coerece => 1,
     required => 1,
   );
@@ -87,6 +89,14 @@ class SQL::Abstract {
     required => 1,
   );
 
+  has quote_chars => (
+    is => 'rw', 
+    isa => QuoteChars,
+    coerece => 1,
+    predicate => 'is_quoting',
+    clearer => 'disable_quoting', 
+  );
+
   has binds => (
     isa => ArrayRef,
     is => 'ro',
@@ -111,7 +121,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');
 
@@ -127,12 +137,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);
   }