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 AST ArrayAST/;
clean;
- subtype NameSeparator,
- as ArrayRef[Str];
- #where { @$_ == 1 ||| @$_ == 2 },
- #message { "Name separator must be one or two elements" };
-
- coerce NameSeparator, from Str, via { [ $_ ] };
-
our $VERSION = '2.000000';
our $AST_VERSION = '1';
}
# Main entry point
- method generate(ClassName $class: ArrayRef $ast) {
+ method generate(ClassName $class: AST $ast) {
croak "SQL::Abstract AST version not specified"
unless ($ast->[0] eq '-ast_version');
$self->_clear_binds();
}
- method dispatch (ArrayRef $ast) {
-
- local $_ = $ast->[0];
- s/^-/_/ or croak "Unknown type tag '$_'";
+ method dispatch (AST $ast) {
+ # I want multi methods!
+ my $tag;
+ if (is_ArrayAST($ast)) {
+ ($tag = $ast->[0]) =~ s/^-/_/;
+ } else {
+ $tag = "_" . $ast->{-type};
+ }
- my $meth = $self->can($_) || croak "Unknown tag '$_'";
+ my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
return $meth->($self, $ast);
}
use Data::Dump qw/pp/;
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 Ref HashRef/;
use MooseX::AttributeHelpers;
+ use SQL::Abstract::Types qw/AST ArrayAST HashAST/;
clean;
};
}
- method _select(ArrayRef $ast) {
+ method _select(HashAST $ast) {
}
- method _where(ArrayRef $ast) {
+ method _where(ArrayAST $ast) {
my (undef, @clauses) = @$ast;
return 'WHERE ' . $self->_recurse_where(\@clauses);
}
- method _order_by(ArrayRef $ast) {
+ method _order_by(ArrayAST $ast) {
my (undef, @clauses) = @$ast;
my @output;
return "ORDER BY " . join(", ", @output);
}
- method _name(ArrayRef $ast) {
+ method _name(ArrayAST $ast) {
my (undef, @names) = @$ast;
my $sep = $self->name_separator;
return join($sep->[0], @names);
}
- method _join(ArrayRef $ast) {
- my (undef, @items) = @$ast;
+ method _join(HashAST $ast) {
- croak "invalid component in JOIN: $_" unless ArrayRef->check($items[0]);
- my @output = 'JOIN';
+ my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
+
+ $output .= exists $ast->{on}
+ ? ' ON (' . $self->_recurse_where( $ast->{on} )
+ : ' USING (' .$self->dispatch($ast->{using} || croak "No 'on' or 'join' clause passed to -join");
- # TODO: Validation of inputs
- return 'JOIN '. $self->dispatch(shift @items) .
- ' ON (' .
- $self->_recurse_where( \@items ) . ')';
+ $output .= ")";
+ return $output;
}
- method _list(ArrayRef $ast) {
+ method _list(ArrayAST $ast) {
my (undef, @items) = @$ast;
return join(
map { $self->dispatch($_) } @items);
}
- method _alias(ArrayRef $ast) {
+ method _alias(ArrayAST $ast) {
my (undef, $alias, $as) = @$ast;
return $self->dispatch($alias) . " AS $as";
}
- method _value(ArrayRef $ast) {
+ method _value(ArrayAST $ast) {
my ($undef, $value) = @$ast;
$self->add_bind($value);
return "?";
}
- method _recurse_where($clauses) {
+ method _recurse_where(ArrayRef $clauses) {
my $OP = 'AND';
my $prio = $SQL::Abstract::PRIO{and};
my $first = $clauses->[0];
- if (!ref $first && $first =~ /^-(and|or)$/) {
- $OP = uc($1);
- $prio = $SQL::Abstract::PRIO{$1};
- shift @$clauses;
+ if (!ref $first) {
+ if ($first =~ /^-(and|or)$/) {
+ $OP = uc($1);
+ $prio = $SQL::Abstract::PRIO{$1};
+ shift @$clauses;
+ } else {
+ $clauses = [ $clauses ];
+ }
}
my $dispatch_table = $self->where_dispatch_table;
my @output;
foreach (@$clauses) {
- croak "invalid component in where clause: $_" unless ArrayRef->check($_);
+ croak "invalid component in where clause: $_" unless is_ArrayRef($_);
my $op = $_->[0];
if ($op =~ /^-(and|or)$/) {
return join(" $OP ", @output);
}
- method _where_component($ast) {
+ method _where_component(ArrayRef $ast) {
my $op = $ast->[0];
if (my $code = $self->lookup_where_dispatch($op)) {
}
- method _binop($ast) {
+ method _binop(ArrayRef $ast) {
my ($op, $lhs, $rhs) = @$ast;
join (' ', $self->_where_component($lhs),
);
}
- method _in($ast) {
+ method _in(ArrayAST $ast) {
my ($tag, $field, @values) = @$ast;
my $not = $tag =~ /^-not/ ? " NOT" : "";
")";
}
- method _like($ast) {
- my ($tag, $field, @values) = @$ast;
-
- my $not = $tag =~ /^-not/ ? " NOT" : "";
-
- return $self->_false if @values == 0;
- return $self->_where_component($field) .
- $not.
- " LIKE " .
- join(", ", map { $self->_where_component($_) } @values ) .
- "";
- }
-
method _generic_func(ArrayRef $ast) {
}
--- /dev/null
+use MooseX::Declare;
+class SQL::Abstract::Types {
+ use Moose::Util::TypeConstraints;
+ use MooseX::Types -declare => [qw/NameSeparator AST ArrayAST HashAST/];
+ use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
+
+ subtype ArrayAST, as ArrayRef,
+ where { is_Str($_->[0]) && substr($_->[0],0,1) eq '-' },
+ message { "First key of arrayref must be a string starting with '-'"; };
+
+ subtype HashAST, as HashRef,
+ where { exists $_->{-type} && is_Str($_->{-type}) },
+ message { "No '-type' key, or it is not a string" };
+
+ subtype AST, as ArrayAST|HashAST;
+
+ subtype NameSeparator,
+ as ArrayRef[Str];
+ #where { @$_ == 1 ||| @$_ == 2 },
+ #message { "Name separator must be one or two elements" };
+
+ coerce NameSeparator, from Str, via { [ $_ ] };
+
+}
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
+use SQL::Abstract::Types ':all';
+
+is(ArrayAST->validate( [ -foo => 'bar' ] ), undef, "is_ArrayAST with valid" );
+ok(!is_ArrayAST( [ foo => 'bar' ] ), "is_ArrayAST with invalid" );
+
+
+is(HashAST->validate( { -type => 'select', select => [] } ), undef, "is_HashAST with valid" );
+ok(!is_HashAST( { foo => 'bar' } ), "is_HashAST with invalid" );
+
+
+is(AST->validate( { -type => 'select', select => [] } ), undef, "is_AST with valid hash" );
+is(AST->validate( [ -name => 1, 2 ] ), undef, "is_AST with valid array" );
+
+is(is_AST([ -name => qw/me id/]), 1);
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 3;
use Test::Differences;
use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
my $sqla = SQL::Abstract->create(1);
is $sqla->dispatch(
- [ -join =>
- [-name => qw/foo/],
- [ '==', [-name => qw/foo id/], [ -name => qw/me foo_id/ ] ]
- ]
+ { -type => 'join',
+ tablespec => [-name => qw/foo/],
+ on => [ '==', [-name => qw/foo id/], [ -name => qw/me foo_id/ ] ],
+ }
), "JOIN foo ON (foo.id = me.foo_id)",
"simple join clause";
+is $sqla->dispatch(
+ { -type => 'join',
+ tablespec => [-alias => [-name => qw/foo/], 'bar' ],
+ using => [ -name => qw/foo_id/ ]
+ }
+), "JOIN foo AS bar USING (foo_id)",
+ "using join clause";
projects / dbsrgits/SQL-Abstract-2.0-ish.git / commitdiff