From: Ash Berlin Date: Fri, 13 Mar 2009 20:55:16 +0000 (+0000) Subject: Rename things and unify error handling a bit X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef0d6124fc3f61e6a2ce5d50df36e9af490d31c4;p=dbsrgits%2FSQL-Abstract-2.0-ish.git Rename things and unify error handling a bit --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index b7c1565..3d6bd73 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -34,14 +34,14 @@ class SQL::Abstract { '-not_like' => 'NOT LIKE', ); - has where_dispatch_table => ( + has expr_dispatch_table => ( is => 'ro', lazy => 1, - builder => '_build_where_dispatch_table', + builder => '_build_expr_dispatch_table', isa => HashRef[CodeRef], metaclass => 'Collection::ImmutableHash', provides => { - get => 'lookup_where_dispatch' + get => 'lookup_expr_dispatch' } ); @@ -61,7 +61,7 @@ class SQL::Abstract { # List of default binary operators (for in where clauses) sub _build_binops { return {%BINOP_MAP} }; - method _build_where_dispatch_table { + method _build_expr_dispatch_table { my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!"; return { map { $_ => $binop } $self->binary_operators diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm index 95a7e80..3de8b66 100644 --- a/lib/SQL/Abstract/AST/v1.pm +++ b/lib/SQL/Abstract/AST/v1.pm @@ -9,11 +9,12 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/; use MooseX::AttributeHelpers; use SQL::Abstract::Types qw/AST ArrayAST HashAST/; + use Devel::PartialDump qw/dump/; clean; # set things that are valid in where clauses - override _build_where_dispatch_table { + override _build_expr_dispatch_table { return { %{super()}, in => $self->can('_in'), @@ -145,6 +146,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { return "?"; } + # Perhaps badly named. handles 'and' and 'or' clauses method _recurse_where(HashAST $ast) { my $op = $ast->{op}; @@ -152,7 +154,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { my $OP = uc $op; my $prio = $SQL::Abstract::PRIO{$op}; - my $dispatch_table = $self->where_dispatch_table; + my $dispatch_table = $self->expr_dispatch_table; my @output; foreach ( @{$ast->{args}} ) { @@ -167,43 +169,37 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { push @output, '(' . $self->_recurse_where($_) . ')'; } } else { - push @output, $self->_where_component($_); + push @output, $self->_expr($_); } } return join(" $OP ", @output); } - method _where_component(HashAST $ast) { + method _expr(HashAST $ast) { my $op = $ast->{-type}; - if (my $code = $self->lookup_where_dispatch($op)) { + $op = $ast->{op} if $op eq 'expr'; + + if (my $code = $self->lookup_expr_dispatch($op)) { return $code->($self, $ast); } - croak "'$op' is not a valid AST type in an expression" - if $op =~ /^-/; + croak "'$op' is not a valid AST type in an expression with " . dump($ast) + if $ast->{-type} ne 'expr'; - use Devel::PartialDump qw/dump/; - croak "'$op' is not a valid AST type in " . dump($ast); - - } - - method _expr(HashAST $ast) { - my $op = $ast->{op}; - my $meth = $self->lookup_where_dispatch($op) || confess "Invalid operator '$op'"; + croak "'$op' is not a valid operator in an expression with " . dump($ast); - $meth->($self, $ast); } method _binop(HashAST $ast) { my ($lhs, $rhs) = @{$ast->{args}}; my $op = $ast->{op}; - join (' ', $self->_where_component($lhs), + join (' ', $self->_expr($lhs), $self->binop_mapping($op) || croak("Unknown binary operator $op"), - $self->_where_component($rhs) + $self->_expr($rhs) ); } @@ -215,7 +211,7 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { return $self->_false unless @values; - return $self->_where_component($field) . + return $self->_expr($field) . $not . " IN (" . join(", ", map { $self->dispatch($_) } @values ) . diff --git a/t/101_where_error.t b/t/101_where_error.t deleted file mode 100644 index ec8287d..0000000 --- a/t/101_where_error.t +++ /dev/null @@ -1,26 +0,0 @@ -use strict; -use warnings; - -use Test::More tests => 3; -use Test::Exception; - -use_ok('SQL::Abstract') or BAIL_OUT( "$@" ); - -my $sqla = SQL::Abstract->create(1); - -throws_ok { - $sqla->dispatch( - [ -where => - [ '==', [-name => qw/me id/], [ -alias => [-name => qw/me foo/], 'bar' ] ] - ] - ) -} qr/^'-alias' is not a valid clause in a where AST/, "Error from invalid part in where"; - -throws_ok { - $sqla->dispatch( - [ -where => - [ '~', [-name => qw/me id/], [ -alias => [-name => qw/me foo/], 'bar' ] ] - ] - ) -} qr/^'~' is not a valid operator/, - "Error from invalid operator in where"; diff --git a/t/900_errors.t b/t/900_errors.t new file mode 100644 index 0000000..a78c4f2 --- /dev/null +++ b/t/900_errors.t @@ -0,0 +1,36 @@ +use strict; +use warnings; + +use Test::More tests => 3; +use Test::Exception; + +use_ok('SQL::Abstract') or BAIL_OUT( "$@" ); + +my $sqla = SQL::Abstract->create(1); + +throws_ok { + $sqla->dispatch( + { -type => 'expr', op => '==', + args => [ + { -type => 'name', args => [qw/me id/] }, + { -type => 'alias', ident => { -type => 'name', args => [qw/me id/] }, as => 'bar' } + ] + } + ) +} qr/^'alias' is not a valid AST type in an expression/, "Error from invalid part in where"; + +throws_ok { + $sqla->dispatch( + { -type => 'expr', op => '~' } + ) +} qr/^'~' is not a valid operator in an expression/ + +__END__ +throws_ok { + $sqla->dispatch( + { -where => + [ '~', [-name => qw/me id/], [ -alias => [-name => qw/me foo/], 'bar' ] ] + ] + ) +} qr/^'~' is not a valid operator/, + "Error from invalid operator in where";