Add dduncan's email comments for all to see
[dbsrgits/SQL-Abstract-2.0-ish.git] / lib / SQL / Abstract / Compat.pm
CommitLineData
0bcf772f 1use MooseX::Declare;
2
3class 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;
70 $args{name_sep} = $self->name_sep
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 $DB::single = 1;
84 return ($self->visitor->dispatch($ast), @{$self->visitor->binds});
68960b60 85 }
e76b9ff7 86
68960b60 87 method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
88 WhereType $where?,
89 WhereType $order?)
90 {
1c51edc4 91 my $ast = {
92 -type => 'select',
93 columns => [
94 map {
c7e5fddf 95 $self->mk_name(0, $_)
1c51edc4 96 } ( is_Str($fields) ? $fields : @$fields )
97 ],
98 tablespec => $self->tablespec($from)
99 };
0a18aa4f 100
1c51edc4 101
102 $ast->{where} = $self->recurse_where($where)
103 if defined $where;
e76b9ff7 104
105 if (defined $order) {
106 my @order = is_ArrayRef($order) ? @$order : $order;
107 $ast->{order_by} = [ map { $self->mk_name(0, $_) } @order ];
108 }
109
68960b60 110 return $ast;
0a18aa4f 111 }
bad761ba 112
0a18aa4f 113 method where(WhereType $where,
114 WhereType $order?)
115 {
116 my $ret = "";
117
118 if ($where) {
1c51edc4 119 my $ast = $self->recurse_where($where);
0a18aa4f 120 $ret .= "WHERE " . $self->visitor->_expr($ast);
121 }
122
123 return $ret;
7c300b3a 124 }
bad761ba 125
0a18aa4f 126
e76b9ff7 127 # method mk_name(Bool $use_convert, Str @names) {
1c51edc4 128 sub mk_name {
e76b9ff7 129 my ($self, $use_convert, @names) = @_;
130
131 @names = split /\Q@{[$self->name_sep]}\E/, $names[0]
132 if (@names == 1 && $self->has_name_sep);
133
134 my $ast = { -type => 'name', args => [ @names ] };
c7e5fddf 135
136 return $ast
137 unless $use_convert && $self->has_field_convertor;
138
139 return $self->apply_convert($ast);
1c51edc4 140 }
141
142 method tablespec(Str|ArrayRef|ScalarRef $from) {
c7e5fddf 143 return $self->mk_name(0, $from)
e76b9ff7 144 if is_Str($from);
145
146 return {
147 -type => 'list',
148 args => [ map {
149 $self->mk_name(0, $_)
150 } @$from ]
151 };
1c51edc4 152 }
153
154 method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
155 return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
156 return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
157 croak "Unknown where clause type " . dump($ast);
158 }
159
49cc8cb6 160 # Deals with where({ .... }) case
1c51edc4 161 method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
162 my @args;
163 my $ret = {
164 -type => 'expr',
165 op => lc $logic,
166 args => \@args
167 };
168
03f6671a 169 for my $key ( sort keys %$ast ) {
170 my $value = $ast->{$key};
171
1c51edc4 172 if ($key =~ /^-(or|and)$/) {
173 my $val = $self->recurse_where($value, uc $1);
174 if ($val->{op} eq $ret->{op}) {
175 push @args, @{$val->{args}};
176 }
177 else {
178 push @args, $val;
179 }
180 next;
181 }
182
183 push @args, $self->field($key, $value);
184 }
185
186 return $args[0] if @args == 1;
187
188 return $ret;
189 }
190
49cc8cb6 191 # Deals with where([ .... ]) case
1c51edc4 192 method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
193 my @args;
194 my $ret = {
195 -type => 'expr',
196 op => lc $logic,
197 args => \@args
198 };
199 my @nodes = @$ast;
200
201 while (my $key = shift @nodes) {
202 if ($key =~ /^-(or|and)$/) {
203 my $value = shift @nodes
204 or confess "missing value after $key at " . dump($ast);
205
206 my $val = $self->recurse_where($value, uc $1);
207 if ($val->{op} eq $ret->{op}) {
208 push @args, @{$val->{args}};
209 }
210 else {
211 push @args, $val;
212 }
213 next;
214 }
215
216 push @args, $self->recurse_where($key);
217 }
218
219 return $args[0] if @args == 1;
220
221 return $ret;
222 }
223
49cc8cb6 224 # { field => { .... } } case
63c2a607 225 method field_hash(Str $key, HashRef $value) returns (AST) {
226 my ($op, @rest) = keys %$value;
227
228 confess "Don't know how to handle " . dump($value) . " (too many keys)"
229 if @rest;
230
231 $value = $value->{$op};
232
1c51edc4 233 my $ret = {
234 -type => 'expr',
f94aef7f 235 op => $op,
1c51edc4 236 args => [
c7e5fddf 237 $self->mk_name(1, $key)
1c51edc4 238 ],
239 };
63c2a607 240 $ret->{op} = $op;
241
242 # TODO: Validate the op?
243 # 'word_like' operator
244 if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
245 $ret->{op} = lc $2;
246 $ret->{op} = "not_" . $ret->{op} if $1;
247
1c51edc4 248
68960b60 249 if (is_ArrayRef($value)) {
63c2a607 250 push @{$ret->{args}}, $self->value($_) for @{$value};
251 return $ret;
68960b60 252 }
1c51edc4 253 }
63c2a607 254
255 # Cases like:
256 # field => { '!=' => [ 'a','b','c'] }
257 # field => { '<' => [ 'a','b','c'] }
258 #
259 # *not* when op is a work or function operator - basic cmp operator only
260 if (is_ArrayRef($value)) {
261 local $self->{cmp} = $op;
262
263 my $ast = {
1c51edc4 264 -type => 'expr',
0073ca43 265 op => 'or',
1c51edc4 266 args => [ map {
63c2a607 267 $self->field($key, $_)
268 } @{$value} ]
1c51edc4 269 };
63c2a607 270 return $ast;
1c51edc4 271 }
63c2a607 272
273
274 push @{$ret->{args}}, $self->value($value);
275 return $ret;
276 }
277
278 # Handle [ { ... }, { ... } ]
279 method field_array(Str $key, ArrayRef $value) {
280 # Return an or clause, sort of.
281 return {
282 -type => 'expr',
283 op => 'or',
284 args => [ map {
285 $self->field($key, $_)
286 } @$value ]
287 };
288 }
289
290 method field(Str $key, $value) returns (AST) {
291
292 if (is_HashRef($value)) {
293 return $self->field_hash($key, $value);
1c51edc4 294 }
63c2a607 295 elsif (is_ArrayRef($value)) {
296 return $self->field_array($key, $value);
297 }
298
299 my $ret = {
300 -type => 'expr',
301 op => $CMP_MAP{$self->cmp} || $self->cmp,
302 args => [
303 $self->mk_name(1, $key),
304 $self->value($value)
305 ],
306 };
1c51edc4 307
308 return $ret;
309 }
310
311 method value($value) returns (AST) {
c7e5fddf 312 return $self->apply_convert( { -type => 'value', value => $value })
1c51edc4 313 if is_Str($value);
314
315 confess "Don't know how to handle terminal value " . dump($value);
316 }
317
c7e5fddf 318 method apply_convert(AST $ast) {
319 return $ast unless $self->has_field_convertor;
320
321 return {
322 -type => 'expr',
323 op => $self->convert,
324 args => [ $ast ]
325 };
326 }
327
1c51edc4 328
0bcf772f 329}
330
331=head1 NAME
332
333SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
334
335=head1 DESCRIPTION
336
337This class attempts to maintain the original behaviour of version 1 of
338SQL::Abstract. It does this by internally converting to an AST and then using
339the standard AST visitor.
340
341If so desired, you can get hold of this transformed AST somehow. This is aimed
342at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
343hashes as part of their public interface.
344
345=head1 AUTHOR
346
347Ash Berlin C<< <ash@cpan.org> >>
348
349=cut
350
3511;