Rename things and unify error handling a bit
Ash Berlin [Fri, 13 Mar 2009 20:55:16 +0000 (20:55 +0000)]
lib/SQL/Abstract.pm
lib/SQL/Abstract/AST/v1.pm
t/101_where_error.t [deleted file]
t/900_errors.t [new file with mode: 0644]

index b7c1565..3d6bd73 100644 (file)
@@ -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
index 95a7e80..3de8b66 100644 (file)
@@ -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 (file)
index ec8287d..0000000
+++ /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 (file)
index 0000000..a78c4f2
--- /dev/null
@@ -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";