9 use Moose::Util::TypeConstraints;
10 use MooseX::Types -declare => [qw/NameSeparator/];
11 use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
12 use MooseX::AttributeHelpers;
13 use SQL::Abstract::Types qw/NameSeparator AST ArrayAST/;
17 our $VERSION = '2.000000';
19 our $AST_VERSION = '1';
21 # Operator precedence for bracketing
32 # LIKE is always "field LIKE <value>"
34 '-not_like' => 'NOT LIKE',
37 has where_dispatch_table => (
40 builder => '_build_where_dispatch_table',
41 isa => HashRef[CodeRef],
42 metaclass => 'Collection::ImmutableHash',
44 get => 'lookup_where_dispatch'
51 builder => '_build_binops',
53 metaclass => 'Collection::ImmutableHash',
55 exists => 'is_valid_binop',
56 get => 'binop_mapping',
57 keys => 'binary_operators'
61 # List of default binary operators (for in where clauses)
62 sub _build_binops { return {%BINOP_MAP} };
64 method _build_where_dispatch_table {
65 my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!";
67 map { $_ => $binop } $self->binary_operators
77 has name_separator => (
80 default => sub { ['.'] },
85 has list_separator => (
95 clearer => '_clear_binds',
97 default => sub { [ ] },
98 metaclass => 'Collection::Array',
104 # TODO: once MXMS supports %args, use that here
105 method create(ClassName $class: Int $ver) {
106 croak "AST version $ver is greater than supported version of $AST_VERSION"
107 if $ver > $AST_VERSION;
109 my $name = "${class}::AST::v$ver";
110 Class::MOP::load_class($name);
112 return $name->new(ast_version => $ver);
116 method generate(ClassName $class: AST $ast) {
117 croak "SQL::Abstract AST version not specified"
118 unless ($ast->[0] eq '-ast_version');
120 my (undef, $ver) = splice(@$ast, 0, 2);
122 # TODO: once MXMS supports %args, use that here
123 my $self = $class->create($ver);
125 return ($self->dispatch($ast), $self->binds);
129 $self->_clear_binds();
132 method dispatch (AST $ast) {
133 # I want multi methods!
135 if (is_ArrayAST($ast)) {
136 ($tag = $ast->[0]) =~ s/^-/_/;
138 $tag = "_" . $ast->{-type};
141 my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
142 return $meth->($self, $ast);