Refactor to use a (hopefully) clearer dispatch table method

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index eb0f2a5..03e2ff6 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,7 +8,7 @@ class SQL::Abstract {
 
   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/;
   use MooseX::AttributeHelpers;
 
   clean;
@@ -30,13 +30,42 @@ class SQL::Abstract {
     or  => 50
   );
 
-  our %OP_MAP = (
+  our %BINOP_MAP = (
     '>' => '>',
     '<' => '<',
     '==' => '=',
     '!=' => '!=',
+    # LIKE is always "field LIKE <value>"
+    '-like' => 'IN',
+    '-not_like' => 'NOT LIKE',
   );
 
+  has where_dispatch_table => (
+    is => 'ro',
+    lazy_build => 1,
+  );
+
+  has binop_map => (
+    is => 'ro',
+    lazy_build => 1,
+    isa => HashRef,
+    metaclass => 'Collection::ImmutableHash',
+    provides => {
+      exists => 'is_valid_binop',
+      get => 'binop_mapping',
+      keys => 'binary_operators'
+    }
+  );
+
+  sub _build_binop_map { return {%BINOP_MAP} };
+
+  method _build_where_dispatch_table {
+    my $binop = $self->can('_binop');
+    return {
+      map { $_ => $binop } $self->binary_operators
+    }
+  }
+
   has ast_version => (
     is => 'ro',
     isa => Int,
@@ -61,11 +90,12 @@ class SQL::Abstract {
   has binds => (
     isa => ArrayRef,
     is => 'ro',
+    clearer => '_clear_binds',
+    lazy => 1,
     default => sub { [ ] },
     metaclass => 'Collection::Array',
     provides => {
       push => 'add_bind',
-      clear => '_clear_binds',
     }
   );
 
@@ -93,5 +123,17 @@ class SQL::Abstract {
     return ($self->dispatch($ast), $self->binds);
   }
 
+  method reset() {
+    $self->_clear_binds();
+  }
+
+  method dispatch (ArrayRef $ast) {
+
+    local $_ = $ast->[0];
+    s/^-/_/ or croak "Unknown type tag '$_'";
+    
+    my $meth = $self->can($_) || croak "Unknown tag '$_'";
+    return $meth->($self, $ast);
+  }
 
 };

diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
index bf50d4f..81abf9d 100644 (file)
--- a/lib/SQL/Abstract/AST/v1.pm
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -12,12 +12,12 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
 
   clean;
 
-  method dispatch (ArrayRef $ast) {
-
-    local $_ = $ast->[0];
-    s/^-/_/g or croak "Unknown type tag '$_'";
-    my $meth = $self->can($_) || \&_generic_func;
-    return $meth->($self, $ast);
+  override _build_where_dispatch_table {
+    return { 
+      %{super()},
+      -in => $self->can('_in'),
+      -not_in => $self->can('_in')
+    };
   }
 
   method _select(ArrayRef $ast) {
@@ -98,16 +98,17 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
       shift @$clauses;
     }
 
+    my $dispatch_table = $self->where_dispatch_table;
+
     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.)
-        
-        push @output, $self->_binop(@$_);
+      if (my $code = $dispatch_table->{$op}) { 
         
+        push @output, $code->($self, $_);
+
       } elsif ($op =~ /^-(and|or)$/) {
         my $sub_prio = $SQL::Abstract::PRIO{$1}; 
 
@@ -117,30 +118,48 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
           push @output, '(' . $self->_recurse_where($_) . ')';
         }
       } else {
-        push @output, $self->dispatch($_);
+        croak "Unknown where clause '$op'";
       }
     }
 
     return join(" $OP ", @output);
   }
 
-  method _binop($op, $lhs, $rhs) {
+  method _binop($ast) {
+    my ($op, $lhs, $rhs) = @$ast;
+
     join (' ', $self->dispatch($lhs), 
-               $SQL::Abstract::OP_MAP{$op} || croak("Unknown binary operator $op"),
+               $self->binop_mapping($op) || croak("Unknown binary operator $op"),
                $self->dispatch($rhs)
     );
   }
 
   method _in($ast) {
-    my (undef, $field, @values) = @$ast;
+    my ($tag, $field, @values) = @$ast;
+
+    my $not = $tag =~ /^-not/ ? " NOT" : "";
 
     return $self->_false if @values == 0;
     return $self->dispatch($field) .
+           $not. 
            " IN (" .
            join(", ", map { $self->dispatch($_) } @values ) .
            ")";
   }
 
+  method _like($ast) {
+    my ($tag, $field, @values) = @$ast;
+
+    my $not = $tag =~ /^-not/ ? " NOT" : "";
+
+    return $self->_false if @values == 0;
+    return $self->dispatch($field) .
+           $not. 
+           " LIKE (" .
+           join(", ", map { $self->dispatch($_) } @values ) .
+           ")";
+  }
+
   method _generic_func(ArrayRef $ast) {
   }
 

diff --git a/t/001_basic.t b/t/001_basic.t
index 2f009ba..21a4cb8 100644 (file)
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -1,13 +1,14 @@
 use strict;
 use warnings;
 
-use Test::More tests => 18;
+use Test::More tests => 9;
 use Test::Differences;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
 
-# TODO: once MXMS supports %args, use that here
 my $sqla = SQL::Abstract->create(1);
+
+# TODO: once MXMS supports %args, use that here
 is $sqla->dispatch( [ -name => qw/me id/]), "me.id",
   "Simple name generator";
 
@@ -35,110 +36,20 @@ is $sqla->dispatch(
 
 is $sqla->dispatch(
   [ -order_by => [ -name => qw/me date/ ] ]
-), "ORDER BY me.date";
+), "ORDER BY me.date",
+   "order by";
 
 is $sqla->dispatch(
   [ -order_by => 
     [ -name => qw/me date/ ],
     [ -name => qw/me foobar/ ],
   ]
-), "ORDER BY me.date, me.foobar";
+), "ORDER BY me.date, me.foobar",
+   "order by";
 
 is $sqla->dispatch(
   [ -order_by => [ -desc => [ -name => qw/me date/ ] ] ]
-), "ORDER BY me.date DESC";
-
-
-is $sqla->dispatch(
-  [ -in => [  ] ]
-), "0 = 1", "emtpy -in";
-
-is $sqla->dispatch(
-  [ -where =>
-      [ '>', [-name => qw/me id/], [-value => 500 ] ]
-  ]
-), "WHERE me.id > ?", "where clause";
-
-eq_or_diff( [ SQL::Abstract->generate(
-    [ -ast_version => 1,
-      -where =>
-        [ '>', [-name => qw/me id/], [-value => 500 ] ],
-        [ '==', [-name => qw/me name/], [-value => '200' ] ]
-    ]
-  ) ], 
-  [ "WHERE me.id > ? AND me.name = ?",
-    [ 500,
-      '200'
-    ]
-  ],
-  "Where with binds"
-);
-
-
-is $sqla->dispatch(
-  [ -where =>  -or =>
-      [ '>', [-name => qw/me id/], [-value => 500 ] ],
-      [ '==', [-name => qw/me name/], [-value => '200' ] ],
-  ]
-), "WHERE me.id > ? OR me.name = ?", "where clause";
-
-
-is $sqla->dispatch(
-  [ -where =>  -or =>
-      [ '>', [-name => qw/me id/], [-value => 500 ] ],
-      [ -or => 
-        [ '==', [-name => qw/me name/], [-value => '200' ] ],
-        [ '==', [-name => qw/me name/], [-value => '100' ] ]
-      ]
-  ]
-), "WHERE me.id > ? OR me.name = ? OR me.name = ?", "where clause";
-
-is $sqla->dispatch(
-  [ -where =>  -or =>
-      [ '==', [-name => qw/me id/], [-value => 500 ] ],
-      [ -and => 
-        [ '>', [-name => qw/me name/], [-value => '200' ] ],
-        [ '<', [-name => qw/me name/], [-value => '100' ] ]
-      ]
-  ]
-), "WHERE me.id = ? OR me.name > ? AND me.name < ?", "where clause";
-
-is $sqla->dispatch(
-  [ -where =>  -and =>
-      [ '==', [-name => qw/me id/], [-value => 500 ] ],
-      [ -and => 
-        [ '>', [-name => qw/me name/], [-value => '200' ] ],
-        [ '<', [-name => qw/me name/], [-value => '100' ] ]
-      ]
-  ]
-), "WHERE me.id = ? AND me.name > ? AND me.name < ?", "where clause";
-
-
-is $sqla->dispatch(
-  [ -where =>  -and =>
-      [ '==', [-name => qw/me id/], [-value => 500 ] ],
-      [ -or => 
-        [ '>', [-name => qw/me name/], [-value => '200' ] ],
-        [ '<', [-name => qw/me name/], [-value => '100' ] ]
-      ]
-  ]
-), "WHERE me.id = ? AND (me.name > ? OR me.name < ?)", "where clause";
+), "ORDER BY me.date DESC",
+   "order by desc";
 
-eq_or_diff(
-  [SQL::Abstract->generate(
-    [ -ast_version => 1,
-      -where =>
-      [ -in => 
-        [-name => qw/me id/],
-        [-value => '100' ],
-        [-value => '200' ],
-        [-value => '300' ],
-      ]
-    ]
-  ) ],
 
-  [ "WHERE me.id IN (?, ?, ?)", 
-    [ qw/100 200 300/]
-  ],
-  
-  "where IN clause");

diff --git a/t/100_where_basic.t b/t/100_where_basic.t
new file mode 100644 (file)
index 0000000..d508ada
--- /dev/null
+++ b/t/100_where_basic.t
@@ -0,0 +1,136 @@
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::Differences;
+
+use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
+
+my $sqla = SQL::Abstract->create(1);
+
+is $sqla->dispatch(
+  [ -where =>
+      [ '>', [-name => qw/me id/], [-value => 500 ] ]
+  ]
+), "WHERE me.id > ?", 
+   "simple where clause";
+
+is $sqla->dispatch(
+  [ -in => [  ] ]
+), "0 = 1", "emtpy -in";
+
+is $sqla->dispatch(
+  [ -where =>
+      [ '>', [-name => qw/me id/], [-value => 500 ] ]
+  ]
+), "WHERE me.id > ?", 
+   "simple where clause";
+
+eq_or_diff( [ SQL::Abstract->generate(
+    [ -ast_version => 1,
+      -where =>
+        [ '>', [-name => qw/me id/], [-value => 500 ] ],
+        [ '==', [-name => qw/me name/], [-value => '200' ] ]
+    ]
+  ) ], 
+  [ "WHERE me.id > ? AND me.name = ?",
+    [ 500,
+      '200'
+    ]
+  ],
+  "Where with binds"
+);
+
+
+is $sqla->dispatch(
+  [ -where =>  -or =>
+      [ '>', [-name => qw/me id/], [-value => 500 ] ],
+      [ '==', [-name => qw/me name/], [-value => '200' ] ],
+  ]
+), "WHERE me.id > ? OR me.name = ?", 
+   "where clause (simple or)";
+
+
+is $sqla->dispatch(
+  [ -where =>  -or =>
+      [ '>', [-name => qw/me id/], [-value => 500 ] ],
+      [ -or => 
+        [ '==', [-name => qw/me name/], [-value => '200' ] ],
+        [ '==', [-name => qw/me name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id > ? OR me.name = ? OR me.name = ?",
+   "where clause (nested or)";
+
+is $sqla->dispatch(
+  [ -where =>  -or =>
+      [ '==', [-name => qw/me id/], [-value => 500 ] ],
+      [ -and => 
+        [ '>', [-name => qw/me name/], [-value => '200' ] ],
+        [ '<', [-name => qw/me name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id = ? OR me.name > ? AND me.name < ?", 
+   "where clause (inner and)";
+
+is $sqla->dispatch(
+  [ -where =>  -and =>
+      [ '==', [-name => qw/me id/], [-value => 500 ] ],
+      [ -and => 
+        [ '>', [-name => qw/me name/], [-value => '200' ] ],
+        [ '<', [-name => qw/me name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id = ? AND me.name > ? AND me.name < ?", 
+   "where clause (nested and)";
+
+
+is $sqla->dispatch(
+  [ -where =>  -and =>
+      [ '==', [-name => qw/me id/], [-value => 500 ] ],
+      [ -or => 
+        [ '>', [-name => qw/me name/], [-value => '200' ] ],
+        [ '<', [-name => qw/me name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id = ? AND (me.name > ? OR me.name < ?)", 
+   "where clause (inner or)";
+
+eq_or_diff(
+  [SQL::Abstract->generate(
+    [ -ast_version => 1,
+      -where =>
+      [ -in => 
+        [-name => qw/me id/],
+        [-value => '100' ],
+        [-value => '200' ],
+        [-value => '300' ],
+      ]
+    ]
+  ) ],
+
+  [ "WHERE me.id IN (?, ?, ?)", 
+    [ qw/100 200 300/]
+  ],
+  
+  "where IN clause");
+
+
+eq_or_diff(
+  [SQL::Abstract->generate(
+    [ -ast_version => 1,
+      -where =>
+      [ -not_in => 
+        [-name => qw/me id/],
+        [-value => '100' ],
+        [-value => '200' ],
+        [-value => '300' ],
+      ]
+    ]
+  ) ],
+
+  [ "WHERE me.id NOT IN (?, ?, ?)", 
+    [ qw/100 200 300/]
+  ],
+  
+  "where NOT IN clause");