Start porting more back compat changes

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index eb0f2a5..d987fd7 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -1,25 +1,18 @@
 use MooseX::Declare;
 
-
 class SQL::Abstract {
 
   use Carp qw/croak/;
   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 HashRef CodeRef/;
   use MooseX::AttributeHelpers;
+  use SQL::Abstract::Types qw/NameSeparator QuoteChars AST/;
+  use Devel::PartialDump qw/dump/;
 
   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';
@@ -30,13 +23,52 @@ class SQL::Abstract {
     or  => 50
   );
 
-  our %OP_MAP = (
+  our %BINOP_MAP = (
     '>' => '>',
+    '>=' => '>=',
     '<' => '<',
+    '<=' => '<=',
     '==' => '=',
     '!=' => '!=',
+    # LIKE is always "field LIKE <value>"
+    'like' => 'LIKE',
+    'not_like' => 'NOT LIKE',
+  );
+
+  has expr_dispatch_table => (
+    is => 'ro',
+    lazy => 1,
+    builder => '_build_expr_dispatch_table',
+    isa => HashRef[CodeRef],
+    metaclass => 'Collection::ImmutableHash',
+    provides => {
+      get => 'lookup_expr_dispatch'
+    }
+  );
+
+  has binop_map => (
+    is => 'ro',
+    lazy => 1,
+    builder => '_build_binops',
+    isa => HashRef,
+    metaclass => 'Collection::ImmutableHash',
+    provides => {
+      exists => 'is_valid_binop',
+      get => 'binop_mapping',
+      keys => 'binary_operators'
+    }
   );
 
+  # List of default binary operators (for in where clauses)
+  sub _build_binops { return {%BINOP_MAP} };
+
+  method _build_expr_dispatch_table {
+    my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!";
+    return {
+      map { $_ => $binop } $self->binary_operators
+    }
+  }
+
   has ast_version => (
     is => 'ro',
     isa => Int,
@@ -46,8 +78,7 @@ class SQL::Abstract {
   has name_separator => ( 
     is => 'rw', 
     isa => NameSeparator,
-    default => sub { ['.'] },
-    coerece => 1,
+    default => '.',
     required => 1,
   );
 
@@ -58,18 +89,28 @@ class SQL::Abstract {
     required => 1,
   );
 
+  has quote_chars => (
+    is => 'rw', 
+    isa => QuoteChars,
+    predicate => 'is_quoting',
+    clearer => 'disable_quoting', 
+    coerce => 1,
+  );
+
   has binds => (
     isa => ArrayRef,
     is => 'ro',
+    clearer => '_clear_binds',
+    lazy => 1,
     default => sub { [ ] },
     metaclass => 'Collection::Array',
     provides => {
       push => 'add_bind',
-      clear => '_clear_binds',
     }
   );
 
   # TODO: once MXMS supports %args, use that here
+  # TODO: improve this so you can pass other args
   method create(ClassName $class: Int $ver) {
     croak "AST version $ver is greater than supported version of $AST_VERSION"
       if $ver > $AST_VERSION;
@@ -81,11 +122,10 @@ class SQL::Abstract {
   }
 
   # Main entry point
-  method generate(ClassName $class: ArrayRef $ast) {
+  method generate(ClassName $class: AST $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);
@@ -93,5 +133,16 @@ class SQL::Abstract {
     return ($self->dispatch($ast), $self->binds);
   }
 
+  method reset() {
+    $self->_clear_binds();
+  }
+
+  method dispatch (AST $ast) {
+
+    my $tag = "_" . $ast->{-type};
+    
+    my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
+    return $meth->($self, $ast);
+  }
 
 };