Commit | Line | Data |
0bcf772f |
1 | use MooseX::Declare; |
2 | |
3 | class SQL::Abstract::Compat { |
7c300b3a |
4 | |
5 | use Moose::Util::TypeConstraints; |
bad761ba |
6 | use MooseX::Types::Moose qw/Str ScalarRef ArrayRef HashRef/; |
0a18aa4f |
7 | use SQL::Abstract::Types::Compat ':all'; |
e76b9ff7 |
8 | use SQL::Abstract::Types qw/AST NameSeparator QuoteChars/; |
0a18aa4f |
9 | use SQL::Abstract::AST::v1; |
10 | use Data::Dump qw/pp/; |
1c51edc4 |
11 | use Devel::PartialDump qw/dump/; |
12 | use Carp qw/croak/; |
bad761ba |
13 | |
0a18aa4f |
14 | class_type 'SQL::Abstract'; |
7c300b3a |
15 | |
16 | has logic => ( |
17 | is => 'rw', |
18 | isa => LogicEnum, |
aa0f2366 |
19 | default => 'AND', |
f94aef7f |
20 | coerce => 1, |
21 | required => 1, |
7c300b3a |
22 | ); |
23 | |
0a18aa4f |
24 | has visitor => ( |
25 | is => 'rw', |
26 | isa => 'SQL::Abstract', |
27 | clearer => 'clear_visitor', |
28 | lazy => 1, |
29 | builder => '_build_visitor', |
30 | ); |
bad761ba |
31 | |
f94aef7f |
32 | has cmp => ( |
33 | is => 'rw', |
34 | isa => 'Str', |
35 | default => '=', |
36 | required => 1, |
37 | ); |
38 | |
39 | our %CMP_MAP = ( |
40 | '=' => '==', |
41 | ); |
bad761ba |
42 | |
c7e5fddf |
43 | has convert => ( |
44 | is => 'rw', |
45 | isa => 'Str', |
46 | predicate => 'has_field_convertor' |
47 | ); |
48 | |
e76b9ff7 |
49 | # TODO: a metaclass trait to automatically use this on vistior construction |
50 | has quote_char => ( |
51 | is => 'rw', |
52 | isa => QuoteChars, |
53 | coerce => 1, |
54 | predicate => "has_quote_chars" |
55 | ); |
56 | |
57 | has name_sep => ( |
58 | is => 'rw', |
59 | isa => NameSeparator, |
60 | predicate => "has_name_sep" |
61 | ); |
62 | |
63 | method _build_visitor() { |
64 | my %args = ( |
65 | ast_version => 1 |
66 | ); |
67 | $args{quote_chars} = $self->quote_char |
68 | if $self->has_quote_chars; |
627dcb62 |
69 | $args{ident_separator} = $self->name_sep |
e76b9ff7 |
70 | if $self->has_name_sep; |
71 | |
72 | # TODO: this needs improving along with SQL::A::create |
73 | my $visitor = SQL::Abstract::AST::v1->new(%args); |
74 | } |
75 | |
7c300b3a |
76 | method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields, |
0a18aa4f |
77 | WhereType $where?, |
78 | WhereType $order?) |
79 | { |
68960b60 |
80 | my $ast = $self->select_ast($from,$fields,$where,$order); |
81 | |
e76b9ff7 |
82 | return ($self->visitor->dispatch($ast), @{$self->visitor->binds}); |
68960b60 |
83 | } |
e76b9ff7 |
84 | |
73e799a6 |
85 | method update(Str|ArrayRef|ScalarRef $from, |
86 | HashRef $fields, WhereType $where? ) |
87 | { |
99124578 |
88 | my $ast = $self->update_ast($from,$fields,$where); |
73e799a6 |
89 | |
90 | return ($self->visitor->dispatch($ast), @{$self->visitor->binds}); |
91 | } |
92 | |
93 | method update_ast(Str|ArrayRef|ScalarRef $from, |
94 | HashRef $fields, WhereType $where? ) |
95 | { |
946503a6 |
96 | my (@columns, @values); |
97 | my $ast = { |
98 | -type => 'update', |
99 | tablespec => $self->tablespec($from), |
100 | columns => \@columns, |
101 | values => \@values |
102 | }; |
103 | |
104 | for (keys %$fields) { |
105 | push @columns, $self->mk_name(0, $_); |
106 | push @values, { -type => 'value', value => $fields->{$_} }; |
107 | } |
108 | |
b6c45ef3 |
109 | $ast->{where} = $self->recurse_where($where) |
110 | if defined $where; |
111 | |
946503a6 |
112 | return $ast; |
73e799a6 |
113 | } |
114 | |
68960b60 |
115 | method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields, |
116 | WhereType $where?, |
117 | WhereType $order?) |
118 | { |
1c51edc4 |
119 | my $ast = { |
120 | -type => 'select', |
121 | columns => [ |
122 | map { |
c7e5fddf |
123 | $self->mk_name(0, $_) |
1c51edc4 |
124 | } ( is_Str($fields) ? $fields : @$fields ) |
125 | ], |
126 | tablespec => $self->tablespec($from) |
127 | }; |
0a18aa4f |
128 | |
1c51edc4 |
129 | |
130 | $ast->{where} = $self->recurse_where($where) |
131 | if defined $where; |
e76b9ff7 |
132 | |
133 | if (defined $order) { |
134 | my @order = is_ArrayRef($order) ? @$order : $order; |
135 | $ast->{order_by} = [ map { $self->mk_name(0, $_) } @order ]; |
136 | } |
137 | |
68960b60 |
138 | return $ast; |
0a18aa4f |
139 | } |
bad761ba |
140 | |
0a18aa4f |
141 | method where(WhereType $where, |
142 | WhereType $order?) |
143 | { |
144 | my $ret = ""; |
145 | |
146 | if ($where) { |
1c51edc4 |
147 | my $ast = $self->recurse_where($where); |
0a18aa4f |
148 | $ret .= "WHERE " . $self->visitor->_expr($ast); |
149 | } |
150 | |
151 | return $ret; |
7c300b3a |
152 | } |
bad761ba |
153 | |
0a18aa4f |
154 | |
e76b9ff7 |
155 | # method mk_name(Bool $use_convert, Str @names) { |
1c51edc4 |
156 | sub mk_name { |
e76b9ff7 |
157 | my ($self, $use_convert, @names) = @_; |
158 | |
159 | @names = split /\Q@{[$self->name_sep]}\E/, $names[0] |
160 | if (@names == 1 && $self->has_name_sep); |
161 | |
627dcb62 |
162 | my $ast = { -type => 'identifier', elements => [ @names ] }; |
c7e5fddf |
163 | |
164 | return $ast |
165 | unless $use_convert && $self->has_field_convertor; |
166 | |
167 | return $self->apply_convert($ast); |
1c51edc4 |
168 | } |
169 | |
170 | method tablespec(Str|ArrayRef|ScalarRef $from) { |
c7e5fddf |
171 | return $self->mk_name(0, $from) |
e76b9ff7 |
172 | if is_Str($from); |
173 | |
174 | return { |
175 | -type => 'list', |
176 | args => [ map { |
177 | $self->mk_name(0, $_) |
178 | } @$from ] |
179 | }; |
1c51edc4 |
180 | } |
181 | |
b6c45ef3 |
182 | method recurse_where(WhereType $ast, LogicEnum $logic?) { |
1c51edc4 |
183 | return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast); |
184 | return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast); |
185 | croak "Unknown where clause type " . dump($ast); |
186 | } |
187 | |
49cc8cb6 |
188 | # Deals with where({ .... }) case |
b6c45ef3 |
189 | method recurse_where_hash(LogicEnum $logic, HashRef $ast) { |
1c51edc4 |
190 | my @args; |
191 | my $ret = { |
192 | -type => 'expr', |
193 | op => lc $logic, |
194 | args => \@args |
195 | }; |
196 | |
03f6671a |
197 | for my $key ( sort keys %$ast ) { |
198 | my $value = $ast->{$key}; |
199 | |
1c51edc4 |
200 | if ($key =~ /^-(or|and)$/) { |
201 | my $val = $self->recurse_where($value, uc $1); |
202 | if ($val->{op} eq $ret->{op}) { |
203 | push @args, @{$val->{args}}; |
204 | } |
205 | else { |
206 | push @args, $val; |
207 | } |
208 | next; |
209 | } |
210 | |
211 | push @args, $self->field($key, $value); |
212 | } |
213 | |
214 | return $args[0] if @args == 1; |
215 | |
216 | return $ret; |
217 | } |
218 | |
49cc8cb6 |
219 | # Deals with where([ .... ]) case |
b6c45ef3 |
220 | method recurse_where_array(LogicEnum $logic, ArrayRef $ast) { |
1c51edc4 |
221 | my @args; |
222 | my $ret = { |
223 | -type => 'expr', |
224 | op => lc $logic, |
225 | args => \@args |
226 | }; |
227 | my @nodes = @$ast; |
228 | |
229 | while (my $key = shift @nodes) { |
230 | if ($key =~ /^-(or|and)$/) { |
231 | my $value = shift @nodes |
232 | or confess "missing value after $key at " . dump($ast); |
233 | |
234 | my $val = $self->recurse_where($value, uc $1); |
235 | if ($val->{op} eq $ret->{op}) { |
236 | push @args, @{$val->{args}}; |
237 | } |
238 | else { |
239 | push @args, $val; |
240 | } |
241 | next; |
242 | } |
243 | |
244 | push @args, $self->recurse_where($key); |
245 | } |
246 | |
247 | return $args[0] if @args == 1; |
248 | |
249 | return $ret; |
250 | } |
251 | |
49cc8cb6 |
252 | # { field => { .... } } case |
b6c45ef3 |
253 | method field_hash(Str $key, HashRef $value) { |
63c2a607 |
254 | my ($op, @rest) = keys %$value; |
255 | |
256 | confess "Don't know how to handle " . dump($value) . " (too many keys)" |
257 | if @rest; |
258 | |
259 | $value = $value->{$op}; |
260 | |
1c51edc4 |
261 | my $ret = { |
262 | -type => 'expr', |
f94aef7f |
263 | op => $op, |
1c51edc4 |
264 | args => [ |
c7e5fddf |
265 | $self->mk_name(1, $key) |
1c51edc4 |
266 | ], |
267 | }; |
63c2a607 |
268 | $ret->{op} = $op; |
269 | |
270 | # TODO: Validate the op? |
271 | # 'word_like' operator |
272 | if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) { |
273 | $ret->{op} = lc $2; |
274 | $ret->{op} = "not_" . $ret->{op} if $1; |
275 | |
1c51edc4 |
276 | |
68960b60 |
277 | if (is_ArrayRef($value)) { |
63c2a607 |
278 | push @{$ret->{args}}, $self->value($_) for @{$value}; |
279 | return $ret; |
68960b60 |
280 | } |
1c51edc4 |
281 | } |
63c2a607 |
282 | |
283 | # Cases like: |
284 | # field => { '!=' => [ 'a','b','c'] } |
285 | # field => { '<' => [ 'a','b','c'] } |
286 | # |
287 | # *not* when op is a work or function operator - basic cmp operator only |
288 | if (is_ArrayRef($value)) { |
289 | local $self->{cmp} = $op; |
290 | |
291 | my $ast = { |
1c51edc4 |
292 | -type => 'expr', |
0073ca43 |
293 | op => 'or', |
1c51edc4 |
294 | args => [ map { |
63c2a607 |
295 | $self->field($key, $_) |
296 | } @{$value} ] |
1c51edc4 |
297 | }; |
63c2a607 |
298 | return $ast; |
1c51edc4 |
299 | } |
63c2a607 |
300 | |
301 | |
302 | push @{$ret->{args}}, $self->value($value); |
303 | return $ret; |
304 | } |
305 | |
306 | # Handle [ { ... }, { ... } ] |
307 | method field_array(Str $key, ArrayRef $value) { |
308 | # Return an or clause, sort of. |
309 | return { |
310 | -type => 'expr', |
311 | op => 'or', |
312 | args => [ map { |
313 | $self->field($key, $_) |
314 | } @$value ] |
315 | }; |
316 | } |
317 | |
b6c45ef3 |
318 | method field(Str $key, $value) { |
63c2a607 |
319 | |
320 | if (is_HashRef($value)) { |
321 | return $self->field_hash($key, $value); |
1c51edc4 |
322 | } |
63c2a607 |
323 | elsif (is_ArrayRef($value)) { |
324 | return $self->field_array($key, $value); |
325 | } |
326 | |
327 | my $ret = { |
328 | -type => 'expr', |
329 | op => $CMP_MAP{$self->cmp} || $self->cmp, |
330 | args => [ |
331 | $self->mk_name(1, $key), |
332 | $self->value($value) |
333 | ], |
334 | }; |
1c51edc4 |
335 | |
336 | return $ret; |
337 | } |
338 | |
b6c45ef3 |
339 | method value($value) { |
c7e5fddf |
340 | return $self->apply_convert( { -type => 'value', value => $value }) |
1c51edc4 |
341 | if is_Str($value); |
342 | |
343 | confess "Don't know how to handle terminal value " . dump($value); |
344 | } |
345 | |
c7e5fddf |
346 | method apply_convert(AST $ast) { |
347 | return $ast unless $self->has_field_convertor; |
348 | |
349 | return { |
350 | -type => 'expr', |
351 | op => $self->convert, |
352 | args => [ $ast ] |
353 | }; |
354 | } |
355 | |
1c51edc4 |
356 | |
0bcf772f |
357 | } |
358 | |
359 | =head1 NAME |
360 | |
361 | SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx |
362 | |
363 | =head1 DESCRIPTION |
364 | |
365 | This class attempts to maintain the original behaviour of version 1 of |
366 | SQL::Abstract. It does this by internally converting to an AST and then using |
367 | the standard AST visitor. |
368 | |
369 | If so desired, you can get hold of this transformed AST somehow. This is aimed |
370 | at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or |
371 | hashes as part of their public interface. |
372 | |
373 | =head1 AUTHOR |
374 | |
375 | Ash Berlin C<< <ash@cpan.org> >> |
376 | |
377 | =cut |
378 | |
379 | 1; |