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'; |
1c51edc4 |
8 | use SQL::Abstract::Types qw/AST/; |
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 | |
7c300b3a |
50 | method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields, |
0a18aa4f |
51 | WhereType $where?, |
52 | WhereType $order?) |
53 | { |
68960b60 |
54 | my $ast = $self->select_ast($from,$fields,$where,$order); |
55 | |
56 | return ($self->visitor->dispatch($ast), $self->visitor->binds); |
57 | } |
58 | method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields, |
59 | WhereType $where?, |
60 | WhereType $order?) |
61 | { |
1c51edc4 |
62 | my $ast = { |
63 | -type => 'select', |
64 | columns => [ |
65 | map { |
c7e5fddf |
66 | $self->mk_name(0, $_) |
1c51edc4 |
67 | } ( is_Str($fields) ? $fields : @$fields ) |
68 | ], |
69 | tablespec => $self->tablespec($from) |
70 | }; |
0a18aa4f |
71 | |
1c51edc4 |
72 | |
73 | $ast->{where} = $self->recurse_where($where) |
74 | if defined $where; |
68960b60 |
75 | return $ast; |
0a18aa4f |
76 | } |
bad761ba |
77 | |
0a18aa4f |
78 | method where(WhereType $where, |
79 | WhereType $order?) |
80 | { |
81 | my $ret = ""; |
82 | |
83 | if ($where) { |
1c51edc4 |
84 | my $ast = $self->recurse_where($where); |
0a18aa4f |
85 | $ret .= "WHERE " . $self->visitor->_expr($ast); |
86 | } |
87 | |
88 | return $ret; |
7c300b3a |
89 | } |
bad761ba |
90 | |
0a18aa4f |
91 | method _build_visitor() { |
92 | return SQL::Abstract->create(1); |
93 | } |
94 | |
1c51edc4 |
95 | sub mk_name { |
c7e5fddf |
96 | my ($self, $use_convert) = (shift,shift); |
97 | my $ast = { -type => 'name', args => [ @_ ] }; |
98 | |
99 | return $ast |
100 | unless $use_convert && $self->has_field_convertor; |
101 | |
102 | return $self->apply_convert($ast); |
1c51edc4 |
103 | } |
104 | |
105 | method tablespec(Str|ArrayRef|ScalarRef $from) { |
c7e5fddf |
106 | return $self->mk_name(0, $from) |
1c51edc4 |
107 | if is_Str($from); |
108 | } |
109 | |
110 | method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) { |
111 | return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast); |
112 | return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast); |
113 | croak "Unknown where clause type " . dump($ast); |
114 | } |
115 | |
49cc8cb6 |
116 | # Deals with where({ .... }) case |
1c51edc4 |
117 | method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) { |
118 | my @args; |
119 | my $ret = { |
120 | -type => 'expr', |
121 | op => lc $logic, |
122 | args => \@args |
123 | }; |
124 | |
03f6671a |
125 | for my $key ( sort keys %$ast ) { |
126 | my $value = $ast->{$key}; |
127 | |
1c51edc4 |
128 | if ($key =~ /^-(or|and)$/) { |
129 | my $val = $self->recurse_where($value, uc $1); |
130 | if ($val->{op} eq $ret->{op}) { |
131 | push @args, @{$val->{args}}; |
132 | } |
133 | else { |
134 | push @args, $val; |
135 | } |
136 | next; |
137 | } |
138 | |
139 | push @args, $self->field($key, $value); |
140 | } |
141 | |
142 | return $args[0] if @args == 1; |
143 | |
144 | return $ret; |
145 | } |
146 | |
49cc8cb6 |
147 | # Deals with where([ .... ]) case |
1c51edc4 |
148 | method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) { |
149 | my @args; |
150 | my $ret = { |
151 | -type => 'expr', |
152 | op => lc $logic, |
153 | args => \@args |
154 | }; |
155 | my @nodes = @$ast; |
156 | |
157 | while (my $key = shift @nodes) { |
158 | if ($key =~ /^-(or|and)$/) { |
159 | my $value = shift @nodes |
160 | or confess "missing value after $key at " . dump($ast); |
161 | |
162 | my $val = $self->recurse_where($value, uc $1); |
163 | if ($val->{op} eq $ret->{op}) { |
164 | push @args, @{$val->{args}}; |
165 | } |
166 | else { |
167 | push @args, $val; |
168 | } |
169 | next; |
170 | } |
171 | |
172 | push @args, $self->recurse_where($key); |
173 | } |
174 | |
175 | return $args[0] if @args == 1; |
176 | |
177 | return $ret; |
178 | } |
179 | |
49cc8cb6 |
180 | # { field => { .... } } case |
63c2a607 |
181 | method field_hash(Str $key, HashRef $value) returns (AST) { |
182 | my ($op, @rest) = keys %$value; |
183 | |
184 | confess "Don't know how to handle " . dump($value) . " (too many keys)" |
185 | if @rest; |
186 | |
187 | $value = $value->{$op}; |
188 | |
1c51edc4 |
189 | my $ret = { |
190 | -type => 'expr', |
f94aef7f |
191 | op => $op, |
1c51edc4 |
192 | args => [ |
c7e5fddf |
193 | $self->mk_name(1, $key) |
1c51edc4 |
194 | ], |
195 | }; |
63c2a607 |
196 | $ret->{op} = $op; |
197 | |
198 | # TODO: Validate the op? |
199 | # 'word_like' operator |
200 | if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) { |
201 | $ret->{op} = lc $2; |
202 | $ret->{op} = "not_" . $ret->{op} if $1; |
203 | |
1c51edc4 |
204 | |
68960b60 |
205 | if (is_ArrayRef($value)) { |
63c2a607 |
206 | push @{$ret->{args}}, $self->value($_) for @{$value}; |
207 | return $ret; |
68960b60 |
208 | } |
1c51edc4 |
209 | } |
63c2a607 |
210 | |
211 | # Cases like: |
212 | # field => { '!=' => [ 'a','b','c'] } |
213 | # field => { '<' => [ 'a','b','c'] } |
214 | # |
215 | # *not* when op is a work or function operator - basic cmp operator only |
216 | if (is_ArrayRef($value)) { |
217 | local $self->{cmp} = $op; |
218 | |
219 | my $ast = { |
1c51edc4 |
220 | -type => 'expr', |
63c2a607 |
221 | |
222 | # Handle e => { '!=', [qw(f g)] }. |
223 | # SQLA treats this as a 'DWIM' since e != f AND e != g doesn't make sense |
224 | op => $op eq '!=' ? 'or' : 'and', |
1c51edc4 |
225 | args => [ map { |
63c2a607 |
226 | $self->field($key, $_) |
227 | } @{$value} ] |
1c51edc4 |
228 | }; |
63c2a607 |
229 | return $ast; |
1c51edc4 |
230 | } |
63c2a607 |
231 | |
232 | |
233 | push @{$ret->{args}}, $self->value($value); |
234 | return $ret; |
235 | } |
236 | |
237 | # Handle [ { ... }, { ... } ] |
238 | method field_array(Str $key, ArrayRef $value) { |
239 | # Return an or clause, sort of. |
240 | return { |
241 | -type => 'expr', |
242 | op => 'or', |
243 | args => [ map { |
244 | $self->field($key, $_) |
245 | } @$value ] |
246 | }; |
247 | } |
248 | |
249 | method field(Str $key, $value) returns (AST) { |
250 | |
251 | if (is_HashRef($value)) { |
252 | return $self->field_hash($key, $value); |
1c51edc4 |
253 | } |
63c2a607 |
254 | elsif (is_ArrayRef($value)) { |
255 | return $self->field_array($key, $value); |
256 | } |
257 | |
258 | my $ret = { |
259 | -type => 'expr', |
260 | op => $CMP_MAP{$self->cmp} || $self->cmp, |
261 | args => [ |
262 | $self->mk_name(1, $key), |
263 | $self->value($value) |
264 | ], |
265 | }; |
1c51edc4 |
266 | |
267 | return $ret; |
268 | } |
269 | |
270 | method value($value) returns (AST) { |
c7e5fddf |
271 | return $self->apply_convert( { -type => 'value', value => $value }) |
1c51edc4 |
272 | if is_Str($value); |
273 | |
274 | confess "Don't know how to handle terminal value " . dump($value); |
275 | } |
276 | |
c7e5fddf |
277 | method apply_convert(AST $ast) { |
278 | return $ast unless $self->has_field_convertor; |
279 | |
280 | return { |
281 | -type => 'expr', |
282 | op => $self->convert, |
283 | args => [ $ast ] |
284 | }; |
285 | } |
286 | |
1c51edc4 |
287 | |
0bcf772f |
288 | } |
289 | |
290 | =head1 NAME |
291 | |
292 | SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx |
293 | |
294 | =head1 DESCRIPTION |
295 | |
296 | This class attempts to maintain the original behaviour of version 1 of |
297 | SQL::Abstract. It does this by internally converting to an AST and then using |
298 | the standard AST visitor. |
299 | |
300 | If so desired, you can get hold of this transformed AST somehow. This is aimed |
301 | at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or |
302 | hashes as part of their public interface. |
303 | |
304 | =head1 AUTHOR |
305 | |
306 | Ash Berlin C<< <ash@cpan.org> >> |
307 | |
308 | =cut |
309 | |
310 | 1; |