Commit | Line | Data |
a0185af2 |
1 | use MooseX::Declare; |
a0185af2 |
2 | |
a0185af2 |
3 | class SQL::Abstract { |
4 | |
5 | use Carp qw/croak/; |
6 | use Data::Dump qw/pp/; |
7 | |
8 | use Moose::Util::TypeConstraints; |
0c371882 |
9 | use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/; |
4769c837 |
10 | use MooseX::AttributeHelpers; |
a464be15 |
11 | use SQL::Abstract::Types qw/NameSeparator QuoteChars AST HashAST ArrayAST/; |
747f7c21 |
12 | use Devel::PartialDump qw/dump/; |
4769c837 |
13 | |
c314b35d |
14 | clean; |
a0185af2 |
15 | |
a0185af2 |
16 | our $VERSION = '2.000000'; |
17 | |
18 | our $AST_VERSION = '1'; |
19 | |
3e63a4d5 |
20 | # Operator precedence for bracketing |
21 | our %PRIO = ( |
22 | and => 10, |
23 | or => 50 |
24 | ); |
25 | |
0bf8a8c4 |
26 | our %BINOP_MAP = ( |
3e63a4d5 |
27 | '>' => '>', |
28 | '<' => '<', |
29 | '==' => '=', |
30 | '!=' => '!=', |
0bf8a8c4 |
31 | # LIKE is always "field LIKE <value>" |
1b85673a |
32 | '-like' => 'LIKE', |
0bf8a8c4 |
33 | '-not_like' => 'NOT LIKE', |
3e63a4d5 |
34 | ); |
35 | |
ef0d6124 |
36 | has expr_dispatch_table => ( |
0bf8a8c4 |
37 | is => 'ro', |
eb22ecd3 |
38 | lazy => 1, |
ef0d6124 |
39 | builder => '_build_expr_dispatch_table', |
0c371882 |
40 | isa => HashRef[CodeRef], |
41 | metaclass => 'Collection::ImmutableHash', |
42 | provides => { |
ef0d6124 |
43 | get => 'lookup_expr_dispatch' |
0c371882 |
44 | } |
0bf8a8c4 |
45 | ); |
46 | |
47 | has binop_map => ( |
48 | is => 'ro', |
eb22ecd3 |
49 | lazy => 1, |
50 | builder => '_build_binops', |
0bf8a8c4 |
51 | isa => HashRef, |
52 | metaclass => 'Collection::ImmutableHash', |
53 | provides => { |
54 | exists => 'is_valid_binop', |
55 | get => 'binop_mapping', |
56 | keys => 'binary_operators' |
57 | } |
58 | ); |
59 | |
eb22ecd3 |
60 | # List of default binary operators (for in where clauses) |
61 | sub _build_binops { return {%BINOP_MAP} }; |
0bf8a8c4 |
62 | |
ef0d6124 |
63 | method _build_expr_dispatch_table { |
0c371882 |
64 | my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!"; |
0bf8a8c4 |
65 | return { |
66 | map { $_ => $binop } $self->binary_operators |
67 | } |
68 | } |
69 | |
c314b35d |
70 | has ast_version => ( |
71 | is => 'ro', |
72 | isa => Int, |
73 | required => 1 |
74 | ); |
75 | |
a0185af2 |
76 | has name_separator => ( |
77 | is => 'rw', |
78 | isa => NameSeparator, |
4ee32f41 |
79 | default => '.', |
a0185af2 |
80 | coerece => 1, |
81 | required => 1, |
82 | ); |
83 | |
84 | has list_separator => ( |
85 | is => 'rw', |
86 | isa => Str, |
87 | default => ', ', |
88 | required => 1, |
89 | ); |
90 | |
4ee32f41 |
91 | has quote_chars => ( |
92 | is => 'rw', |
93 | isa => QuoteChars, |
94 | coerece => 1, |
95 | predicate => 'is_quoting', |
96 | clearer => 'disable_quoting', |
97 | ); |
98 | |
4769c837 |
99 | has binds => ( |
100 | isa => ArrayRef, |
5bf8c024 |
101 | is => 'ro', |
0bf8a8c4 |
102 | clearer => '_clear_binds', |
103 | lazy => 1, |
4769c837 |
104 | default => sub { [ ] }, |
105 | metaclass => 'Collection::Array', |
106 | provides => { |
107 | push => 'add_bind', |
4769c837 |
108 | } |
109 | ); |
110 | |
14774be0 |
111 | # TODO: once MXMS supports %args, use that here |
112 | method create(ClassName $class: Int $ver) { |
113 | croak "AST version $ver is greater than supported version of $AST_VERSION" |
114 | if $ver > $AST_VERSION; |
115 | |
116 | my $name = "${class}::AST::v$ver"; |
117 | Class::MOP::load_class($name); |
118 | |
119 | return $name->new(ast_version => $ver); |
c314b35d |
120 | } |
121 | |
122 | # Main entry point |
a464be15 |
123 | method generate(ClassName $class: HashAST $ast) { |
124 | my $ver = $ast->{-ast_version}; |
c314b35d |
125 | croak "SQL::Abstract AST version not specified" |
a464be15 |
126 | unless defined $ver; |
c314b35d |
127 | |
14774be0 |
128 | # TODO: once MXMS supports %args, use that here |
129 | my $self = $class->create($ver); |
c314b35d |
130 | |
131 | return ($self->dispatch($ast), $self->binds); |
132 | } |
133 | |
0bf8a8c4 |
134 | method reset() { |
135 | $self->_clear_binds(); |
136 | } |
137 | |
cbcfedc1 |
138 | method dispatch (AST $ast) { |
f7dc4536 |
139 | |
140 | |
cbcfedc1 |
141 | # I want multi methods! |
142 | my $tag; |
143 | if (is_ArrayAST($ast)) { |
747f7c21 |
144 | confess "FIX: " . dump($ast); |
cbcfedc1 |
145 | } else { |
146 | $tag = "_" . $ast->{-type}; |
147 | } |
0bf8a8c4 |
148 | |
cbcfedc1 |
149 | my $meth = $self->can($tag) || croak "Unknown tag '$tag'"; |
0bf8a8c4 |
150 | return $meth->($self, $ast); |
151 | } |
4769c837 |
152 | |
a0185af2 |
153 | }; |