From: Ash Berlin Date: Thu, 12 Mar 2009 22:57:27 +0000 (+0000) Subject: Refactor more things to fully hash based AST X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Abstract-2.0-ish.git;a=commitdiff_plain;h=a464be15784e1eda253d435dd39cf2ffb4f10dae Refactor more things to fully hash based AST --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index d689e58..b7c1565 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -10,7 +10,7 @@ class SQL::Abstract { use MooseX::Types -declare => [qw/NameSeparator/]; use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/; use MooseX::AttributeHelpers; - use SQL::Abstract::Types qw/NameSeparator QuoteChars AST ArrayAST/; + use SQL::Abstract::Types qw/NameSeparator QuoteChars AST HashAST ArrayAST/; clean; @@ -121,11 +121,10 @@ class SQL::Abstract { } # Main entry point - method generate(ClassName $class: AST $ast) { + method generate(ClassName $class: HashAST $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); diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm index 7aa1711..3135086 100644 --- a/lib/SQL/Abstract/AST/v1.pm +++ b/lib/SQL/Abstract/AST/v1.pm @@ -18,6 +18,8 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { %{super()}, in => $self->can('_in'), not_in => $self->can('_in'), + and => $self->can('_recurse_where'), + or => $self->can('_recurse_where'), map { +"$_" => $self->can("_$_") } qw/ value name @@ -142,28 +144,17 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { return "?"; } - method _recurse_where(ArrayRef $clauses) { + method _recurse_where(HashAST $ast) { - my $OP = 'AND'; - my $prio = $SQL::Abstract::PRIO{and}; - my $first = $clauses->[0]; + my $op = $ast->{op}; - if (!ref $first) { - if ($first =~ /^-(and|or)$/) { - $OP = uc($1); - $prio = $SQL::Abstract::PRIO{$1}; - shift @$clauses; - } else { - # If first is not a ref, and its not -and or -or, then $clauses - # contains just a single clause - $clauses = [ $clauses ]; - } - } + my $OP = uc $op; + my $prio = $SQL::Abstract::PRIO{$op}; my $dispatch_table = $self->where_dispatch_table; my @output; - foreach (@$clauses) { + foreach ( @{$ast->{args}} ) { croak "invalid component in where clause: $_" unless is_ArrayRef($_); my $op = $_->[0]; @@ -215,16 +206,18 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract { ); } - method _in(ArrayAST $ast) { - my ($tag, $field, @values) = @$ast; + method _in(HashAST $ast) { + + my ($field,$values) = @{$ast->{args}}; + + my $not = ($ast->{op} =~ /^-not/) ? " NOT" : ""; - my $not = $tag =~ /^-not/ ? " NOT" : ""; + return $self->_false if !defined $values || @$values == 0; - return $self->_false if @values == 0; return $self->_where_component($field) . $not. " IN (" . - join(", ", map { $self->dispatch($_) } @values ) . + join(", ", map { $self->dispatch($_) } @$values ) . ")"; } diff --git a/t/100_where_basic.t b/t/100_where_basic.t index 2012ed8..e175912 100644 --- a/t/100_where_basic.t +++ b/t/100_where_basic.t @@ -18,32 +18,59 @@ is $sqla->dispatch( } ), "me.id > ?", "simple where clause"; -__END__ + is $sqla->dispatch( - [ -in => [ ] ] + { -type => 'expr', op => 'in', args => [ ] } ), "0 = 1", "emtpy -in"; is $sqla->dispatch( - [ -where => - [ '>', [-name => qw/me id/], [-value => 500 ] ] - ] -), "WHERE me.id > ?", - "simple where clause"; + { -type => 'expr', + op => 'in', + args => [ { -type => 'name', args => ['foo'] } ], + } +), "0 = 1", "emtpy -in"; -eq_or_diff( [ SQL::Abstract->generate( - [ -ast_version => 1, - -where => - [ '>', [-name => qw/me id/], [-value => 500 ] ], - [ '==', [-name => qw/me name/], [-value => '200' ] ] +is $sqla->dispatch( + { -type => 'expr', + op => '>', + args => [ + {-type => 'name', args => [qw/me id/]}, + {-type => 'value', value => 500 } ] + } +), "me.id > ?", + "simple expr clause"; + +eq_or_diff( [ SQL::Abstract->generate( + { -ast_version => 1, + -type => 'expr', + op => 'and', + args => [ + { -type => 'expr', + op => '>', + args => [ + {-type => 'name', args => [qw/me id/]}, + {-type => 'value', value => 500 } + ] + }, + { -type => 'expr', + op => '==', + args => [ + {-type => 'name', args => [qw/me name/]}, + {-type => 'value', value => '200' } + ] + }, + ] + } ) ], - [ "WHERE me.id > ? AND me.name = ?", + [ "me.id > ? AND me.name = ?", [ 500, '200' ] ], "Where with binds" ); +__END__ is $sqla->dispatch(