Commit | Line | Data |
d5dedbd6 |
1 | package DBIx::Class::SQLMaker::LimitDialects; |
7fca91be |
2 | |
3 | use warnings; |
4 | use strict; |
5 | |
7fca91be |
6 | use List::Util 'first'; |
7 | use namespace::clean; |
8 | |
d5dedbd6 |
9 | =head1 NAME |
10 | |
11 | DBIx::Class::SQLMaker::LimitDialects - SQL::Abstract::Limit-like functionality for DBIx::Class::SQLMaker |
12 | |
13 | =head1 DESCRIPTION |
14 | |
15 | This module replicates a lot of the functionality originally found in |
16 | L<SQL::Abstract::Limit>. While simple limits would work as-is, the more |
17 | complex dialects that require e.g. subqueries could not be reliably |
18 | implemented without taking full advantage of the metadata locked within |
19 | L<DBIx::Class::ResultSource> classes. After reimplementation of close to |
20 | 80% of the L<SQL::Abstract::Limit> functionality it was deemed more |
21 | practical to simply make an independent DBIx::Class-specific limit-dialect |
22 | provider. |
23 | |
24 | =head1 SQL LIMIT DIALECTS |
25 | |
26 | Note that the actual implementations listed below never use C<*> literally. |
27 | Instead proper re-aliasing of selectors and order criteria is done, so that |
28 | the limit dialect are safe to use on joined resultsets with clashing column |
29 | names. |
30 | |
31 | Currently the provided dialects are: |
32 | |
33 | =cut |
34 | |
35 | =head2 LimitOffset |
36 | |
37 | SELECT ... LIMIT $limit OFFSET $offset |
38 | |
39 | Supported by B<PostgreSQL> and B<SQLite> |
40 | |
41 | =cut |
7fca91be |
42 | sub _LimitOffset { |
43 | my ( $self, $sql, $order, $rows, $offset ) = @_; |
44 | $sql .= $self->_order_by( $order ) . " LIMIT $rows"; |
45 | $sql .= " OFFSET $offset" if +$offset; |
46 | return $sql; |
47 | } |
48 | |
d5dedbd6 |
49 | =head2 LimitXY |
50 | |
51 | SELECT ... LIMIT $offset $limit |
52 | |
53 | Supported by B<MySQL> and any L<SQL::Statement> based DBD |
54 | |
55 | =cut |
7fca91be |
56 | sub _LimitXY { |
57 | my ( $self, $sql, $order, $rows, $offset ) = @_; |
58 | $sql .= $self->_order_by( $order ) . " LIMIT "; |
59 | $sql .= "$offset, " if +$offset; |
60 | $sql .= $rows; |
61 | return $sql; |
62 | } |
d5dedbd6 |
63 | |
64 | =head2 RowNumberOver |
65 | |
66 | SELECT * FROM ( |
67 | SELECT *, ROW_NUMBER() OVER( ORDER BY ... ) AS RNO__ROW__INDEX FROM ( |
68 | SELECT ... |
69 | ) |
70 | ) WHERE RNO__ROW__INDEX BETWEEN ($offset+1) AND ($limit+$offset) |
71 | |
72 | |
73 | ANSI standard Limit/Offset implementation. Supported by B<DB2> and |
74 | B<< MSSQL >= 2005 >>. |
75 | |
76 | =cut |
7fca91be |
77 | sub _RowNumberOver { |
78 | my ($self, $sql, $rs_attrs, $rows, $offset ) = @_; |
79 | |
80 | # mangle the input sql as we will be replacing the selector |
81 | $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix |
70c28808 |
82 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
83 | |
84 | # get selectors, and scan the order_by (if any) |
85 | my ($in_sel, $out_sel, $alias_map, $extra_order_sel) |
86 | = $self->_subqueried_limit_attrs ( $rs_attrs ); |
87 | |
88 | # make up an order if none exists |
89 | my $requested_order = (delete $rs_attrs->{order_by}) || $self->_rno_default_order; |
90 | my $rno_ord = $self->_order_by ($requested_order); |
91 | |
92 | # this is the order supplement magic |
93 | my $mid_sel = $out_sel; |
94 | if ($extra_order_sel) { |
95 | for my $extra_col (sort |
96 | { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } |
97 | keys %$extra_order_sel |
98 | ) { |
99 | $in_sel .= sprintf (', %s AS %s', |
100 | $extra_col, |
101 | $extra_order_sel->{$extra_col}, |
102 | ); |
103 | |
104 | $mid_sel .= ', ' . $extra_order_sel->{$extra_col}; |
105 | } |
106 | } |
107 | |
108 | # and this is order re-alias magic |
109 | for ($extra_order_sel, $alias_map) { |
110 | for my $col (keys %$_) { |
111 | my $re_col = quotemeta ($col); |
112 | $rno_ord =~ s/$re_col/$_->{$col}/; |
113 | } |
114 | } |
115 | |
116 | # whatever is left of the order_by (only where is processed at this point) |
117 | my $group_having = $self->_parse_rs_attrs($rs_attrs); |
118 | |
119 | my $qalias = $self->_quote ($rs_attrs->{alias}); |
120 | my $idx_name = $self->_quote ('rno__row__index'); |
121 | |
122 | $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, ); |
123 | |
124 | SELECT $out_sel FROM ( |
125 | SELECT $mid_sel, ROW_NUMBER() OVER( $rno_ord ) AS $idx_name FROM ( |
126 | SELECT $in_sel ${sql}${group_having} |
127 | ) $qalias |
128 | ) $qalias WHERE $idx_name BETWEEN %u AND %u |
129 | |
130 | EOS |
131 | |
7fca91be |
132 | return $sql; |
133 | } |
134 | |
135 | # some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) ) |
136 | sub _rno_default_order { |
137 | return undef; |
138 | } |
139 | |
d5dedbd6 |
140 | =head2 SkipFirst |
141 | |
142 | SELECT SKIP $offset FIRST $limit * FROM ... |
143 | |
144 | Suported by B<Informix>, almost like LimitOffset. According to |
145 | L<SQL::Abstract::Limit> C<... SKIP $offset LIMIT $limit ...> is also supported. |
146 | |
147 | =cut |
7fca91be |
148 | sub _SkipFirst { |
149 | my ($self, $sql, $rs_attrs, $rows, $offset) = @_; |
150 | |
151 | $sql =~ s/^ \s* SELECT \s+ //ix |
70c28808 |
152 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
153 | |
154 | return sprintf ('SELECT %s%s%s%s', |
155 | $offset |
156 | ? sprintf ('SKIP %u ', $offset) |
157 | : '' |
158 | , |
159 | sprintf ('FIRST %u ', $rows), |
160 | $sql, |
161 | $self->_parse_rs_attrs ($rs_attrs), |
162 | ); |
163 | } |
164 | |
d5dedbd6 |
165 | =head2 FirstSkip |
166 | |
167 | SELECT FIRST $limit SKIP $offset * FROM ... |
168 | |
169 | Supported by B<Firebird/Interbase>, reverse of SkipFirst. According to |
170 | L<SQL::Abstract::Limit> C<... ROWS $limit TO $offset ...> is also supported. |
171 | |
172 | =cut |
7fca91be |
173 | sub _FirstSkip { |
174 | my ($self, $sql, $rs_attrs, $rows, $offset) = @_; |
175 | |
176 | $sql =~ s/^ \s* SELECT \s+ //ix |
70c28808 |
177 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
178 | |
179 | return sprintf ('SELECT %s%s%s%s', |
180 | sprintf ('FIRST %u ', $rows), |
181 | $offset |
182 | ? sprintf ('SKIP %u ', $offset) |
183 | : '' |
184 | , |
185 | $sql, |
186 | $self->_parse_rs_attrs ($rs_attrs), |
187 | ); |
188 | } |
189 | |
d5dedbd6 |
190 | =head2 RowNum |
191 | |
192 | SELECT * FROM ( |
193 | SELECT *, ROWNUM rownum__index FROM ( |
194 | SELECT ... |
d9672fb9 |
195 | ) WHERE ROWNUM <= ($limit+$offset) |
196 | ) WHERE rownum__index >= ($offset+1) |
d5dedbd6 |
197 | |
198 | Supported by B<Oracle>. |
199 | |
200 | =cut |
7fca91be |
201 | sub _RowNum { |
202 | my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; |
203 | |
204 | # mangle the input sql as we will be replacing the selector |
205 | $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix |
70c28808 |
206 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
207 | |
208 | my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs); |
209 | |
210 | my $qalias = $self->_quote ($rs_attrs->{alias}); |
211 | my $idx_name = $self->_quote ('rownum__index'); |
212 | my $order_group_having = $self->_parse_rs_attrs($rs_attrs); |
213 | |
d9672fb9 |
214 | if ($offset) { |
215 | |
216 | $sql = sprintf (<<EOS, $offset + $rows, $offset + 1 ); |
7fca91be |
217 | |
218 | SELECT $outsel FROM ( |
219 | SELECT $outsel, ROWNUM $idx_name FROM ( |
220 | SELECT $insel ${sql}${order_group_having} |
d9672fb9 |
221 | ) $qalias WHERE ROWNUM <= %u |
222 | ) $qalias WHERE $idx_name >= %u |
7fca91be |
223 | |
224 | EOS |
d9672fb9 |
225 | } |
226 | else { |
227 | $sql = sprintf (<<EOS, $rows ); |
228 | |
229 | SELECT $outsel FROM ( |
230 | SELECT $insel ${sql}${order_group_having} |
231 | ) $qalias WHERE ROWNUM <= %u |
232 | |
233 | EOS |
234 | } |
7fca91be |
235 | |
7fca91be |
236 | return $sql; |
237 | } |
238 | |
96eacdb7 |
239 | # used by _Top and _FetchFirst |
240 | sub _prep_for_skimming_limit { |
241 | my ( $self, $sql, $rs_attrs ) = @_; |
7fca91be |
242 | |
243 | # mangle the input sql as we will be replacing the selector |
244 | $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix |
70c28808 |
245 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
246 | |
96eacdb7 |
247 | my %r = ( inner_sql => $sql ); |
248 | |
7fca91be |
249 | # get selectors |
96eacdb7 |
250 | my ($alias_map, $extra_order_sel); |
251 | ($r{in_sel}, $r{out_sel}, $alias_map, $extra_order_sel) |
7fca91be |
252 | = $self->_subqueried_limit_attrs ($rs_attrs); |
253 | |
254 | my $requested_order = delete $rs_attrs->{order_by}; |
96eacdb7 |
255 | $r{order_by_requested} = $self->_order_by ($requested_order); |
7fca91be |
256 | |
257 | # make up an order unless supplied |
96eacdb7 |
258 | my $inner_order = ($r{order_by_requested} |
7fca91be |
259 | ? $requested_order |
260 | : [ map |
3f5b99fe |
261 | { "$rs_attrs->{alias}.$_" } |
4376a157 |
262 | ( $rs_attrs->{_rsroot_rsrc}->_pri_cols ) |
7fca91be |
263 | ] |
264 | ); |
265 | |
7fca91be |
266 | # localise as we already have all the bind values we need |
267 | { |
268 | local $self->{order_bind}; |
96eacdb7 |
269 | $r{order_by_inner} = $self->_order_by ($inner_order); |
7fca91be |
270 | |
271 | my @out_chunks; |
272 | for my $ch ($self->_order_by_chunks ($inner_order)) { |
273 | $ch = $ch->[0] if ref $ch eq 'ARRAY'; |
274 | |
275 | $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix; |
276 | my $dir = uc ($1||'ASC'); |
277 | |
278 | push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' ); |
279 | } |
280 | |
96eacdb7 |
281 | $r{order_by_reversed} = $self->_order_by (\@out_chunks); |
7fca91be |
282 | } |
283 | |
284 | # this is the order supplement magic |
96eacdb7 |
285 | $r{mid_sel} = $r{out_sel}; |
7fca91be |
286 | if ($extra_order_sel) { |
287 | for my $extra_col (sort |
288 | { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } |
289 | keys %$extra_order_sel |
290 | ) { |
96eacdb7 |
291 | $r{in_sel} .= sprintf (', %s AS %s', |
7fca91be |
292 | $extra_col, |
293 | $extra_order_sel->{$extra_col}, |
294 | ); |
295 | |
96eacdb7 |
296 | $r{mid_sel} .= ', ' . $extra_order_sel->{$extra_col}; |
7fca91be |
297 | } |
298 | |
299 | # since whatever order bindvals there are, they will be realiased |
300 | # and need to show up in front of the entire initial inner subquery |
4c2b30d6 |
301 | # *unshift* the selector bind stack to make this happen (horrible, |
302 | # horrible, but we don't have another mechanism yet) |
303 | unshift @{$self->{select_bind}}, @{$self->{order_bind}}; |
7fca91be |
304 | } |
305 | |
306 | # and this is order re-alias magic |
307 | for my $map ($extra_order_sel, $alias_map) { |
308 | for my $col (keys %$map) { |
309 | my $re_col = quotemeta ($col); |
310 | $_ =~ s/$re_col/$map->{$col}/ |
96eacdb7 |
311 | for ($r{order_by_reversed}, $r{order_by_requested}); |
7fca91be |
312 | } |
313 | } |
314 | |
315 | # generate the rest of the sql |
96eacdb7 |
316 | $r{grpby_having} = $self->_parse_rs_attrs ($rs_attrs); |
7fca91be |
317 | |
96eacdb7 |
318 | $r{quoted_rs_alias} = $self->_quote ($rs_attrs->{alias}); |
319 | |
320 | \%r; |
321 | } |
322 | |
323 | =head2 Top |
324 | |
325 | SELECT * FROM |
326 | |
327 | SELECT TOP $limit FROM ( |
328 | SELECT TOP $limit FROM ( |
329 | SELECT TOP ($limit+$offset) ... |
330 | ) ORDER BY $reversed_original_order |
331 | ) ORDER BY $original_order |
332 | |
333 | Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>. |
334 | |
335 | =head3 CAVEAT |
336 | |
337 | Due to its implementation, this limit dialect returns B<incorrect results> |
338 | when $limit+$offset > total amount of rows in the resultset. |
339 | |
340 | =cut |
341 | |
342 | sub _Top { |
343 | my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; |
344 | |
345 | my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; |
7fca91be |
346 | |
347 | $sql = sprintf ('SELECT TOP %u %s %s %s %s', |
348 | $rows + ($offset||0), |
96eacdb7 |
349 | $l{in_sel}, |
350 | $l{inner_sql}, |
351 | $l{grpby_having}, |
352 | $l{order_by_inner}, |
7fca91be |
353 | ); |
354 | |
355 | $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', |
356 | $rows, |
96eacdb7 |
357 | $l{mid_sel}, |
7fca91be |
358 | $sql, |
96eacdb7 |
359 | $l{quoted_rs_alias}, |
360 | $l{order_by_reversed}, |
7fca91be |
361 | ) if $offset; |
362 | |
363 | $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', |
364 | $rows, |
96eacdb7 |
365 | $l{out_sel}, |
366 | $sql, |
367 | $l{quoted_rs_alias}, |
368 | $l{order_by_requested}, |
369 | ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); |
370 | |
371 | return $sql; |
372 | } |
373 | |
374 | =head2 FetchFirst |
375 | |
376 | SELECT * FROM |
377 | ( |
378 | SELECT * FROM ( |
379 | SELECT * FROM ( |
380 | SELECT * FROM ... |
381 | ) ORDER BY $reversed_original_order |
382 | FETCH FIRST $limit ROWS ONLY |
383 | ) ORDER BY $original_order |
384 | FETCH FIRST $limit ROWS ONLY |
385 | ) |
386 | |
387 | Unreliable FetchFirst-based implementation, supported by B<< IBM DB2 <= V5R3 >>. |
388 | |
389 | =head3 CAVEAT |
390 | |
391 | Due to its implementation, this limit dialect returns B<incorrect results> |
392 | when $limit+$offset > total amount of rows in the resultset. |
393 | |
394 | =cut |
395 | |
396 | sub _FetchFirst { |
397 | my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; |
398 | |
399 | my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; |
400 | |
401 | $sql = sprintf ('SELECT %s %s %s %s FETCH FIRST %u ROWS ONLY', |
402 | $l{in_sel}, |
403 | $l{inner_sql}, |
404 | $l{grpby_having}, |
405 | $l{order_by_inner}, |
406 | $rows + ($offset||0), |
407 | ); |
408 | |
409 | $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', |
410 | $l{mid_sel}, |
411 | $sql, |
412 | $l{quoted_rs_alias}, |
413 | $l{order_by_reversed}, |
414 | $rows, |
415 | ) if $offset; |
416 | |
417 | $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', |
418 | $l{out_sel}, |
7fca91be |
419 | $sql, |
96eacdb7 |
420 | $l{quoted_rs_alias}, |
421 | $l{order_by_requested}, |
422 | $rows, |
423 | ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); |
7fca91be |
424 | |
7fca91be |
425 | return $sql; |
426 | } |
427 | |
d5dedbd6 |
428 | =head2 RowCountOrGenericSubQ |
429 | |
430 | This is not exactly a limit dialect, but more of a proxy for B<Sybase ASE>. |
431 | If no $offset is supplied the limit is simply performed as: |
432 | |
433 | SET ROWCOUNT $limit |
434 | SELECT ... |
435 | SET ROWCOUNT 0 |
436 | |
437 | Otherwise we fall back to L</GenericSubQ> |
438 | |
439 | =cut |
96eacdb7 |
440 | |
7fca91be |
441 | sub _RowCountOrGenericSubQ { |
442 | my $self = shift; |
443 | my ($sql, $rs_attrs, $rows, $offset) = @_; |
444 | |
445 | return $self->_GenericSubQ(@_) if $offset; |
446 | |
447 | return sprintf <<"EOF", $rows, $sql; |
448 | SET ROWCOUNT %d |
449 | %s |
450 | SET ROWCOUNT 0 |
451 | EOF |
452 | } |
453 | |
d5dedbd6 |
454 | =head2 GenericSubQ |
455 | |
456 | SELECT * FROM ( |
457 | SELECT ... |
458 | ) |
459 | WHERE ( |
460 | SELECT COUNT(*) FROM $original_table cnt WHERE cnt.id < $original_table.id |
461 | ) BETWEEN $offset AND ($offset+$rows-1) |
462 | |
463 | This is the most evil limit "dialect" (more of a hack) for I<really> stupid |
464 | databases. It works by ordering the set by some unique column, and calculating |
465 | the amount of rows that have a less-er value (thus emulating a L</RowNum>-like |
466 | index). Of course this implies the set can only be ordered by a single unique |
467 | column. Also note that this technique can be and often is B<excruciatingly |
468 | slow>. |
469 | |
470 | Currently used by B<Sybase ASE>, due to lack of any other option. |
471 | |
472 | =cut |
7fca91be |
473 | sub _GenericSubQ { |
474 | my ($self, $sql, $rs_attrs, $rows, $offset) = @_; |
475 | |
4376a157 |
476 | my $root_rsrc = $rs_attrs->{_rsroot_rsrc}; |
7fca91be |
477 | my $root_tbl_name = $root_rsrc->name; |
478 | |
479 | # mangle the input sql as we will be replacing the selector |
480 | $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix |
70c28808 |
481 | or $self->throw_exception("Unrecognizable SELECT: $sql"); |
7fca91be |
482 | |
483 | my ($order_by, @rest) = do { |
484 | local $self->{quote_char}; |
485 | $self->_order_by_chunks ($rs_attrs->{order_by}) |
486 | }; |
487 | |
488 | unless ( |
489 | $order_by |
490 | && |
491 | ! @rest |
492 | && |
493 | ( ! ref $order_by |
494 | || |
495 | ( ref $order_by eq 'ARRAY' and @$order_by == 1 ) |
496 | ) |
497 | ) { |
70c28808 |
498 | $self->throw_exception ( |
7fca91be |
499 | 'Generic Subquery Limit does not work on resultsets without an order, or resultsets ' |
500 | . 'with complex order criteria (multicolumn and/or functions). Provide a single, ' |
501 | . 'unique-column order criteria.' |
502 | ); |
503 | } |
504 | |
505 | ($order_by) = @$order_by if ref $order_by; |
506 | |
507 | $order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix; |
508 | my $direction = lc ($1 || 'asc'); |
509 | |
510 | my ($unq_sort_col) = $order_by =~ /(?:^|\.)([^\.]+)$/; |
511 | |
512 | my $inf = $root_rsrc->storage->_resolve_column_info ( |
513 | $rs_attrs->{from}, [$order_by, $unq_sort_col] |
514 | ); |
515 | |
70c28808 |
516 | my $ord_colinfo = $inf->{$order_by} || $self->throw_exception("Unable to determine source of order-criteria '$order_by'"); |
7fca91be |
517 | |
518 | if ($ord_colinfo->{-result_source}->name ne $root_tbl_name) { |
70c28808 |
519 | $self->throw_exception(sprintf |
520 | "Generic Subquery Limit order criteria can be only based on the root-source '%s'" |
521 | . " (aliased as '%s')", $root_rsrc->source_name, $rs_attrs->{alias}, |
522 | ); |
7fca91be |
523 | } |
524 | |
525 | # make sure order column is qualified |
526 | $order_by = "$rs_attrs->{alias}.$order_by" |
527 | unless $order_by =~ /^$rs_attrs->{alias}\./; |
528 | |
529 | my $is_u; |
530 | my $ucs = { $root_rsrc->unique_constraints }; |
531 | for (values %$ucs ) { |
532 | if (@$_ == 1 && "$rs_attrs->{alias}.$_->[0]" eq $order_by) { |
533 | $is_u++; |
534 | last; |
535 | } |
536 | } |
70c28808 |
537 | $self->throw_exception( |
538 | "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)" |
539 | ) unless $is_u; |
7fca91be |
540 | |
541 | my ($in_sel, $out_sel, $alias_map, $extra_order_sel) |
542 | = $self->_subqueried_limit_attrs ($rs_attrs); |
543 | |
544 | my $cmp_op = $direction eq 'desc' ? '>' : '<'; |
545 | my $count_tbl_alias = 'rownum__emulation'; |
546 | |
547 | my $order_sql = $self->_order_by (delete $rs_attrs->{order_by}); |
548 | my $group_having_sql = $self->_parse_rs_attrs($rs_attrs); |
549 | |
550 | # add the order supplement (if any) as this is what will be used for the outer WHERE |
551 | $in_sel .= ", $_" for keys %{$extra_order_sel||{}}; |
552 | |
553 | $sql = sprintf (<<EOS, |
554 | SELECT $out_sel |
555 | FROM ( |
556 | SELECT $in_sel ${sql}${group_having_sql} |
557 | ) %s |
558 | WHERE ( SELECT COUNT(*) FROM %s %s WHERE %s $cmp_op %s ) %s |
559 | $order_sql |
560 | EOS |
561 | ( map { $self->_quote ($_) } ( |
562 | $rs_attrs->{alias}, |
563 | $root_tbl_name, |
564 | $count_tbl_alias, |
565 | "$count_tbl_alias.$unq_sort_col", |
566 | $order_by, |
567 | )), |
568 | $offset |
569 | ? sprintf ('BETWEEN %u AND %u', $offset, $offset + $rows - 1) |
570 | : sprintf ('< %u', $rows ) |
571 | , |
572 | ); |
573 | |
7fca91be |
574 | return $sql; |
575 | } |
576 | |
577 | |
578 | # !!! THIS IS ALSO HORRIFIC !!! /me ashamed |
579 | # |
580 | # Generates inner/outer select lists for various limit dialects |
581 | # which result in one or more subqueries (e.g. RNO, Top, RowNum) |
582 | # Any non-root-table columns need to have their table qualifier |
583 | # turned into a column alias (otherwise names in subqueries clash |
584 | # and/or lose their source table) |
585 | # |
586 | # Returns inner/outer strings of SQL QUOTED selectors with aliases |
587 | # (to be used in whatever select statement), and an alias index hashref |
588 | # of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst |
589 | # higher up). |
590 | # If an order_by is supplied, the inner select needs to bring out columns |
591 | # used in implicit (non-selected) orders, and the order condition itself |
592 | # needs to be realiased to the proper names in the outer query. Thus we |
593 | # also return a hashref (order doesn't matter) of QUOTED EXTRA-SEL => |
594 | # QUOTED ALIAS pairs, which is a list of extra selectors that do *not* |
595 | # exist in the original select list |
7fca91be |
596 | sub _subqueried_limit_attrs { |
597 | my ($self, $rs_attrs) = @_; |
598 | |
70c28808 |
599 | $self->throw_exception( |
600 | 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)' |
601 | ) unless ref ($rs_attrs) eq 'HASH'; |
7fca91be |
602 | |
3f5b99fe |
603 | my ($re_sep, $re_alias) = map { quotemeta $_ } ( $self->{name_sep}, $rs_attrs->{alias} ); |
7fca91be |
604 | |
605 | # correlate select and as, build selection index |
606 | my (@sel, $in_sel_index); |
607 | for my $i (0 .. $#{$rs_attrs->{select}}) { |
608 | |
609 | my $s = $rs_attrs->{select}[$i]; |
610 | my $sql_sel = $self->_recurse_fields ($s); |
611 | my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef; |
612 | |
7fca91be |
613 | push @sel, { |
614 | sql => $sql_sel, |
615 | unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) }, |
616 | as => |
617 | $sql_alias |
618 | || |
619 | $rs_attrs->{as}[$i] |
620 | || |
70c28808 |
621 | $self->throw_exception("Select argument $i ($s) without corresponding 'as'") |
7fca91be |
622 | , |
623 | }; |
624 | |
625 | $in_sel_index->{$sql_sel}++; |
626 | $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias; |
627 | |
628 | # record unqualified versions too, so we do not have |
629 | # to reselect the same column twice (in qualified and |
630 | # unqualified form) |
631 | if (! ref $s && $sql_sel =~ / $re_sep (.+) $/x) { |
632 | $in_sel_index->{$1}++; |
633 | } |
634 | } |
635 | |
636 | |
637 | # re-alias and remove any name separators from aliases, |
638 | # unless we are dealing with the current source alias |
639 | # (which will transcend the subqueries as it is necessary |
640 | # for possible further chaining) |
641 | my (@in_sel, @out_sel, %renamed); |
642 | for my $node (@sel) { |
3f5b99fe |
643 | if ( |
644 | $node->{as} =~ / (?<! ^ $re_alias ) \. /x |
645 | or |
646 | $node->{unquoted_sql} =~ / (?<! ^ $re_alias ) $re_sep /x |
647 | ) { |
7fca91be |
648 | $node->{as} = $self->_unqualify_colname($node->{as}); |
649 | my $quoted_as = $self->_quote($node->{as}); |
650 | push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as; |
651 | push @out_sel, $quoted_as; |
652 | $renamed{$node->{sql}} = $quoted_as; |
653 | } |
654 | else { |
655 | push @in_sel, $node->{sql}; |
656 | push @out_sel, $self->_quote ($node->{as}); |
657 | } |
658 | } |
659 | |
660 | # see if the order gives us anything |
661 | my %extra_order_sel; |
662 | for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) { |
663 | # order with bind |
664 | $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY'; |
665 | $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix; |
666 | |
667 | next if $in_sel_index->{$chunk}; |
668 | |
669 | $extra_order_sel{$chunk} ||= $self->_quote ( |
670 | 'ORDER__BY__' . scalar keys %extra_order_sel |
671 | ); |
672 | } |
673 | |
674 | return ( |
675 | (map { join (', ', @$_ ) } ( |
676 | \@in_sel, |
677 | \@out_sel) |
678 | ), |
679 | \%renamed, |
680 | keys %extra_order_sel ? \%extra_order_sel : (), |
681 | ); |
682 | } |
683 | |
684 | sub _unqualify_colname { |
685 | my ($self, $fqcn) = @_; |
3f5b99fe |
686 | $fqcn =~ s/ \. /__/xg; |
7fca91be |
687 | return $fqcn; |
688 | } |
689 | |
690 | 1; |
d5dedbd6 |
691 | |
692 | =head1 AUTHORS |
693 | |
694 | See L<DBIx::Class/CONTRIBUTORS>. |
695 | |
696 | =head1 LICENSE |
697 | |
698 | You may distribute this code under the same terms as Perl itself. |
699 | |
700 | =cut |