Commit | Line | Data |
1ff9018c |
1 | package SQL::Abstract::ExtraClauses; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use if $] < '5.010', 'MRO::Compat'; |
6 | use mro 'c3'; |
a3040091 |
7 | use base qw(SQL::Abstract); |
1ff9018c |
8 | |
9 | BEGIN { *puke = \&SQL::Abstract::puke } |
10 | |
a3040091 |
11 | sub new { |
12 | my $self = shift->next::method(@_); |
2b0b3d43 |
13 | my @clauses = $self->clauses_of('select'); |
14 | my @before_setop; |
15 | CLAUSE: foreach my $idx (0..$#clauses) { |
16 | if ($clauses[$idx] eq 'order_by') { |
17 | @before_setop = @clauses[0..$idx-1]; |
18 | splice(@clauses, $idx, 0, qw(setop group_by having)); |
19 | last CLAUSE; |
20 | } |
21 | } |
22 | die "Huh?" unless @before_setop; |
1ba47f38 |
23 | $self->clauses_of(select => 'with', @clauses); |
58ebc7fa |
24 | $self->clause_expanders( |
25 | 'select.group_by', sub { |
fe8b493f |
26 | $_[0]->_expand_maybe_list_expr($_[2], -ident) |
58ebc7fa |
27 | }, |
fe8b493f |
28 | 'select.having', sub { $_[0]->expand_expr($_[2]) }, |
58ebc7fa |
29 | ); |
a6227174 |
30 | foreach my $thing (qw(join from_list)) { |
31 | $self->expander($thing => "_expand_${thing}") |
32 | ->renderer($thing => "_render_${thing}") |
33 | } |
555ad787 |
34 | $self->op_expander(as => '_expand_op_as'); |
35 | $self->expander(as => '_expand_op_as'); |
36 | $self->renderer(as => '_render_as'); |
984db0d7 |
37 | $self->expander(alias => sub { |
38 | my ($self, undef, $args) = @_; |
39 | if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) { |
40 | $args = $alias; |
41 | } |
42 | +{ -alias => [ |
43 | map $self->expand_expr($_, -ident), |
44 | ref($args) eq 'ARRAY' ? @{$args} : $args |
45 | ] |
46 | } |
47 | }); |
48 | $self->renderer(alias => '_render_alias'); |
58ebc7fa |
49 | |
ee706e89 |
50 | $self->clauses_of(update => sub { |
51 | my ($self, @clauses) = @_; |
52 | splice(@clauses, 2, 0, 'from'); |
53 | @clauses; |
54 | }); |
55 | |
56 | $self->clauses_of(delete => sub { |
57 | my ($self, @clauses) = @_; |
58 | splice(@clauses, 1, 0, 'using'); |
59 | @clauses; |
60 | }); |
61 | |
58ebc7fa |
62 | $self->clause_expanders( |
63 | 'update.from' => '_expand_select_clause_from', |
64 | 'delete.using' => sub { |
fe8b493f |
65 | +(using => $_[0]->_expand_from_list(undef, $_[2])); |
58ebc7fa |
66 | }, |
67 | 'insert.rowvalues' => sub { |
fe8b493f |
68 | +(from => $_[0]->expand_expr({ -values => $_[2] })); |
58ebc7fa |
69 | }, |
70 | 'insert.select' => sub { |
fe8b493f |
71 | +(from => $_[0]->expand_expr({ -select => $_[2] })); |
58ebc7fa |
72 | }, |
73 | ); |
26994fdd |
74 | |
2b0b3d43 |
75 | # set ops |
3f9899e5 |
76 | $self->wrap_expander(select => sub { |
77 | my $orig = shift; |
78 | sub { |
2b0b3d43 |
79 | my $self = shift; |
80 | my $exp = $self->$orig(@_); |
81 | return $exp unless my $setop = (my $sel = $exp->{-select})->{setop}; |
82 | if (my @keys = grep $sel->{$_}, @before_setop) { |
83 | my %inner; @inner{@keys} = delete @{$sel}{@keys}; |
84 | unshift @{(values(%$setop))[0]{queries}}, |
85 | { -select => \%inner }; |
86 | } |
87 | return $exp; |
3f9899e5 |
88 | } |
89 | }); |
d175037f |
90 | my $expand_setop = sub { |
91 | my ($self, $setop, $args) = @_; |
92 | +{ "-${setop}" => { |
2b0b3d43 |
93 | %$args, |
94 | queries => [ map $self->expand_expr($_), @{$args->{queries}} ], |
95 | } }; |
d175037f |
96 | }; |
97 | $self->expanders(map +($_ => $expand_setop), qw(union intersect except)); |
2b0b3d43 |
98 | |
99 | $self->clause_renderer('select.setop' => sub { |
fe8b493f |
100 | my ($self, undef, $setop) = @_; |
3f312d2e |
101 | $self->render_aqt($setop); |
2b0b3d43 |
102 | }); |
103 | |
260e0f29 |
104 | $self->renderer($_ => sub { |
105 | my ($self, $setop, $args) = @_; |
0236f122 |
106 | $self->join_query_parts( |
260e0f29 |
107 | ' '.$self->format_keyword(join '_', $setop, ($args->{type}||())).' ', |
a1f8b6ef |
108 | @{$args->{queries}} |
260e0f29 |
109 | ); |
110 | }) for qw(union intersect except); |
111 | |
f61bfd7b |
112 | my $setop_expander = sub { |
113 | my ($self, $setop, $args) = @_; |
114 | my ($op, $type) = split '_', $setop; |
115 | +(setop => $self->expand_expr({ |
116 | "-${op}" => { |
117 | ($type ? (type => $type) : ()), |
118 | queries => (ref($args) eq 'ARRAY' ? $args : [ $args ]) |
119 | } |
120 | })); |
121 | }; |
122 | |
123 | $self->clause_expanders( |
124 | map +($_ => $setop_expander), |
125 | map "select.${_}", |
126 | map +($_, "${_}_all", "${_}_distinct"), |
127 | qw(union intersect except) |
128 | ); |
d175037f |
129 | |
1ba47f38 |
130 | $self->clause_expander('select.with' => my $with_expander = sub { |
7237eb3c |
131 | my ($self, $name, $with) = @_; |
132 | my (undef, $type) = split '_', $name; |
1ba47f38 |
133 | if (ref($with) eq 'HASH') { |
134 | return +{ |
135 | %$with, |
38e67490 |
136 | queries => [ |
137 | map +[ |
984db0d7 |
138 | $self->expand_expr({ -alias => $_->[0] }, -ident), |
38e67490 |
139 | $self->expand_expr($_->[1]), |
140 | ], @{$with->{queries}} |
141 | ] |
1ba47f38 |
142 | } |
143 | } |
144 | my @with = @$with; |
145 | my @exp; |
38e67490 |
146 | while (my ($alias, $query) = splice @with, 0, 2) { |
1ba47f38 |
147 | push @exp, [ |
984db0d7 |
148 | $self->expand_expr({ -alias => $alias }, -ident), |
1ba47f38 |
149 | $self->expand_expr($query) |
150 | ]; |
151 | } |
7237eb3c |
152 | return +(with => { ($type ? (type => $type) : ()), queries => \@exp }); |
1ba47f38 |
153 | }); |
7237eb3c |
154 | $self->clause_expander('select.with_recursive', $with_expander); |
a97ecd95 |
155 | $self->clause_renderer('select.with' => my $with_renderer = sub { |
fe8b493f |
156 | my ($self, undef, $with) = @_; |
3f312d2e |
157 | my $q_part = $self->join_query_parts(', ', |
1ba47f38 |
158 | map { |
159 | my ($alias, $query) = @$_; |
3f312d2e |
160 | $self->join_query_parts(' ', |
984db0d7 |
161 | $alias, |
7b811acd |
162 | $self->format_keyword('as'), |
a1f8b6ef |
163 | $query, |
3f312d2e |
164 | ) |
1ba47f38 |
165 | } @{$with->{queries}} |
3f312d2e |
166 | ); |
0236f122 |
167 | return $self->join_query_parts(' ', |
7b811acd |
168 | $self->format_keyword(join '_', 'with', ($with->{type}||'')), |
1ba47f38 |
169 | $q_part, |
1ba47f38 |
170 | ); |
171 | }); |
a97ecd95 |
172 | foreach my $stmt (qw(insert update delete)) { |
173 | $self->clauses_of($stmt => 'with', $self->clauses_of($stmt)); |
174 | $self->clause_expander("${stmt}.$_", $with_expander) |
175 | for qw(with with_recursive); |
176 | $self->clause_renderer("${stmt}.with", $with_renderer); |
177 | } |
a867b2df |
178 | $self->expander(cast => sub { |
e07de273 |
179 | return { -func => [ cast => $_[2] ] } if ref($_[2]) eq 'HASH'; |
a867b2df |
180 | my ($cast, $to) = @{$_[2]}; |
181 | +{ -func => [ cast => { -as => [ |
182 | $self->expand_expr($cast), |
183 | $self->expand_expr($to, -ident), |
184 | ] } ] }; |
185 | }); |
2b0b3d43 |
186 | |
b4546197 |
187 | return $self; |
1ff9018c |
188 | } |
189 | |
7741b7ad |
190 | sub _expand_select_clause_from { |
fe8b493f |
191 | my ($self, undef, $from) = @_; |
7741b7ad |
192 | +(from => $self->_expand_from_list(undef, $from)); |
193 | } |
194 | |
195 | sub _expand_from_list { |
196 | my ($self, undef, $args) = @_; |
197 | if (ref($args) eq 'HASH') { |
38e67490 |
198 | return $args if $args->{-from_list}; |
7741b7ad |
199 | return { -from_list => [ $self->expand_expr($args) ] }; |
200 | } |
201 | my @list; |
86a6ebf4 |
202 | my @args = ref($args) eq 'ARRAY' ? @$args : ($args); |
7741b7ad |
203 | while (my $entry = shift @args) { |
b99e9a14 |
204 | if (!ref($entry) and $entry =~ /^-(.*)/) { |
205 | if ($1 eq 'as') { |
206 | $list[-1] = $self->expand_expr({ -as => [ |
207 | $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args) |
208 | ]}); |
209 | next; |
210 | } |
7741b7ad |
211 | $entry = { $entry => shift @args }; |
212 | } |
213 | my $aqt = $self->expand_expr($entry, -ident); |
214 | if ($aqt->{-join} and not $aqt->{-join}{from}) { |
215 | $aqt->{-join}{from} = pop @list; |
216 | } |
217 | push @list, $aqt; |
218 | } |
219 | return { -from_list => \@list }; |
220 | } |
221 | |
222 | sub _expand_join { |
223 | my ($self, undef, $args) = @_; |
224 | my %proto = ( |
225 | ref($args) eq 'HASH' |
226 | ? %$args |
227 | : (to => $args->[0], @{$args}[1..$#$args]) |
228 | ); |
b99e9a14 |
229 | if (my $as = delete $proto{as}) { |
984db0d7 |
230 | $proto{to} = $self->expand_expr({ -as => [ $proto{to}, $as ] }); |
b99e9a14 |
231 | } |
e0eb8d26 |
232 | if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') { |
13c99dad |
233 | $proto{using} = [ |
e0eb8d26 |
234 | map [ $self->expand_expr($_, -ident) ], |
235 | ref($using) eq 'ARRAY' ? @$using: $using |
13c99dad |
236 | ]; |
e0eb8d26 |
237 | } |
7741b7ad |
238 | my %ret = map +($_ => $self->expand_expr($proto{$_}, -ident)), |
239 | sort keys %proto; |
240 | return +{ -join => \%ret }; |
241 | } |
242 | |
243 | sub _render_from_list { |
a01911a2 |
244 | my ($self, undef, $list) = @_; |
a1f8b6ef |
245 | return $self->join_query_parts(', ', @$list); |
7741b7ad |
246 | } |
247 | |
248 | sub _render_join { |
a01911a2 |
249 | my ($self, undef, $args) = @_; |
7741b7ad |
250 | |
251 | my @parts = ( |
412f9efe |
252 | $args->{from}, |
253 | $self->format_keyword(join '_', ($args->{type}||()), 'join'), |
51ccda04 |
254 | (map +($_->{-ident} || $_->{-as} ? $_ : ('(', $_, ')')), $args->{to}), |
7741b7ad |
255 | ($args->{on} ? ( |
412f9efe |
256 | $self->format_keyword('on') , |
257 | $args->{on}, |
7741b7ad |
258 | ) : ()), |
259 | ($args->{using} ? ( |
412f9efe |
260 | $self->format_keyword('using'), |
13c99dad |
261 | '(', $args->{using}, ')', |
7741b7ad |
262 | ) : ()), |
263 | ); |
0236f122 |
264 | return $self->join_query_parts(' ', @parts); |
7741b7ad |
265 | } |
266 | |
b99e9a14 |
267 | sub _expand_op_as { |
268 | my ($self, undef, $vv, $k) = @_; |
984db0d7 |
269 | my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv); |
270 | $k ||= shift @vv; |
271 | my $ik = $self->expand_expr($k, -ident); |
272 | return +{ -as => [ $ik, $self->expand_expr($vv[0], -alias) ] } |
273 | if @vv == 1 and ref($vv[0]) eq 'HASH'; |
274 | |
275 | my @as = map $self->expand_expr($_, -ident), @vv; |
276 | return { -as => [ $ik, { -alias => \@as } ] }; |
b99e9a14 |
277 | } |
278 | |
279 | sub _render_as { |
a01911a2 |
280 | my ($self, undef, $args) = @_; |
984db0d7 |
281 | my ($thing, $alias) = @$args; |
0236f122 |
282 | return $self->join_query_parts( |
ac7992be |
283 | ' ', |
984db0d7 |
284 | $thing, |
ac7992be |
285 | $self->format_keyword('as'), |
984db0d7 |
286 | $alias, |
1ba47f38 |
287 | ); |
288 | } |
289 | |
290 | sub _render_alias { |
984db0d7 |
291 | my ($self, undef, $args) = @_; |
1ba47f38 |
292 | my ($as, @cols) = @$args; |
293 | return (@cols |
0236f122 |
294 | ? $self->join_query_parts('', |
a1f8b6ef |
295 | $as, |
3f312d2e |
296 | '(', |
297 | $self->join_query_parts( |
298 | ', ', |
299 | @cols |
300 | ), |
301 | ')', |
1ba47f38 |
302 | ) |
303 | : $self->render_aqt($as) |
b99e9a14 |
304 | ); |
305 | } |
306 | |
f9f1fdcd |
307 | sub _expand_update_clause_target { |
fe8b493f |
308 | my ($self, undef, $target) = @_; |
f9f1fdcd |
309 | +(target => $self->_expand_from_list(undef, $target)); |
310 | } |
311 | |
1ff9018c |
312 | 1; |