From: Ash Berlin Date: Wed, 4 Mar 2009 21:43:27 +0000 (+0000) Subject: Refactor to use a (hopefully) clearer dispatch table method X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Abstract-2.0-ish.git;a=commitdiff_plain;h=0bf8a8c40f7a290717b41ce554b0c5ba85697c2a 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 --- 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 " + '-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 --- 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 --- 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 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");