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