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; |
8 | use List::Util 'first'; |
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 { |
90 | $my_cols->{$_} = {}; # important for ||= below |
91 | } |
92 | } |
93 | |
94 | my $relinfo; |
95 | # run through relationships, collect metadata, inject non-left fk-bridges from |
96 | # *INNER-JOINED* children (if any) |
97 | for my $rel (keys %$rel_cols) { |
98 | my $rel_src = __get_related_source($self, $rel, $rel_cols->{$rel}); |
99 | |
100 | my $inf = $self->relationship_info ($rel); |
101 | |
102 | $relinfo->{$rel}{is_single} = $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi'; |
103 | $relinfo->{$rel}{is_inner} = ( $inf->{attrs}{join_type} || '' ) !~ /^left/i; |
104 | $relinfo->{$rel}{rsrc} = $rel_src; |
105 | |
106 | my $cond = $inf->{cond}; |
107 | |
108 | if ( |
109 | ref $cond eq 'HASH' |
110 | and |
111 | keys %$cond |
112 | and |
113 | ! first { $_ !~ /^foreign\./ } (keys %$cond) |
114 | and |
115 | ! first { $_ !~ /^self\./ } (values %$cond) |
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; |
121 | |
4e9fc3f3 |
122 | # need to know source from *our* pov, hence $rel. |
76031e14 |
123 | $my_cols->{$s} ||= { via_fk => "$rel.$f" } if ( |
124 | defined $rel_cols->{$rel}{$f} # in fact selected |
125 | and |
4e9fc3f3 |
126 | $relinfo->{$rel}{is_inner} |
76031e14 |
127 | ); |
128 | } |
129 | } |
130 | } |
131 | |
132 | # if the parent is already defined, assume all of its related FKs are selected |
133 | # (even if they in fact are NOT in the select list). Keep a record of what we |
134 | # assumed, and if any such phantom-column becomes part of our own collapser, |
135 | # throw everything assumed-from-parent away and replace with the collapser of |
136 | # the parent (whatever it may be) |
137 | my $assumed_from_parent; |
82f0e0aa |
138 | unless ($args->{_parent_info}{underdefined}) { |
76031e14 |
139 | $assumed_from_parent->{columns} = { map |
140 | # only add to the list if we do not already select said columns |
141 | { ! exists $my_cols->{$_} ? ( $_ => 1 ) : () } |
82f0e0aa |
142 | values %{$args->{_parent_info}{rel_condition} || {}} |
76031e14 |
143 | }; |
144 | |
82f0e0aa |
145 | $my_cols->{$_} = { via_collapse => $args->{_parent_info}{collapse_on} } |
76031e14 |
146 | for keys %{$assumed_from_parent->{columns}}; |
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 | |
157 | # try to resolve based on our columns (plus already inserted FK bridges) |
158 | if ( |
159 | $my_cols |
160 | and |
4e9fc3f3 |
161 | my $idset = $self->_identifying_column_set ({map { $_ => $my_cols->{$_}{colinfo} } keys %$my_cols}) |
76031e14 |
162 | ) { |
163 | # see if the resulting collapser relies on any implied columns, |
164 | # and fix stuff up if this is the case |
4e9fc3f3 |
165 | my @reduced_set = grep { ! $assumed_from_parent->{columns}{$_} } @$idset; |
76031e14 |
166 | |
76031e14 |
167 | $collapse_map->{-node_id} = __unique_numlist( |
82f0e0aa |
168 | (@reduced_set != @$idset) ? @{$args->{_parent_info}{collapse_on}} : (), |
76031e14 |
169 | (map |
170 | { |
171 | my $fqc = join ('.', |
82f0e0aa |
172 | @{$args->{_rel_chain}}[1 .. $#{$args->{_rel_chain}}], |
76031e14 |
173 | ( $my_cols->{$_}{via_fk} || $_ ), |
174 | ); |
175 | |
82f0e0aa |
176 | $common_args->{_as_fq_idx}->{$fqc}; |
76031e14 |
177 | } |
4e9fc3f3 |
178 | @reduced_set |
76031e14 |
179 | ), |
180 | ); |
181 | } |
182 | |
183 | # Stil don't know how to collapse - keep descending down 1:1 chains - if |
184 | # a related non-LEFT 1:1 is resolvable - its condition will collapse us |
185 | # too |
186 | unless ($collapse_map->{-node_id}) { |
187 | my @candidates; |
188 | |
189 | for my $rel (keys %$relinfo) { |
190 | next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); |
191 | |
82f0e0aa |
192 | if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
193 | as => $rel_cols->{$rel}, |
194 | _rel_chain => [ @{$args->{_rel_chain}}, $rel ], |
195 | _parent_info => { underdefined => 1 }, |
196 | }, $common_args)) { |
76031e14 |
197 | push @candidates, $rel_collapse->{-node_id}; |
198 | } |
199 | } |
200 | |
201 | # get the set with least amount of columns |
202 | # FIXME - maybe need to implement a data type order as well (i.e. prefer several ints |
203 | # to a single varchar) |
204 | if (@candidates) { |
205 | ($collapse_map->{-node_id}) = sort { scalar @$a <=> scalar @$b } (@candidates); |
206 | } |
207 | } |
208 | |
209 | # Still dont know how to collapse - see if the parent passed us anything |
210 | # (i.e. reuse collapser over 1:1) |
211 | unless ($collapse_map->{-node_id}) { |
82f0e0aa |
212 | $collapse_map->{-node_id} = $args->{_parent_info}{collapse_on} |
213 | if $args->{_parent_info}{collapser_reusable}; |
76031e14 |
214 | } |
215 | |
216 | # stop descending into children if we were called by a parent for first-pass |
217 | # and don't despair if nothing was found (there may be other parallel branches |
218 | # to dive into) |
82f0e0aa |
219 | if ($args->{_parent_info}{underdefined}) { |
76031e14 |
220 | return $collapse_map->{-node_id} ? $collapse_map : undef |
221 | } |
222 | # nothing down the chain resolved - can't calculate a collapse-map |
223 | elsif (! $collapse_map->{-node_id}) { |
224 | $self->throw_exception ( sprintf |
225 | "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns", |
226 | $self->source_name, |
82f0e0aa |
227 | @{$args->{_rel_chain}} > 1 |
228 | ? sprintf (' (last member of the %s chain)', join ' -> ', @{$args->{_rel_chain}} ) |
76031e14 |
229 | : '' |
230 | , |
231 | ); |
232 | } |
233 | |
234 | # If we got that far - we are collapsable - GREAT! Now go down all children |
235 | # a second time, and fill in the rest |
236 | |
82f0e0aa |
237 | $collapse_map->{-is_optional} = 1 if $args->{_parent_info}{is_optional}; |
238 | $collapse_map->{-node_index} = $common_args->{_node_idx}++; |
76031e14 |
239 | |
240 | my (@id_sets, $multis_in_chain); |
241 | for my $rel (sort keys %$relinfo) { |
242 | |
82f0e0aa |
243 | $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
244 | as => { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) }, |
245 | _rel_chain => [ @{$args->{_rel_chain}}, $rel], |
246 | _parent_info => { |
76031e14 |
247 | collapse_on => [ @{$collapse_map->{-node_id}} ], |
248 | |
249 | rel_condition => $relinfo->{$rel}{fk_map}, |
250 | |
251 | is_optional => $collapse_map->{-is_optional}, |
252 | |
253 | # if this is a 1:1 our own collapser can be used as a collapse-map |
254 | # (regardless of left or not) |
255 | collapser_reusable => $relinfo->{$rel}{is_single}, |
256 | }, |
82f0e0aa |
257 | }, $common_args ); |
76031e14 |
258 | |
259 | $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single}; |
260 | $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner}; |
261 | push @id_sets, @{ $collapse_map->{$rel}{-branch_id} }; |
262 | } |
263 | |
264 | $collapse_map->{-branch_id} = __unique_numlist( @id_sets, @{$collapse_map->{-node_id}} ); |
265 | |
266 | return $collapse_map; |
267 | } |
268 | |
76031e14 |
269 | # Takes an arrayref of {as} dbic column aliases and the collapse and select |
2d0b795a |
270 | # attributes from the same $rs (the selector requirement is a temporary |
271 | # workaround... I hope), and returns a coderef capable of: |
272 | # my $me_pref_clps = $coderef->([$rs->cursor->next/all]) |
273 | # Where the $me_pref_clps arrayref is the future argument to inflate_result() |
76031e14 |
274 | # |
275 | # For an example of this coderef in action (and to see its guts) look at |
2d0b795a |
276 | # t/resultset/rowparser_internals.t |
76031e14 |
277 | # |
2d0b795a |
278 | # This is a huge performance win, as we call the same code for # every row |
279 | # returned from the db, thus avoiding repeated method lookups when traversing |
280 | # relationships |
76031e14 |
281 | # |
282 | # Also since the coderef is completely stateless (the returned structure is |
283 | # always fresh on every new invocation) this is a very good opportunity for |
284 | # memoization if further speed improvements are needed |
285 | # |
2d0b795a |
286 | # The way we construct this coderef is somewhat fugly, although the result is |
287 | # really worth it. The final coderef does not perform any kind of recursion - |
288 | # the entire nested structure constructor is rolled out into a single scope. |
289 | # |
76031e14 |
290 | # In any case - the output of this thing is meticulously micro-tested, so |
2d0b795a |
291 | # any sort of adjustment/rewrite should be relatively easy (fsvo relatively) |
76031e14 |
292 | # |
293 | sub _mk_row_parser { |
294 | my ($self, $args) = @_; |
295 | |
296 | my $inflate_index = { map |
297 | { $args->{inflate_map}[$_] => $_ } |
298 | ( 0 .. $#{$args->{inflate_map}} ) |
299 | }; |
300 | |
2d0b795a |
301 | my $parser_src; |
302 | |
303 | # the non-collapsing assembler is easy |
304 | # FIXME SUBOPTIMAL there could be a yet faster way to do things here, but |
305 | # need to try an actual implementation and benchmark it: |
306 | # |
307 | # <timbunce_> First setup the nested data structure you want for each row |
308 | # Then call bind_col() to alias the row fields into the right place in |
309 | # the data structure, then to fetch the data do: |
310 | # push @rows, dclone($row_data_struct) while ($sth->fetchrow); |
311 | # |
312 | if (!$args->{collapse}) { |
313 | $parser_src = sprintf('$_ = %s for @{$_[0]}', __visit_infmap_simple( |
314 | $inflate_index, |
315 | { rsrc => $self }, # need the $rsrc to sanity-check inflation map once |
316 | )); |
317 | |
318 | # change the quoted placeholders to unquoted alias-references |
319 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$_->[$1]"/gex; |
320 | } |
321 | |
322 | # the collapsing parser is more complicated - it needs to keep a lot of state |
323 | # |
324 | else { |
76031e14 |
325 | |
82f0e0aa |
326 | my $collapse_map = $self->_resolve_collapse ({ |
76031e14 |
327 | # FIXME |
328 | # only consider real columns (not functions) during collapse resolution |
329 | # this check shouldn't really be here, as fucktards are not supposed to |
330 | # alias random crap to existing column names anyway, but still - just in |
331 | # case |
332 | # FIXME !!!! - this does not yet deal with unbalanced selectors correctly |
2d0b795a |
333 | # (it is now trivial as the attrs specify where things go out of sync |
334 | # needs MOAR tests) |
82f0e0aa |
335 | as => { map |
76031e14 |
336 | { ref $args->{selection}[$inflate_index->{$_}] ? () : ( $_ => $inflate_index->{$_} ) } |
337 | keys %$inflate_index |
338 | } |
82f0e0aa |
339 | }); |
76031e14 |
340 | |
4e9fc3f3 |
341 | my $top_branch_idx_list = join (', ', @{$collapse_map->{-branch_id}}); |
76031e14 |
342 | |
4e9fc3f3 |
343 | my $top_node_id_path = join ('', map |
344 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
345 | @{$collapse_map->{-node_id}} |
346 | ); |
76031e14 |
347 | |
4e9fc3f3 |
348 | my $rel_assemblers = __visit_infmap_collapse ( |
76031e14 |
349 | $inflate_index, $collapse_map |
350 | ); |
76031e14 |
351 | |
4e9fc3f3 |
352 | $parser_src = sprintf (<<'EOS', $top_branch_idx_list, $top_node_id_path, $rel_assemblers); |
76031e14 |
353 | ### BEGIN STRING EVAL |
4e9fc3f3 |
354 | |
355 | my ($rows_pos, $result_pos, $cur_row, @cur_row_ids, @collapse_idx, $is_new_res) = (0,0); |
76031e14 |
356 | |
357 | # this loop is a bit arcane - the rationale is that the passed in |
358 | # $_[0] will either have only one row (->next) or will have all |
359 | # rows already pulled in (->all and/or unordered). Given that the |
360 | # result can be rather large - we reuse the same already allocated |
361 | # array, since the collapsed prefetch is smaller by definition. |
362 | # At the end we cut the leftovers away and move on. |
363 | while ($cur_row = |
4e9fc3f3 |
364 | ( ( $rows_pos >= 0 and $_[0][$rows_pos++] ) or do { $rows_pos = -1; undef } ) |
76031e14 |
365 | || |
366 | ($_[1] and $_[1]->()) |
367 | ) { |
368 | |
4e9fc3f3 |
369 | $cur_row_ids[$_] = defined $cur_row->[$_] ? $cur_row->[$_] : "\xFF\xFFN\xFFU\xFFL\xFFL\xFF\xFF" |
76031e14 |
370 | for (%1$s); # the top branch_id includes all id values |
371 | |
4e9fc3f3 |
372 | $is_new_res = ! $collapse_idx[1]%2$s and ( |
373 | $_[1] and $result_pos and (unshift @{$_[2]}, $cur_row) and last |
374 | ); |
76031e14 |
375 | |
4e9fc3f3 |
376 | %3$s |
76031e14 |
377 | |
4e9fc3f3 |
378 | $_[0][$result_pos++] = $collapse_idx[1]%2$s |
76031e14 |
379 | if $is_new_res; |
380 | } |
381 | |
382 | splice @{$_[0]}, $result_pos; # truncate the passed in array for cases of collapsing ->all() |
383 | ### END STRING EVAL |
384 | EOS |
385 | |
2d0b795a |
386 | # !!! note - different var than the one above |
76031e14 |
387 | # change the quoted placeholders to unquoted alias-references |
388 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$cur_row->[$1]"/gex; |
4e9fc3f3 |
389 | $parser_src =~ s/ \' \xFF__IDVALPOS__(\d+)__\xFF \' /"\$cur_row_ids[$1]"/gex; |
76031e14 |
390 | } |
391 | |
76031e14 |
392 | $parser_src; |
393 | } |
394 | |
2d0b795a |
395 | # the simple non-collapsing nested structure recursor |
76031e14 |
396 | sub __visit_infmap_simple { |
397 | my ($val_idx, $args) = @_; |
398 | |
399 | my $my_cols = {}; |
400 | my $rel_cols; |
401 | for (keys %$val_idx) { |
402 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
403 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
404 | } |
405 | else { |
406 | $my_cols->{$_} = $val_idx->{$_}; |
407 | } |
408 | } |
409 | my @relperl; |
410 | for my $rel (sort keys %$rel_cols) { |
411 | |
2d0b795a |
412 | # DISABLEPRUNE |
76031e14 |
413 | #my $optional = $args->{is_optional}; |
414 | #$optional ||= ($args->{rsrc}->relationship_info($rel)->{attrs}{join_type} || '') =~ /^left/i; |
415 | |
416 | push @relperl, join ' => ', perlstring($rel), __visit_infmap_simple($rel_cols->{$rel}, { |
2d0b795a |
417 | rsrc => __get_related_source($args->{rsrc}, $rel, $rel_cols->{$rel}), |
418 | # DISABLEPRUNE |
419 | #non_top => 1, |
76031e14 |
420 | #is_optional => $optional, |
76031e14 |
421 | }); |
422 | |
2d0b795a |
423 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
424 | #if ($optional and my @branch_null_checks = map |
425 | # { "(! defined '\xFF__VALPOS__${_}__\xFF')" } |
426 | # sort { $a <=> $b } values %{$rel_cols->{$rel}} |
427 | #) { |
428 | # $relperl[-1] = sprintf ( '(%s) ? ( %s => [] ) : ( %s )', |
429 | # join (' && ', @branch_null_checks ), |
430 | # perlstring($rel), |
431 | # $relperl[-1], |
432 | # ); |
433 | #} |
434 | } |
435 | |
436 | my $me_struct = keys %$my_cols |
437 | ? __visit_dump({ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }) |
438 | : 'undef' |
439 | ; |
440 | |
441 | return sprintf '[%s]', join (',', |
442 | $me_struct, |
443 | @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (), |
444 | ); |
445 | } |
446 | |
2d0b795a |
447 | # the collapsing nested structure recursor |
76031e14 |
448 | sub __visit_infmap_collapse { |
449 | |
450 | my ($val_idx, $collapse_map, $parent_info) = @_; |
451 | |
452 | my $my_cols = {}; |
453 | my $rel_cols; |
454 | for (keys %$val_idx) { |
455 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
456 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
457 | } |
458 | else { |
459 | $my_cols->{$_} = $val_idx->{$_}; |
460 | } |
461 | } |
462 | |
463 | my $sequenced_node_id = join ('', map |
464 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
465 | @{$collapse_map->{-node_id}} |
466 | ); |
467 | |
468 | my $me_struct = keys %$my_cols |
469 | ? __visit_dump([{ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }]) |
4e9fc3f3 |
470 | : undef |
76031e14 |
471 | ; |
472 | my $node_idx_ref = sprintf '$collapse_idx[%d]%s', $collapse_map->{-node_index}, $sequenced_node_id; |
473 | |
474 | my $parent_idx_ref = sprintf( '$collapse_idx[%d]%s[1]{%s}', |
475 | @{$parent_info}{qw/node_idx sequenced_node_id/}, |
476 | perlstring($parent_info->{relname}), |
477 | ) if $parent_info; |
478 | |
479 | my @src; |
480 | if ($collapse_map->{-node_index} == 1) { |
481 | push @src, sprintf( '%s ||= %s;', |
482 | $node_idx_ref, |
483 | $me_struct, |
4e9fc3f3 |
484 | ) if $me_struct; |
76031e14 |
485 | } |
486 | elsif ($collapse_map->{-is_single}) { |
4e9fc3f3 |
487 | push @src, sprintf ( '%s ||= %s%s;', |
76031e14 |
488 | $parent_idx_ref, |
489 | $node_idx_ref, |
4e9fc3f3 |
490 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
491 | ); |
492 | } |
493 | else { |
4e9fc3f3 |
494 | push @src, sprintf('push @{%s}, %s%s unless %s;', |
76031e14 |
495 | $parent_idx_ref, |
496 | $node_idx_ref, |
4e9fc3f3 |
497 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
498 | $node_idx_ref, |
499 | ); |
500 | } |
501 | |
2d0b795a |
502 | # DISABLEPRUNE |
76031e14 |
503 | #my $known_defined = { %{ $parent_info->{known_defined} || {} } }; |
504 | #$known_defined->{$_}++ for @{$collapse_map->{-node_id}}; |
505 | |
506 | for my $rel (sort keys %$rel_cols) { |
507 | |
4e9fc3f3 |
508 | push @src, sprintf( '%s[1]{%s} ||= [];', $node_idx_ref, perlstring($rel) ) |
509 | unless $collapse_map->{$rel}{-is_single}; |
76031e14 |
510 | |
511 | push @src, __visit_infmap_collapse($rel_cols->{$rel}, $collapse_map->{$rel}, { |
512 | node_idx => $collapse_map->{-node_index}, |
513 | sequenced_node_id => $sequenced_node_id, |
514 | relname => $rel, |
2d0b795a |
515 | # DISABLEPRUNE |
76031e14 |
516 | #known_defined => $known_defined, |
517 | }); |
518 | |
2d0b795a |
519 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
520 | #if ($collapse_map->{$rel}{-is_optional} and my @null_checks = map |
4e9fc3f3 |
521 | # { "(! defined '\xFF__IDVALPOS__${_}__\xFF')" } |
76031e14 |
522 | # sort { $a <=> $b } grep |
523 | # { ! $known_defined->{$_} } |
524 | # @{$collapse_map->{$rel}{-node_id}} |
525 | #) { |
526 | # $src[-1] = sprintf( '(%s) or %s', |
527 | # join (' || ', @null_checks ), |
528 | # $src[-1], |
529 | # ); |
530 | #} |
531 | } |
532 | |
533 | join "\n", @src; |
534 | } |
535 | |
536 | # adding a dep on MoreUtils *just* for this is retarded |
537 | sub __unique_numlist { |
538 | [ sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }} ] |
539 | } |
540 | |
541 | # This error must be thrown from two distinct codepaths, joining them is |
542 | # rather hard. Go for this hack instead. |
543 | sub __get_related_source { |
544 | my ($rsrc, $rel, $relcols) = @_; |
545 | try { |
546 | $rsrc->related_source ($rel) |
547 | } catch { |
548 | $rsrc->throw_exception(sprintf( |
549 | "Can't inflate prefetch into non-existent relationship '%s' from '%s', " |
550 | . "check the inflation specification (columns/as) ending in '...%s.%s'.", |
551 | $rel, |
552 | $rsrc->source_name, |
553 | $rel, |
554 | (sort { length($a) <=> length ($b) } keys %$relcols)[0], |
555 | ))}; |
556 | } |
557 | |
558 | # keep our own DD object around so we don't have to fitz with quoting |
559 | my $dumper_obj; |
560 | sub __visit_dump { |
561 | # we actually will be producing functional perl code here, |
562 | # thus no second-guessing of what these globals might have |
563 | # been set to. DO NOT CHANGE! |
564 | ($dumper_obj ||= do { |
565 | require Data::Dumper; |
566 | Data::Dumper->new([]) |
2d0b795a |
567 | ->Useperl (0) |
76031e14 |
568 | ->Purity (1) |
569 | ->Pad ('') |
570 | ->Useqq (0) |
571 | ->Terse (1) |
572 | ->Quotekeys (1) |
573 | ->Deepcopy (0) |
574 | ->Deparse (0) |
575 | ->Maxdepth (0) |
576 | ->Indent (0) # faster but harder to read, perhaps leave at 1 ? |
577 | })->Values ([$_[0]])->Dump; |
578 | } |
579 | |
580 | 1; |