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 QuoteChars AST HashAST ArrayAST/;
14 use Devel::PartialDump qw/dump/;
18 our $VERSION = '2.000000';
20 our $AST_VERSION = '1';
22 # Operator precedence for bracketing
33 # LIKE is always "field LIKE <value>"
35 '-not_like' => 'NOT LIKE',
38 has expr_dispatch_table => (
41 builder => '_build_expr_dispatch_table',
42 isa => HashRef[CodeRef],
43 metaclass => 'Collection::ImmutableHash',
45 get => 'lookup_expr_dispatch'
52 builder => '_build_binops',
54 metaclass => 'Collection::ImmutableHash',
56 exists => 'is_valid_binop',
57 get => 'binop_mapping',
58 keys => 'binary_operators'
62 # List of default binary operators (for in where clauses)
63 sub _build_binops { return {%BINOP_MAP} };
65 method _build_expr_dispatch_table {
66 my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!";
68 map { $_ => $binop } $self->binary_operators
78 has name_separator => (
86 has list_separator => (
97 predicate => 'is_quoting',
98 clearer => 'disable_quoting',
104 clearer => '_clear_binds',
106 default => sub { [ ] },
107 metaclass => 'Collection::Array',
113 # TODO: once MXMS supports %args, use that here
114 method create(ClassName $class: Int $ver) {
115 croak "AST version $ver is greater than supported version of $AST_VERSION"
116 if $ver > $AST_VERSION;
118 my $name = "${class}::AST::v$ver";
119 Class::MOP::load_class($name);
121 return $name->new(ast_version => $ver);
125 method generate(ClassName $class: HashAST $ast) {
126 my $ver = $ast->{-ast_version};
127 croak "SQL::Abstract AST version not specified"
130 # TODO: once MXMS supports %args, use that here
131 my $self = $class->create($ver);
133 return ($self->dispatch($ast), $self->binds);
137 $self->_clear_binds();
140 method dispatch (AST $ast) {
141 # I want multi methods!
143 if (is_ArrayAST($ast)) {
144 confess "FIX: " . dump($ast);
146 $tag = "_" . $ast->{-type};
149 my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
150 return $meth->($self, $ast);