Commit | Line | Data |
4e9fc3f3 |
1 | package # hide from the pauses |
2 | DBIx::Class::ResultSource::RowParser; |
76031e14 |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Try::Tiny; |
fcf32d04 |
8 | use List::Util qw(first max); |
76031e14 |
9 | use B 'perlstring'; |
10 | |
11 | use namespace::clean; |
12 | |
13 | use base 'DBIx::Class'; |
14 | |
15 | # Accepts one or more relationships for the current source and returns an |
16 | # array of column names for each of those relationships. Column names are |
17 | # prefixed relative to the current source, in accordance with where they appear |
18 | # in the supplied relationships. |
19 | sub _resolve_prefetch { |
20 | my ($self, $pre, $alias, $alias_map, $order, $pref_path) = @_; |
21 | $pref_path ||= []; |
22 | |
23 | if (not defined $pre or not length $pre) { |
24 | return (); |
25 | } |
26 | elsif( ref $pre eq 'ARRAY' ) { |
27 | return |
28 | map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, [ @$pref_path ] ) } |
29 | @$pre; |
30 | } |
31 | elsif( ref $pre eq 'HASH' ) { |
32 | my @ret = |
33 | map { |
34 | $self->_resolve_prefetch($_, $alias, $alias_map, $order, [ @$pref_path ] ), |
35 | $self->related_source($_)->_resolve_prefetch( |
4e9fc3f3 |
36 | $pre->{$_}, "${alias}.$_", $alias_map, $order, [ @$pref_path, $_] ) |
76031e14 |
37 | } keys %$pre; |
38 | return @ret; |
39 | } |
40 | elsif( ref $pre ) { |
41 | $self->throw_exception( |
42 | "don't know how to resolve prefetch reftype ".ref($pre)); |
43 | } |
44 | else { |
45 | my $p = $alias_map; |
46 | $p = $p->{$_} for (@$pref_path, $pre); |
47 | |
48 | $self->throw_exception ( |
49 | "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: " |
50 | . join (' -> ', @$pref_path, $pre) |
51 | ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} ); |
52 | |
53 | my $as = shift @{$p->{-join_aliases}}; |
54 | |
55 | my $rel_info = $self->relationship_info( $pre ); |
56 | $self->throw_exception( $self->source_name . " has no such relationship '$pre'" ) |
57 | unless $rel_info; |
58 | |
59 | my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); |
76031e14 |
60 | |
61 | return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } |
4e9fc3f3 |
62 | $self->related_source($pre)->columns; |
76031e14 |
63 | } |
64 | } |
65 | |
2d0b795a |
66 | # Takes an arrayref selection list and generates a collapse-map representing |
76031e14 |
67 | # row-object fold-points. Every relationship is assigned a set of unique, |
68 | # non-nullable columns (which may *not even be* from the same resultset) |
69 | # and the collapser will use this information to correctly distinguish |
2d0b795a |
70 | # data of individual to-be-row-objects. See t/resultset/rowparser_internals.t |
71 | # for extensive RV examples |
76031e14 |
72 | sub _resolve_collapse { |
82f0e0aa |
73 | my ($self, $args, $common_args) = @_; |
76031e14 |
74 | |
75 | # for comprehensible error messages put ourselves at the head of the relationship chain |
82f0e0aa |
76 | $args->{_rel_chain} ||= [ $self->source_name ]; |
76031e14 |
77 | |
82f0e0aa |
78 | # record top-level fully-qualified column index, start nodecount |
79 | $common_args ||= { |
80 | _as_fq_idx => { %{$args->{as}} }, |
81 | _node_idx => 1, # this is *deliberately* not 0-based |
82 | }; |
76031e14 |
83 | |
84 | my ($my_cols, $rel_cols); |
82f0e0aa |
85 | for (keys %{$args->{as}}) { |
76031e14 |
86 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
87 | $rel_cols->{$1}{$2} = 1; |
88 | } |
89 | else { |
fcf32d04 |
90 | $my_cols->{$_} = {}; # important for ||='s below |
76031e14 |
91 | } |
92 | } |
93 | |
94 | my $relinfo; |
fcf32d04 |
95 | # run through relationships, collect metadata |
76031e14 |
96 | for my $rel (keys %$rel_cols) { |
97 | my $rel_src = __get_related_source($self, $rel, $rel_cols->{$rel}); |
98 | |
99 | my $inf = $self->relationship_info ($rel); |
100 | |
101 | $relinfo->{$rel}{is_single} = $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi'; |
102 | $relinfo->{$rel}{is_inner} = ( $inf->{attrs}{join_type} || '' ) !~ /^left/i; |
103 | $relinfo->{$rel}{rsrc} = $rel_src; |
104 | |
fcf32d04 |
105 | # FIME - need to use _resolve_cond here instead |
76031e14 |
106 | my $cond = $inf->{cond}; |
107 | |
108 | if ( |
109 | ref $cond eq 'HASH' |
110 | and |
111 | keys %$cond |
112 | and |
fcf32d04 |
113 | ! defined first { $_ !~ /^foreign\./ } (keys %$cond) |
76031e14 |
114 | and |
fcf32d04 |
115 | ! defined first { $_ !~ /^self\./ } (values %$cond) |
76031e14 |
116 | ) { |
117 | for my $f (keys %$cond) { |
118 | my $s = $cond->{$f}; |
119 | $_ =~ s/^ (?: foreign | self ) \.//x for ($f, $s); |
120 | $relinfo->{$rel}{fk_map}{$s} = $f; |
76031e14 |
121 | } |
122 | } |
123 | } |
124 | |
fcf32d04 |
125 | # inject non-left fk-bridges from *INNER-JOINED* children (if any) |
126 | for my $rel (grep { $relinfo->{$_}{is_inner} } keys %$relinfo) { |
127 | my $ri = $relinfo->{$rel}; |
128 | for (keys %{$ri->{fk_map}} ) { |
129 | # need to know source from *our* pov, hence $rel.col |
130 | $my_cols->{$_} ||= { via_fk => "$rel.$ri->{fk_map}{$_}" } |
131 | if defined $rel_cols->{$rel}{$ri->{fk_map}{$_}} # in fact selected |
132 | } |
133 | } |
134 | |
76031e14 |
135 | # if the parent is already defined, assume all of its related FKs are selected |
136 | # (even if they in fact are NOT in the select list). Keep a record of what we |
137 | # assumed, and if any such phantom-column becomes part of our own collapser, |
138 | # throw everything assumed-from-parent away and replace with the collapser of |
139 | # the parent (whatever it may be) |
140 | my $assumed_from_parent; |
82f0e0aa |
141 | unless ($args->{_parent_info}{underdefined}) { |
fcf32d04 |
142 | for my $col ( values %{$args->{_parent_info}{rel_condition} || {}} ) { |
143 | next if exists $my_cols->{$col}; |
144 | $my_cols->{$col} = { via_collapse => $args->{_parent_info}{collapse_on_idcols} }; |
145 | $assumed_from_parent->{columns}{$col}++; |
146 | } |
76031e14 |
147 | } |
148 | |
149 | # get colinfo for everything |
150 | if ($my_cols) { |
151 | my $ci = $self->columns_info; |
152 | $my_cols->{$_}{colinfo} = $ci->{$_} for keys %$my_cols; |
153 | } |
154 | |
155 | my $collapse_map; |
156 | |
3faac878 |
157 | # first try to reuse the parent's collapser (i.e. reuse collapser over 1:1) |
158 | # (makes for a leaner coderef later) |
159 | unless ($collapse_map->{-idcols_current_node}) { |
160 | $collapse_map->{-idcols_current_node} = $args->{_parent_info}{collapse_on_idcols} |
161 | if $args->{_parent_info}{collapser_reusable}; |
162 | } |
163 | |
164 | |
165 | # Still dont know how to collapse - try to resolve based on our columns (plus already inserted FK bridges) |
76031e14 |
166 | if ( |
3faac878 |
167 | ! $collapse_map->{-idcols_current_node} |
168 | and |
76031e14 |
169 | $my_cols |
170 | and |
4e9fc3f3 |
171 | my $idset = $self->_identifying_column_set ({map { $_ => $my_cols->{$_}{colinfo} } keys %$my_cols}) |
76031e14 |
172 | ) { |
173 | # see if the resulting collapser relies on any implied columns, |
174 | # and fix stuff up if this is the case |
4e9fc3f3 |
175 | my @reduced_set = grep { ! $assumed_from_parent->{columns}{$_} } @$idset; |
76031e14 |
176 | |
3faac878 |
177 | $collapse_map->{-idcols_current_node} = [ __unique_numlist( |
178 | @{ $args->{_parent_info}{collapse_on_idcols}||[] }, |
179 | |
76031e14 |
180 | (map |
181 | { |
182 | my $fqc = join ('.', |
82f0e0aa |
183 | @{$args->{_rel_chain}}[1 .. $#{$args->{_rel_chain}}], |
76031e14 |
184 | ( $my_cols->{$_}{via_fk} || $_ ), |
185 | ); |
186 | |
82f0e0aa |
187 | $common_args->{_as_fq_idx}->{$fqc}; |
76031e14 |
188 | } |
4e9fc3f3 |
189 | @reduced_set |
76031e14 |
190 | ), |
3faac878 |
191 | )]; |
76031e14 |
192 | } |
193 | |
194 | # Stil don't know how to collapse - keep descending down 1:1 chains - if |
195 | # a related non-LEFT 1:1 is resolvable - its condition will collapse us |
196 | # too |
3faac878 |
197 | unless ($collapse_map->{-idcols_current_node}) { |
76031e14 |
198 | my @candidates; |
199 | |
200 | for my $rel (keys %$relinfo) { |
201 | next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); |
202 | |
82f0e0aa |
203 | if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
204 | as => $rel_cols->{$rel}, |
205 | _rel_chain => [ @{$args->{_rel_chain}}, $rel ], |
206 | _parent_info => { underdefined => 1 }, |
207 | }, $common_args)) { |
3faac878 |
208 | push @candidates, $rel_collapse->{-idcols_current_node}; |
76031e14 |
209 | } |
210 | } |
211 | |
212 | # get the set with least amount of columns |
213 | # FIXME - maybe need to implement a data type order as well (i.e. prefer several ints |
214 | # to a single varchar) |
215 | if (@candidates) { |
3faac878 |
216 | ($collapse_map->{-idcols_current_node}) = sort { scalar @$a <=> scalar @$b } (@candidates); |
76031e14 |
217 | } |
218 | } |
219 | |
fcf32d04 |
220 | # Stil don't know how to collapse, and we are the root node. Last ditch |
221 | # effort in case we are *NOT* premultiplied. |
222 | # Run through *each multi* all the way down, left or not, and all |
223 | # *left* singles (a single may become a multi underneath) . When everything |
224 | # gets back see if all the rels link to us definitively. If this is the |
225 | # case we are good - either one of them will define us, or if all are NULLs |
226 | # we know we are "unique" due to the "non-premultiplied" check |
227 | if ( |
228 | ! $collapse_map->{-idcols_current_node} |
229 | and |
230 | ! $args->{premultiplied} |
231 | and |
232 | $common_args->{_node_idx} == 1 |
233 | ) { |
234 | my (@collapse_sets, $uncollapsible_chain); |
235 | |
236 | for my $rel (keys %$relinfo) { |
237 | |
238 | # we already looked at these higher up |
239 | next if ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); |
240 | |
241 | if (my $clps = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
242 | as => $rel_cols->{$rel}, |
243 | _rel_chain => [ @{$args->{_rel_chain}}, $rel ], |
244 | _parent_info => { underdefined => 1 }, |
245 | }, $common_args) ) { |
246 | |
247 | # for singles use the idcols wholesale (either there or not) |
248 | if ($relinfo->{$rel}{is_single}) { |
249 | push @collapse_sets, $clps->{-idcols_current_node}; |
250 | } |
251 | elsif (! $relinfo->{$rel}{fk_map}) { |
252 | $uncollapsible_chain = 1; |
253 | last; |
254 | } |
255 | else { |
256 | my $defined_cols_parent_side; |
257 | |
258 | for my $fq_col ( grep { /^$rel\.[^\.]+$/ } keys %{$args->{as}} ) { |
259 | my ($col) = $fq_col =~ /([^\.]+)$/; |
260 | |
261 | $defined_cols_parent_side->{$_} = $args->{as}{$fq_col} for grep |
262 | { $relinfo->{$rel}{fk_map}{$_} eq $col } |
263 | keys %{$relinfo->{$rel}{fk_map}} |
264 | ; |
265 | } |
266 | |
267 | if (my $set = $self->_identifying_column_set([ keys %$defined_cols_parent_side ]) ) { |
268 | push @collapse_sets, [ sort map { $defined_cols_parent_side->{$_} } @$set ]; |
269 | } |
270 | else { |
271 | $uncollapsible_chain = 1; |
272 | last; |
273 | } |
274 | } |
275 | } |
276 | else { |
277 | $uncollapsible_chain = 1; |
278 | last; |
279 | } |
280 | } |
281 | |
282 | unless ($uncollapsible_chain) { |
283 | # if we got here - we are good to go, but the construction is tricky |
284 | # since our children will want to include our collapse criteria - we |
285 | # don't give them anything (safe, since they are all collapsible on their own) |
286 | # in addition we record the individual collapse posibilities |
287 | # of all left children node collapsers, and merge them in the rowparser |
288 | # coderef later |
289 | $collapse_map->{-idcols_current_node} = []; |
290 | $collapse_map->{-root_node_idcol_variants} = [ sort { |
291 | (scalar @$a) <=> (scalar @$b) or max(@$a) <=> max(@$b) |
292 | } @collapse_sets ]; |
293 | } |
294 | } |
295 | |
76031e14 |
296 | # stop descending into children if we were called by a parent for first-pass |
297 | # and don't despair if nothing was found (there may be other parallel branches |
298 | # to dive into) |
82f0e0aa |
299 | if ($args->{_parent_info}{underdefined}) { |
3faac878 |
300 | return $collapse_map->{-idcols_current_node} ? $collapse_map : undef |
76031e14 |
301 | } |
302 | # nothing down the chain resolved - can't calculate a collapse-map |
3faac878 |
303 | elsif (! $collapse_map->{-idcols_current_node}) { |
76031e14 |
304 | $self->throw_exception ( sprintf |
305 | "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns", |
306 | $self->source_name, |
82f0e0aa |
307 | @{$args->{_rel_chain}} > 1 |
308 | ? sprintf (' (last member of the %s chain)', join ' -> ', @{$args->{_rel_chain}} ) |
76031e14 |
309 | : '' |
310 | , |
311 | ); |
312 | } |
313 | |
314 | # If we got that far - we are collapsable - GREAT! Now go down all children |
315 | # a second time, and fill in the rest |
316 | |
82f0e0aa |
317 | $collapse_map->{-is_optional} = 1 if $args->{_parent_info}{is_optional}; |
318 | $collapse_map->{-node_index} = $common_args->{_node_idx}++; |
76031e14 |
319 | |
3faac878 |
320 | |
321 | my @id_sets; |
76031e14 |
322 | for my $rel (sort keys %$relinfo) { |
323 | |
82f0e0aa |
324 | $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
325 | as => { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) }, |
326 | _rel_chain => [ @{$args->{_rel_chain}}, $rel], |
327 | _parent_info => { |
3faac878 |
328 | # shallow copy |
329 | collapse_on_idcols => [ @{$collapse_map->{-idcols_current_node}} ], |
76031e14 |
330 | |
331 | rel_condition => $relinfo->{$rel}{fk_map}, |
332 | |
333 | is_optional => $collapse_map->{-is_optional}, |
334 | |
335 | # if this is a 1:1 our own collapser can be used as a collapse-map |
336 | # (regardless of left or not) |
fcf32d04 |
337 | collapser_reusable => @{$collapse_map->{-idcols_current_node}} && $relinfo->{$rel}{is_single}, |
76031e14 |
338 | }, |
82f0e0aa |
339 | }, $common_args ); |
76031e14 |
340 | |
341 | $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single}; |
342 | $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner}; |
3faac878 |
343 | push @id_sets, ( map { @$_ } ( |
344 | $collapse_map->{$rel}{-idcols_current_node}, |
345 | $collapse_map->{$rel}{-idcols_extra_from_children} || (), |
346 | )); |
76031e14 |
347 | } |
348 | |
3faac878 |
349 | if (@id_sets) { |
350 | my $cur_nodeid_hash = { map { $_ => 1 } @{$collapse_map->{-idcols_current_node}} }; |
351 | $collapse_map->{-idcols_extra_from_children} = [ grep |
352 | { ! $cur_nodeid_hash->{$_} } |
353 | __unique_numlist( @id_sets ) |
354 | ]; |
355 | } |
76031e14 |
356 | |
357 | return $collapse_map; |
358 | } |
359 | |
76031e14 |
360 | # Takes an arrayref of {as} dbic column aliases and the collapse and select |
2d0b795a |
361 | # attributes from the same $rs (the selector requirement is a temporary |
362 | # workaround... I hope), and returns a coderef capable of: |
363 | # my $me_pref_clps = $coderef->([$rs->cursor->next/all]) |
364 | # Where the $me_pref_clps arrayref is the future argument to inflate_result() |
76031e14 |
365 | # |
366 | # For an example of this coderef in action (and to see its guts) look at |
2d0b795a |
367 | # t/resultset/rowparser_internals.t |
76031e14 |
368 | # |
fcf32d04 |
369 | # This is a huge performance win, as we call the same code for every row |
2d0b795a |
370 | # returned from the db, thus avoiding repeated method lookups when traversing |
371 | # relationships |
76031e14 |
372 | # |
373 | # Also since the coderef is completely stateless (the returned structure is |
374 | # always fresh on every new invocation) this is a very good opportunity for |
375 | # memoization if further speed improvements are needed |
376 | # |
2d0b795a |
377 | # The way we construct this coderef is somewhat fugly, although the result is |
378 | # really worth it. The final coderef does not perform any kind of recursion - |
379 | # the entire nested structure constructor is rolled out into a single scope. |
380 | # |
76031e14 |
381 | # In any case - the output of this thing is meticulously micro-tested, so |
2d0b795a |
382 | # any sort of adjustment/rewrite should be relatively easy (fsvo relatively) |
76031e14 |
383 | # |
384 | sub _mk_row_parser { |
385 | my ($self, $args) = @_; |
386 | |
387 | my $inflate_index = { map |
388 | { $args->{inflate_map}[$_] => $_ } |
389 | ( 0 .. $#{$args->{inflate_map}} ) |
390 | }; |
391 | |
2d0b795a |
392 | my $parser_src; |
393 | |
394 | # the non-collapsing assembler is easy |
395 | # FIXME SUBOPTIMAL there could be a yet faster way to do things here, but |
396 | # need to try an actual implementation and benchmark it: |
397 | # |
398 | # <timbunce_> First setup the nested data structure you want for each row |
399 | # Then call bind_col() to alias the row fields into the right place in |
400 | # the data structure, then to fetch the data do: |
401 | # push @rows, dclone($row_data_struct) while ($sth->fetchrow); |
402 | # |
403 | if (!$args->{collapse}) { |
404 | $parser_src = sprintf('$_ = %s for @{$_[0]}', __visit_infmap_simple( |
405 | $inflate_index, |
406 | { rsrc => $self }, # need the $rsrc to sanity-check inflation map once |
407 | )); |
408 | |
409 | # change the quoted placeholders to unquoted alias-references |
410 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$_->[$1]"/gex; |
411 | } |
412 | |
413 | # the collapsing parser is more complicated - it needs to keep a lot of state |
414 | # |
415 | else { |
82f0e0aa |
416 | my $collapse_map = $self->_resolve_collapse ({ |
fcf32d04 |
417 | premultiplied => $args->{premultiplied}, |
76031e14 |
418 | # FIXME |
419 | # only consider real columns (not functions) during collapse resolution |
420 | # this check shouldn't really be here, as fucktards are not supposed to |
421 | # alias random crap to existing column names anyway, but still - just in |
422 | # case |
423 | # FIXME !!!! - this does not yet deal with unbalanced selectors correctly |
2d0b795a |
424 | # (it is now trivial as the attrs specify where things go out of sync |
425 | # needs MOAR tests) |
82f0e0aa |
426 | as => { map |
76031e14 |
427 | { ref $args->{selection}[$inflate_index->{$_}] ? () : ( $_ => $inflate_index->{$_} ) } |
428 | keys %$inflate_index |
429 | } |
82f0e0aa |
430 | }); |
76031e14 |
431 | |
fcf32d04 |
432 | my @all_idcols = sort { $a <=> $b } map { @$_ } ( |
3faac878 |
433 | $collapse_map->{-idcols_current_node}, |
434 | $collapse_map->{-idcols_extra_from_children} || (), |
435 | ); |
76031e14 |
436 | |
fcf32d04 |
437 | my ($top_node_id_path, $top_node_id_cacher, @path_variants); |
438 | if (scalar @{$collapse_map->{-idcols_current_node}}) { |
439 | $top_node_id_path = join ('', map |
440 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
441 | @{$collapse_map->{-idcols_current_node}} |
442 | ); |
443 | } |
444 | elsif( my @variants = @{$collapse_map->{-root_node_idcol_variants}} ) { |
445 | my @path_parts; |
446 | |
447 | for (@variants) { |
448 | |
449 | push @path_variants, sprintf "(join qq(\xFF), '', %s, '')", |
450 | ( join ', ', map { "'\xFF__VALPOS__${_}__\xFF'" } @$_ ) |
451 | ; |
452 | |
453 | push @path_parts, sprintf "( %s && %s)", |
454 | ( join ' && ', map { "( defined '\xFF__VALPOS__${_}__\xFF' )" } @$_ ), |
455 | $path_variants[-1]; |
456 | ; |
457 | } |
458 | |
459 | $top_node_id_cacher = sprintf '$cur_row_ids[%d] = (%s);', |
460 | $all_idcols[-1] + 1, |
461 | "\n" . join( "\n or\n", @path_parts, qq{"\0\$rows_pos\0"} ); |
462 | $top_node_id_path = sprintf '{$cur_row_ids[%d]}', $all_idcols[-1] + 1; |
463 | } |
464 | else { |
465 | $self->throw_exception('Unexpected collapse map contents'); |
466 | } |
76031e14 |
467 | |
4e9fc3f3 |
468 | my $rel_assemblers = __visit_infmap_collapse ( |
fcf32d04 |
469 | $inflate_index, { %$collapse_map, -custom_node_id => $top_node_id_path }, |
76031e14 |
470 | ); |
76031e14 |
471 | |
fcf32d04 |
472 | $parser_src = sprintf (<<'EOS', join(', ', @all_idcols), $top_node_id_path, $top_node_id_cacher||'', $rel_assemblers); |
3faac878 |
473 | ### BEGIN LITERAL STRING EVAL |
4e9fc3f3 |
474 | my ($rows_pos, $result_pos, $cur_row, @cur_row_ids, @collapse_idx, $is_new_res) = (0,0); |
76031e14 |
475 | |
476 | # this loop is a bit arcane - the rationale is that the passed in |
477 | # $_[0] will either have only one row (->next) or will have all |
478 | # rows already pulled in (->all and/or unordered). Given that the |
479 | # result can be rather large - we reuse the same already allocated |
480 | # array, since the collapsed prefetch is smaller by definition. |
481 | # At the end we cut the leftovers away and move on. |
482 | while ($cur_row = |
4e9fc3f3 |
483 | ( ( $rows_pos >= 0 and $_[0][$rows_pos++] ) or do { $rows_pos = -1; undef } ) |
76031e14 |
484 | || |
485 | ($_[1] and $_[1]->()) |
486 | ) { |
487 | |
3faac878 |
488 | # due to left joins some of the ids may be NULL/undef, and |
489 | # won't play well when used as hash lookups |
fcf32d04 |
490 | # we also need to differentiate NULLs on per-row/per-col basis |
491 | #(otherwise folding of optional 1:1s will be greatly confused |
492 | $cur_row_ids[$_] = defined $cur_row->[$_] ? $cur_row->[$_] : "\0NULL\xFF$rows_pos\xFF$_\0" |
3faac878 |
493 | for (%1$s); |
76031e14 |
494 | |
fcf32d04 |
495 | # maybe(!) cache the top node id calculation |
496 | %3$s |
497 | |
4e9fc3f3 |
498 | $is_new_res = ! $collapse_idx[1]%2$s and ( |
499 | $_[1] and $result_pos and (unshift @{$_[2]}, $cur_row) and last |
500 | ); |
76031e14 |
501 | |
fcf32d04 |
502 | %4$s |
76031e14 |
503 | |
4e9fc3f3 |
504 | $_[0][$result_pos++] = $collapse_idx[1]%2$s |
76031e14 |
505 | if $is_new_res; |
506 | } |
507 | |
508 | splice @{$_[0]}, $result_pos; # truncate the passed in array for cases of collapsing ->all() |
3faac878 |
509 | ### END LITERAL STRING EVAL |
76031e14 |
510 | EOS |
511 | |
2d0b795a |
512 | # !!! note - different var than the one above |
76031e14 |
513 | # change the quoted placeholders to unquoted alias-references |
514 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$cur_row->[$1]"/gex; |
4e9fc3f3 |
515 | $parser_src =~ s/ \' \xFF__IDVALPOS__(\d+)__\xFF \' /"\$cur_row_ids[$1]"/gex; |
76031e14 |
516 | } |
517 | |
76031e14 |
518 | $parser_src; |
519 | } |
520 | |
2d0b795a |
521 | # the simple non-collapsing nested structure recursor |
76031e14 |
522 | sub __visit_infmap_simple { |
523 | my ($val_idx, $args) = @_; |
524 | |
525 | my $my_cols = {}; |
526 | my $rel_cols; |
527 | for (keys %$val_idx) { |
528 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
529 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
530 | } |
531 | else { |
532 | $my_cols->{$_} = $val_idx->{$_}; |
533 | } |
534 | } |
535 | my @relperl; |
536 | for my $rel (sort keys %$rel_cols) { |
537 | |
2d0b795a |
538 | # DISABLEPRUNE |
76031e14 |
539 | #my $optional = $args->{is_optional}; |
540 | #$optional ||= ($args->{rsrc}->relationship_info($rel)->{attrs}{join_type} || '') =~ /^left/i; |
541 | |
542 | push @relperl, join ' => ', perlstring($rel), __visit_infmap_simple($rel_cols->{$rel}, { |
2d0b795a |
543 | rsrc => __get_related_source($args->{rsrc}, $rel, $rel_cols->{$rel}), |
544 | # DISABLEPRUNE |
545 | #non_top => 1, |
76031e14 |
546 | #is_optional => $optional, |
76031e14 |
547 | }); |
548 | |
2d0b795a |
549 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
550 | #if ($optional and my @branch_null_checks = map |
551 | # { "(! defined '\xFF__VALPOS__${_}__\xFF')" } |
552 | # sort { $a <=> $b } values %{$rel_cols->{$rel}} |
553 | #) { |
554 | # $relperl[-1] = sprintf ( '(%s) ? ( %s => [] ) : ( %s )', |
555 | # join (' && ', @branch_null_checks ), |
556 | # perlstring($rel), |
557 | # $relperl[-1], |
558 | # ); |
559 | #} |
560 | } |
561 | |
562 | my $me_struct = keys %$my_cols |
563 | ? __visit_dump({ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }) |
564 | : 'undef' |
565 | ; |
566 | |
567 | return sprintf '[%s]', join (',', |
568 | $me_struct, |
569 | @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (), |
570 | ); |
571 | } |
572 | |
2d0b795a |
573 | # the collapsing nested structure recursor |
76031e14 |
574 | sub __visit_infmap_collapse { |
575 | |
576 | my ($val_idx, $collapse_map, $parent_info) = @_; |
577 | |
578 | my $my_cols = {}; |
579 | my $rel_cols; |
580 | for (keys %$val_idx) { |
581 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
582 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
583 | } |
584 | else { |
585 | $my_cols->{$_} = $val_idx->{$_}; |
586 | } |
587 | } |
588 | |
fcf32d04 |
589 | my $sequenced_node_id = $collapse_map->{-custom_node_id} || join ('', map |
76031e14 |
590 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
3faac878 |
591 | @{$collapse_map->{-idcols_current_node}} |
76031e14 |
592 | ); |
593 | |
594 | my $me_struct = keys %$my_cols |
595 | ? __visit_dump([{ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }]) |
4e9fc3f3 |
596 | : undef |
76031e14 |
597 | ; |
598 | my $node_idx_ref = sprintf '$collapse_idx[%d]%s', $collapse_map->{-node_index}, $sequenced_node_id; |
599 | |
600 | my $parent_idx_ref = sprintf( '$collapse_idx[%d]%s[1]{%s}', |
601 | @{$parent_info}{qw/node_idx sequenced_node_id/}, |
602 | perlstring($parent_info->{relname}), |
603 | ) if $parent_info; |
604 | |
605 | my @src; |
606 | if ($collapse_map->{-node_index} == 1) { |
607 | push @src, sprintf( '%s ||= %s;', |
608 | $node_idx_ref, |
609 | $me_struct, |
4e9fc3f3 |
610 | ) if $me_struct; |
76031e14 |
611 | } |
612 | elsif ($collapse_map->{-is_single}) { |
4e9fc3f3 |
613 | push @src, sprintf ( '%s ||= %s%s;', |
76031e14 |
614 | $parent_idx_ref, |
615 | $node_idx_ref, |
4e9fc3f3 |
616 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
617 | ); |
618 | } |
619 | else { |
4e9fc3f3 |
620 | push @src, sprintf('push @{%s}, %s%s unless %s;', |
76031e14 |
621 | $parent_idx_ref, |
622 | $node_idx_ref, |
4e9fc3f3 |
623 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
624 | $node_idx_ref, |
625 | ); |
626 | } |
627 | |
2d0b795a |
628 | # DISABLEPRUNE |
76031e14 |
629 | #my $known_defined = { %{ $parent_info->{known_defined} || {} } }; |
3faac878 |
630 | #$known_defined->{$_}++ for @{$collapse_map->{-idcols_current_node}}; |
76031e14 |
631 | for my $rel (sort keys %$rel_cols) { |
632 | |
3faac878 |
633 | # push @src, sprintf( |
634 | # '%s[1]{%s} ||= [];', $node_idx_ref, perlstring($rel) |
635 | # ) unless $collapse_map->{$rel}{-is_single}; |
76031e14 |
636 | |
637 | push @src, __visit_infmap_collapse($rel_cols->{$rel}, $collapse_map->{$rel}, { |
638 | node_idx => $collapse_map->{-node_index}, |
639 | sequenced_node_id => $sequenced_node_id, |
640 | relname => $rel, |
2d0b795a |
641 | # DISABLEPRUNE |
76031e14 |
642 | #known_defined => $known_defined, |
643 | }); |
644 | |
2d0b795a |
645 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
646 | #if ($collapse_map->{$rel}{-is_optional} and my @null_checks = map |
4e9fc3f3 |
647 | # { "(! defined '\xFF__IDVALPOS__${_}__\xFF')" } |
76031e14 |
648 | # sort { $a <=> $b } grep |
649 | # { ! $known_defined->{$_} } |
3faac878 |
650 | # @{$collapse_map->{$rel}{-idcols_current_node}} |
76031e14 |
651 | #) { |
652 | # $src[-1] = sprintf( '(%s) or %s', |
653 | # join (' || ', @null_checks ), |
654 | # $src[-1], |
655 | # ); |
656 | #} |
657 | } |
658 | |
659 | join "\n", @src; |
660 | } |
661 | |
662 | # adding a dep on MoreUtils *just* for this is retarded |
663 | sub __unique_numlist { |
3faac878 |
664 | sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }} |
76031e14 |
665 | } |
666 | |
667 | # This error must be thrown from two distinct codepaths, joining them is |
668 | # rather hard. Go for this hack instead. |
669 | sub __get_related_source { |
670 | my ($rsrc, $rel, $relcols) = @_; |
671 | try { |
672 | $rsrc->related_source ($rel) |
673 | } catch { |
674 | $rsrc->throw_exception(sprintf( |
675 | "Can't inflate prefetch into non-existent relationship '%s' from '%s', " |
676 | . "check the inflation specification (columns/as) ending in '...%s.%s'.", |
677 | $rel, |
678 | $rsrc->source_name, |
679 | $rel, |
680 | (sort { length($a) <=> length ($b) } keys %$relcols)[0], |
681 | ))}; |
682 | } |
683 | |
684 | # keep our own DD object around so we don't have to fitz with quoting |
685 | my $dumper_obj; |
686 | sub __visit_dump { |
687 | # we actually will be producing functional perl code here, |
688 | # thus no second-guessing of what these globals might have |
689 | # been set to. DO NOT CHANGE! |
690 | ($dumper_obj ||= do { |
691 | require Data::Dumper; |
692 | Data::Dumper->new([]) |
2d0b795a |
693 | ->Useperl (0) |
76031e14 |
694 | ->Purity (1) |
695 | ->Pad ('') |
696 | ->Useqq (0) |
697 | ->Terse (1) |
698 | ->Quotekeys (1) |
699 | ->Deepcopy (0) |
700 | ->Deparse (0) |
701 | ->Maxdepth (0) |
702 | ->Indent (0) # faster but harder to read, perhaps leave at 1 ? |
703 | })->Values ([$_[0]])->Dump; |
704 | } |
705 | |
706 | 1; |