Commit | Line | Data |
7eb76996 |
1 | package DBIx::Class::Storage::DBIHacks; |
d28bb90d |
2 | |
3 | # |
4 | # This module contains code that should never have seen the light of day, |
5 | # does not belong in the Storage, or is otherwise unfit for public |
7eb76996 |
6 | # display. The arrival of SQLA2 should immediately oboslete 90% of this |
d28bb90d |
7 | # |
8 | |
9 | use strict; |
10 | use warnings; |
11 | |
12 | use base 'DBIx::Class::Storage'; |
13 | use mro 'c3'; |
14 | |
15 | use Carp::Clan qw/^DBIx::Class/; |
16 | |
17 | # |
18 | # This is the code producing joined subqueries like: |
19 | # SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ... |
20 | # |
21 | sub _adjust_select_args_for_complex_prefetch { |
22 | my ($self, $from, $select, $where, $attrs) = @_; |
23 | |
24 | $self->throw_exception ('Nothing to prefetch... how did we get here?!') |
25 | if not @{$attrs->{_prefetch_select}}; |
26 | |
27 | $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute') |
28 | if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY'); |
29 | |
30 | |
31 | # generate inner/outer attribute lists, remove stuff that doesn't apply |
32 | my $outer_attrs = { %$attrs }; |
33 | delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/; |
34 | |
35 | my $inner_attrs = { %$attrs }; |
36 | delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/; |
37 | |
38 | |
39 | # bring over all non-collapse-induced order_by into the inner query (if any) |
40 | # the outer one will have to keep them all |
41 | delete $inner_attrs->{order_by}; |
42 | if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) { |
43 | $inner_attrs->{order_by} = [ |
44 | @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1] |
45 | ]; |
46 | } |
47 | |
48 | |
49 | # generate the inner/outer select lists |
50 | # for inside we consider only stuff *not* brought in by the prefetch |
51 | # on the outside we substitute any function for its alias |
52 | my $outer_select = [ @$select ]; |
53 | my $inner_select = []; |
54 | for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) { |
55 | my $sel = $outer_select->[$i]; |
56 | |
57 | if (ref $sel eq 'HASH' ) { |
58 | $sel->{-as} ||= $attrs->{as}[$i]; |
59 | $outer_select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "inner_column_$i") ); |
60 | } |
61 | |
62 | push @$inner_select, $sel; |
63 | } |
64 | |
65 | # normalize a copy of $from, so it will be easier to work with further |
66 | # down (i.e. promote the initial hashref to an AoH) |
67 | $from = [ @$from ]; |
68 | $from->[0] = [ $from->[0] ]; |
69 | my %original_join_info = map { $_->[0]{-alias} => $_->[0] } (@$from); |
70 | |
71 | |
72 | # decide which parts of the join will remain in either part of |
73 | # the outer/inner query |
74 | |
75 | # First we compose a list of which aliases are used in restrictions |
76 | # (i.e. conditions/order/grouping/etc). Since we do not have |
77 | # introspectable SQLA, we fall back to ugly scanning of raw SQL for |
78 | # WHERE, and for pieces of ORDER BY in order to determine which aliases |
79 | # need to appear in the resulting sql. |
80 | # It may not be very efficient, but it's a reasonable stop-gap |
81 | # Also unqualified column names will not be considered, but more often |
82 | # than not this is actually ok |
83 | # |
84 | # In the same loop we enumerate part of the selection aliases, as |
85 | # it requires the same sqla hack for the time being |
86 | my ($restrict_aliases, $select_aliases, $prefetch_aliases); |
87 | { |
88 | # produce stuff unquoted, so it can be scanned |
89 | my $sql_maker = $self->sql_maker; |
90 | local $sql_maker->{quote_char}; |
91 | my $sep = $self->_sql_maker_opts->{name_sep} || '.'; |
92 | $sep = "\Q$sep\E"; |
93 | |
94 | my $non_prefetch_select_sql = $sql_maker->_recurse_fields ($inner_select); |
95 | my $prefetch_select_sql = $sql_maker->_recurse_fields ($outer_attrs->{_prefetch_select}); |
96 | my $where_sql = $sql_maker->where ($where); |
97 | my $group_by_sql = $sql_maker->_order_by({ |
98 | map { $_ => $inner_attrs->{$_} } qw/group_by having/ |
99 | }); |
100 | my @non_prefetch_order_by_chunks = (map |
101 | { ref $_ ? $_->[0] : $_ } |
102 | $sql_maker->_order_by_chunks ($inner_attrs->{order_by}) |
103 | ); |
104 | |
105 | |
106 | for my $alias (keys %original_join_info) { |
107 | my $seen_re = qr/\b $alias $sep/x; |
108 | |
109 | for my $piece ($where_sql, $group_by_sql, @non_prefetch_order_by_chunks ) { |
110 | if ($piece =~ $seen_re) { |
111 | $restrict_aliases->{$alias} = 1; |
112 | } |
113 | } |
114 | |
115 | if ($non_prefetch_select_sql =~ $seen_re) { |
116 | $select_aliases->{$alias} = 1; |
117 | } |
118 | |
119 | if ($prefetch_select_sql =~ $seen_re) { |
120 | $prefetch_aliases->{$alias} = 1; |
121 | } |
122 | |
123 | } |
124 | } |
125 | |
126 | # Add any non-left joins to the restriction list (such joins are indeed restrictions) |
127 | for my $j (values %original_join_info) { |
128 | my $alias = $j->{-alias} or next; |
129 | $restrict_aliases->{$alias} = 1 if ( |
130 | (not $j->{-join_type}) |
131 | or |
132 | ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi) |
133 | ); |
134 | } |
135 | |
136 | # mark all join parents as mentioned |
137 | # (e.g. join => { cds => 'tracks' } - tracks will need to bring cds too ) |
138 | for my $collection ($restrict_aliases, $select_aliases) { |
139 | for my $alias (keys %$collection) { |
140 | $collection->{$_} = 1 |
141 | for (@{ $original_join_info{$alias}{-join_path} || [] }); |
142 | } |
143 | } |
144 | |
145 | # construct the inner $from for the subquery |
146 | my %inner_joins = (map { %{$_ || {}} } ($restrict_aliases, $select_aliases) ); |
147 | my @inner_from; |
148 | for my $j (@$from) { |
149 | push @inner_from, $j if $inner_joins{$j->[0]{-alias}}; |
150 | } |
151 | |
152 | # if a multi-type join was needed in the subquery ("multi" is indicated by |
153 | # presence in {collapse}) - add a group_by to simulate the collapse in the subq |
154 | unless ($inner_attrs->{group_by}) { |
155 | for my $alias (keys %inner_joins) { |
156 | |
157 | # the dot comes from some weirdness in collapse |
158 | # remove after the rewrite |
159 | if ($attrs->{collapse}{".$alias"}) { |
160 | $inner_attrs->{group_by} ||= $inner_select; |
161 | last; |
162 | } |
163 | } |
164 | } |
165 | |
166 | # demote the inner_from head |
167 | $inner_from[0] = $inner_from[0][0]; |
168 | |
169 | # generate the subquery |
170 | my $subq = $self->_select_args_to_query ( |
171 | \@inner_from, |
172 | $inner_select, |
173 | $where, |
174 | $inner_attrs, |
175 | ); |
176 | |
177 | my $subq_joinspec = { |
178 | -alias => $attrs->{alias}, |
179 | -source_handle => $inner_from[0]{-source_handle}, |
180 | $attrs->{alias} => $subq, |
181 | }; |
182 | |
183 | # Generate the outer from - this is relatively easy (really just replace |
184 | # the join slot with the subquery), with a major caveat - we can not |
185 | # join anything that is non-selecting (not part of the prefetch), but at |
186 | # the same time is a multi-type relationship, as it will explode the result. |
187 | # |
188 | # There are two possibilities here |
189 | # - either the join is non-restricting, in which case we simply throw it away |
190 | # - it is part of the restrictions, in which case we need to collapse the outer |
191 | # result by tackling yet another group_by to the outside of the query |
192 | |
193 | # so first generate the outer_from, up to the substitution point |
194 | my @outer_from; |
195 | while (my $j = shift @$from) { |
196 | if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap |
197 | push @outer_from, [ |
198 | $subq_joinspec, |
199 | @{$j}[1 .. $#$j], |
200 | ]; |
201 | last; # we'll take care of what's left in $from below |
202 | } |
203 | else { |
204 | push @outer_from, $j; |
205 | } |
206 | } |
207 | |
208 | # see what's left - throw away if not selecting/restricting |
209 | # also throw in a group_by if restricting to guard against |
210 | # cross-join explosions |
211 | # |
212 | while (my $j = shift @$from) { |
213 | my $alias = $j->[0]{-alias}; |
214 | |
215 | if ($select_aliases->{$alias} || $prefetch_aliases->{$alias}) { |
216 | push @outer_from, $j; |
217 | } |
218 | elsif ($restrict_aliases->{$alias}) { |
219 | push @outer_from, $j; |
220 | |
221 | # FIXME - this should be obviated by SQLA2, as I'll be able to |
222 | # have restrict_inner and restrict_outer... or something to that |
223 | # effect... I think... |
224 | |
225 | # FIXME2 - I can't find a clean way to determine if a particular join |
226 | # is a multi - instead I am just treating everything as a potential |
227 | # explosive join (ribasushi) |
228 | # |
229 | # if (my $handle = $j->[0]{-source_handle}) { |
230 | # my $rsrc = $handle->resolve; |
231 | # ... need to bail out of the following if this is not a multi, |
232 | # as it will be much easier on the db ... |
233 | |
234 | $outer_attrs->{group_by} ||= $outer_select; |
235 | # } |
236 | } |
237 | } |
238 | |
239 | # demote the outer_from head |
240 | $outer_from[0] = $outer_from[0][0]; |
241 | |
242 | # This is totally horrific - the $where ends up in both the inner and outer query |
243 | # Unfortunately not much can be done until SQLA2 introspection arrives, and even |
244 | # then if where conditions apply to the *right* side of the prefetch, you may have |
245 | # to both filter the inner select (e.g. to apply a limit) and then have to re-filter |
246 | # the outer select to exclude joins you didin't want in the first place |
247 | # |
248 | # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;) |
249 | return (\@outer_from, $outer_select, $where, $outer_attrs); |
250 | } |
251 | |
252 | sub _resolve_ident_sources { |
253 | my ($self, $ident) = @_; |
254 | |
255 | my $alias2source = {}; |
256 | my $rs_alias; |
257 | |
258 | # the reason this is so contrived is that $ident may be a {from} |
259 | # structure, specifying multiple tables to join |
260 | if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { |
261 | # this is compat mode for insert/update/delete which do not deal with aliases |
262 | $alias2source->{me} = $ident; |
263 | $rs_alias = 'me'; |
264 | } |
265 | elsif (ref $ident eq 'ARRAY') { |
266 | |
267 | for (@$ident) { |
268 | my $tabinfo; |
269 | if (ref $_ eq 'HASH') { |
270 | $tabinfo = $_; |
271 | $rs_alias = $tabinfo->{-alias}; |
272 | } |
273 | if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') { |
274 | $tabinfo = $_->[0]; |
275 | } |
276 | |
277 | $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve |
278 | if ($tabinfo->{-source_handle}); |
279 | } |
280 | } |
281 | |
282 | return ($alias2source, $rs_alias); |
283 | } |
284 | |
285 | # Takes $ident, \@column_names |
286 | # |
287 | # returns { $column_name => \%column_info, ... } |
288 | # also note: this adds -result_source => $rsrc to the column info |
289 | # |
290 | # usage: |
291 | # my $col_sources = $self->_resolve_column_info($ident, @column_names); |
292 | sub _resolve_column_info { |
293 | my ($self, $ident, $colnames) = @_; |
294 | my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident); |
295 | |
296 | my $sep = $self->_sql_maker_opts->{name_sep} || '.'; |
297 | $sep = "\Q$sep\E"; |
298 | |
299 | my (%return, %seen_cols); |
300 | |
301 | # compile a global list of column names, to be able to properly |
302 | # disambiguate unqualified column names (if at all possible) |
303 | for my $alias (keys %$alias2src) { |
304 | my $rsrc = $alias2src->{$alias}; |
305 | for my $colname ($rsrc->columns) { |
306 | push @{$seen_cols{$colname}}, $alias; |
307 | } |
308 | } |
309 | |
310 | COLUMN: |
311 | foreach my $col (@$colnames) { |
312 | my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x; |
313 | |
314 | unless ($alias) { |
315 | # see if the column was seen exactly once (so we know which rsrc it came from) |
316 | if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1) { |
317 | $alias = $seen_cols{$colname}[0]; |
318 | } |
319 | else { |
320 | next COLUMN; |
321 | } |
322 | } |
323 | |
324 | my $rsrc = $alias2src->{$alias}; |
325 | $return{$col} = $rsrc && { |
326 | %{$rsrc->column_info($colname)}, |
327 | -result_source => $rsrc, |
328 | -source_alias => $alias, |
329 | }; |
330 | } |
331 | |
332 | return \%return; |
333 | } |
334 | |
289ac713 |
335 | # The DBIC relationship chaining implementation is pretty simple - every |
336 | # new related_relationship is pushed onto the {from} stack, and the {select} |
337 | # window simply slides further in. This means that when we count somewhere |
338 | # in the middle, we got to make sure that everything in the join chain is an |
339 | # actual inner join, otherwise the count will come back with unpredictable |
340 | # results (a resultset may be generated with _some_ rows regardless of if |
341 | # the relation which the $rs currently selects has rows or not). E.g. |
342 | # $artist_rs->cds->count - normally generates: |
343 | # SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid |
344 | # which actually returns the number of artists * (number of cds || 1) |
345 | # |
346 | # So what we do here is crawl {from}, determine if the current alias is at |
347 | # the top of the stack, and if not - make sure the chain is inner-joined down |
348 | # to the root. |
349 | # |
350 | sub _straight_join_to_node { |
351 | my ($self, $from, $alias) = @_; |
352 | |
353 | # subqueries and other oddness are naturally not supported |
354 | return $from if ( |
355 | ref $from ne 'ARRAY' |
356 | || |
357 | @$from <= 1 |
358 | || |
359 | ref $from->[0] ne 'HASH' |
360 | || |
361 | ! $from->[0]{-alias} |
362 | || |
7eb76996 |
363 | $from->[0]{-alias} eq $alias # this last bit means $alias is the head of $from - nothing to do |
289ac713 |
364 | ); |
365 | |
366 | # find the current $alias in the $from structure |
367 | my $switch_branch; |
368 | JOINSCAN: |
369 | for my $j (@{$from}[1 .. $#$from]) { |
370 | if ($j->[0]{-alias} eq $alias) { |
371 | $switch_branch = $j->[0]{-join_path}; |
372 | last JOINSCAN; |
373 | } |
374 | } |
375 | |
7eb76996 |
376 | # something else went quite wrong |
289ac713 |
377 | return $from unless $switch_branch; |
378 | |
379 | # So it looks like we will have to switch some stuff around. |
380 | # local() is useless here as we will be leaving the scope |
381 | # anyway, and deep cloning is just too fucking expensive |
7eb76996 |
382 | # So replace the first hashref in the node arrayref manually |
289ac713 |
383 | my @new_from = ($from->[0]); |
384 | my $sw_idx = { map { $_ => 1 } @$switch_branch }; |
385 | |
386 | for my $j (@{$from}[1 .. $#$from]) { |
387 | my $jalias = $j->[0]{-alias}; |
388 | |
389 | if ($sw_idx->{$jalias}) { |
390 | my %attrs = %{$j->[0]}; |
391 | delete $attrs{-join_type}; |
392 | push @new_from, [ |
393 | \%attrs, |
394 | @{$j}[ 1 .. $#$j ], |
395 | ]; |
396 | } |
397 | else { |
398 | push @new_from, $j; |
399 | } |
400 | } |
401 | |
402 | return \@new_from; |
403 | } |
404 | |
d28bb90d |
405 | 1; |