Profile of DBIx/Class/SQLMaker/LimitDialects.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:07 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/SQLMaker/LimitDialects.pm
Statements | Executed 43 statements in 2.51ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
5 | 1 | 1 | 120µs | 2.85ms | DBIx::Class::SQLMaker::LimitDialects::::_LimitOffsetDBIx::Class::SQLMaker::LimitDialects::_LimitOffset
5 | 1 | 1 | 24µs | 24µs | DBIx::Class::SQLMaker::LimitDialects::::__rows_bindtypeDBIx::Class::SQLMaker::LimitDialects::__rows_bindtype
1 | 1 | 1 | 13µs | 22µs | DBIx::Class::SQLMaker::LimitDialects::::BEGIN@3DBIx::Class::SQLMaker::LimitDialects::BEGIN@3
1 | 1 | 1 | 11µs | 49µs | DBIx::Class::SQLMaker::LimitDialects::::BEGIN@6DBIx::Class::SQLMaker::LimitDialects::BEGIN@6
1 | 1 | 1 | 8µs | 177µs | DBIx::Class::SQLMaker::LimitDialects::::BEGIN@7DBIx::Class::SQLMaker::LimitDialects::BEGIN@7
1 | 1 | 1 | 7µs | 9µs | DBIx::Class::SQLMaker::LimitDialects::::BEGIN@4DBIx::Class::SQLMaker::LimitDialects::BEGIN@4
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_FetchFirstDBIx::Class::SQLMaker::LimitDialects::_FetchFirst
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_FirstSkipDBIx::Class::SQLMaker::LimitDialects::_FirstSkip
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_GenericSubQDBIx::Class::SQLMaker::LimitDialects::_GenericSubQ
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_LimitXYDBIx::Class::SQLMaker::LimitDialects::_LimitXY
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_RowCountOrGenericSubQDBIx::Class::SQLMaker::LimitDialects::_RowCountOrGenericSubQ
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_RowNumDBIx::Class::SQLMaker::LimitDialects::_RowNum
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_RowNumberOverDBIx::Class::SQLMaker::LimitDialects::_RowNumberOver
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_SkipFirstDBIx::Class::SQLMaker::LimitDialects::_SkipFirst
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_TopDBIx::Class::SQLMaker::LimitDialects::_Top
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::__ANON__[:333]DBIx::Class::SQLMaker::LimitDialects::__ANON__[:333]
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::__offset_bindtypeDBIx::Class::SQLMaker::LimitDialects::__offset_bindtype
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::__order_by_is_uniqueDBIx::Class::SQLMaker::LimitDialects::__order_by_is_unique
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::__total_bindtypeDBIx::Class::SQLMaker::LimitDialects::__total_bindtype
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_prep_for_skimming_limitDBIx::Class::SQLMaker::LimitDialects::_prep_for_skimming_limit
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_rno_default_orderDBIx::Class::SQLMaker::LimitDialects::_rno_default_order
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_subqueried_limit_attrsDBIx::Class::SQLMaker::LimitDialects::_subqueried_limit_attrs
0 | 0 | 0 | 0s | 0s | DBIx::Class::SQLMaker::LimitDialects::::_unqualify_colnameDBIx::Class::SQLMaker::LimitDialects::_unqualify_colname

Call graph for these subroutines as a Graphviz dot language file.

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