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 | |
3faac878 |
145 | $my_cols->{$_} = { via_collapse => $args->{_parent_info}{collapse_on_idcols} } |
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 | |
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 | |
76031e14 |
220 | # stop descending into children if we were called by a parent for first-pass |
221 | # and don't despair if nothing was found (there may be other parallel branches |
222 | # to dive into) |
82f0e0aa |
223 | if ($args->{_parent_info}{underdefined}) { |
3faac878 |
224 | return $collapse_map->{-idcols_current_node} ? $collapse_map : undef |
76031e14 |
225 | } |
226 | # nothing down the chain resolved - can't calculate a collapse-map |
3faac878 |
227 | elsif (! $collapse_map->{-idcols_current_node}) { |
76031e14 |
228 | $self->throw_exception ( sprintf |
229 | "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns", |
230 | $self->source_name, |
82f0e0aa |
231 | @{$args->{_rel_chain}} > 1 |
232 | ? sprintf (' (last member of the %s chain)', join ' -> ', @{$args->{_rel_chain}} ) |
76031e14 |
233 | : '' |
234 | , |
235 | ); |
236 | } |
237 | |
238 | # If we got that far - we are collapsable - GREAT! Now go down all children |
239 | # a second time, and fill in the rest |
240 | |
82f0e0aa |
241 | $collapse_map->{-is_optional} = 1 if $args->{_parent_info}{is_optional}; |
242 | $collapse_map->{-node_index} = $common_args->{_node_idx}++; |
76031e14 |
243 | |
3faac878 |
244 | |
245 | my @id_sets; |
76031e14 |
246 | for my $rel (sort keys %$relinfo) { |
247 | |
82f0e0aa |
248 | $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
249 | as => { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) }, |
250 | _rel_chain => [ @{$args->{_rel_chain}}, $rel], |
251 | _parent_info => { |
3faac878 |
252 | # shallow copy |
253 | collapse_on_idcols => [ @{$collapse_map->{-idcols_current_node}} ], |
76031e14 |
254 | |
255 | rel_condition => $relinfo->{$rel}{fk_map}, |
256 | |
257 | is_optional => $collapse_map->{-is_optional}, |
258 | |
259 | # if this is a 1:1 our own collapser can be used as a collapse-map |
260 | # (regardless of left or not) |
261 | collapser_reusable => $relinfo->{$rel}{is_single}, |
262 | }, |
82f0e0aa |
263 | }, $common_args ); |
76031e14 |
264 | |
265 | $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single}; |
266 | $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner}; |
3faac878 |
267 | push @id_sets, ( map { @$_ } ( |
268 | $collapse_map->{$rel}{-idcols_current_node}, |
269 | $collapse_map->{$rel}{-idcols_extra_from_children} || (), |
270 | )); |
76031e14 |
271 | } |
272 | |
3faac878 |
273 | if (@id_sets) { |
274 | my $cur_nodeid_hash = { map { $_ => 1 } @{$collapse_map->{-idcols_current_node}} }; |
275 | $collapse_map->{-idcols_extra_from_children} = [ grep |
276 | { ! $cur_nodeid_hash->{$_} } |
277 | __unique_numlist( @id_sets ) |
278 | ]; |
279 | } |
76031e14 |
280 | |
281 | return $collapse_map; |
282 | } |
283 | |
76031e14 |
284 | # Takes an arrayref of {as} dbic column aliases and the collapse and select |
2d0b795a |
285 | # attributes from the same $rs (the selector requirement is a temporary |
286 | # workaround... I hope), and returns a coderef capable of: |
287 | # my $me_pref_clps = $coderef->([$rs->cursor->next/all]) |
288 | # Where the $me_pref_clps arrayref is the future argument to inflate_result() |
76031e14 |
289 | # |
290 | # For an example of this coderef in action (and to see its guts) look at |
2d0b795a |
291 | # t/resultset/rowparser_internals.t |
76031e14 |
292 | # |
2d0b795a |
293 | # This is a huge performance win, as we call the same code for # every row |
294 | # returned from the db, thus avoiding repeated method lookups when traversing |
295 | # relationships |
76031e14 |
296 | # |
297 | # Also since the coderef is completely stateless (the returned structure is |
298 | # always fresh on every new invocation) this is a very good opportunity for |
299 | # memoization if further speed improvements are needed |
300 | # |
2d0b795a |
301 | # The way we construct this coderef is somewhat fugly, although the result is |
302 | # really worth it. The final coderef does not perform any kind of recursion - |
303 | # the entire nested structure constructor is rolled out into a single scope. |
304 | # |
76031e14 |
305 | # In any case - the output of this thing is meticulously micro-tested, so |
2d0b795a |
306 | # any sort of adjustment/rewrite should be relatively easy (fsvo relatively) |
76031e14 |
307 | # |
308 | sub _mk_row_parser { |
309 | my ($self, $args) = @_; |
310 | |
311 | my $inflate_index = { map |
312 | { $args->{inflate_map}[$_] => $_ } |
313 | ( 0 .. $#{$args->{inflate_map}} ) |
314 | }; |
315 | |
2d0b795a |
316 | my $parser_src; |
317 | |
318 | # the non-collapsing assembler is easy |
319 | # FIXME SUBOPTIMAL there could be a yet faster way to do things here, but |
320 | # need to try an actual implementation and benchmark it: |
321 | # |
322 | # <timbunce_> First setup the nested data structure you want for each row |
323 | # Then call bind_col() to alias the row fields into the right place in |
324 | # the data structure, then to fetch the data do: |
325 | # push @rows, dclone($row_data_struct) while ($sth->fetchrow); |
326 | # |
327 | if (!$args->{collapse}) { |
328 | $parser_src = sprintf('$_ = %s for @{$_[0]}', __visit_infmap_simple( |
329 | $inflate_index, |
330 | { rsrc => $self }, # need the $rsrc to sanity-check inflation map once |
331 | )); |
332 | |
333 | # change the quoted placeholders to unquoted alias-references |
334 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$_->[$1]"/gex; |
335 | } |
336 | |
337 | # the collapsing parser is more complicated - it needs to keep a lot of state |
338 | # |
339 | else { |
82f0e0aa |
340 | my $collapse_map = $self->_resolve_collapse ({ |
76031e14 |
341 | # FIXME |
342 | # only consider real columns (not functions) during collapse resolution |
343 | # this check shouldn't really be here, as fucktards are not supposed to |
344 | # alias random crap to existing column names anyway, but still - just in |
345 | # case |
346 | # FIXME !!!! - this does not yet deal with unbalanced selectors correctly |
2d0b795a |
347 | # (it is now trivial as the attrs specify where things go out of sync |
348 | # needs MOAR tests) |
82f0e0aa |
349 | as => { map |
76031e14 |
350 | { ref $args->{selection}[$inflate_index->{$_}] ? () : ( $_ => $inflate_index->{$_} ) } |
351 | keys %$inflate_index |
352 | } |
82f0e0aa |
353 | }); |
76031e14 |
354 | |
3faac878 |
355 | my $all_idcols_as_list = join ', ', sort map { @$_ } ( |
356 | $collapse_map->{-idcols_current_node}, |
357 | $collapse_map->{-idcols_extra_from_children} || (), |
358 | ); |
76031e14 |
359 | |
4e9fc3f3 |
360 | my $top_node_id_path = join ('', map |
361 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
3faac878 |
362 | @{$collapse_map->{-idcols_current_node}} |
4e9fc3f3 |
363 | ); |
76031e14 |
364 | |
4e9fc3f3 |
365 | my $rel_assemblers = __visit_infmap_collapse ( |
76031e14 |
366 | $inflate_index, $collapse_map |
367 | ); |
76031e14 |
368 | |
3faac878 |
369 | $parser_src = sprintf (<<'EOS', $all_idcols_as_list, $top_node_id_path, $rel_assemblers); |
370 | ### BEGIN LITERAL STRING EVAL |
4e9fc3f3 |
371 | |
372 | my ($rows_pos, $result_pos, $cur_row, @cur_row_ids, @collapse_idx, $is_new_res) = (0,0); |
76031e14 |
373 | |
374 | # this loop is a bit arcane - the rationale is that the passed in |
375 | # $_[0] will either have only one row (->next) or will have all |
376 | # rows already pulled in (->all and/or unordered). Given that the |
377 | # result can be rather large - we reuse the same already allocated |
378 | # array, since the collapsed prefetch is smaller by definition. |
379 | # At the end we cut the leftovers away and move on. |
380 | while ($cur_row = |
4e9fc3f3 |
381 | ( ( $rows_pos >= 0 and $_[0][$rows_pos++] ) or do { $rows_pos = -1; undef } ) |
76031e14 |
382 | || |
383 | ($_[1] and $_[1]->()) |
384 | ) { |
385 | |
3faac878 |
386 | # due to left joins some of the ids may be NULL/undef, and |
387 | # won't play well when used as hash lookups |
4e9fc3f3 |
388 | $cur_row_ids[$_] = defined $cur_row->[$_] ? $cur_row->[$_] : "\xFF\xFFN\xFFU\xFFL\xFFL\xFF\xFF" |
3faac878 |
389 | for (%1$s); |
76031e14 |
390 | |
4e9fc3f3 |
391 | $is_new_res = ! $collapse_idx[1]%2$s and ( |
392 | $_[1] and $result_pos and (unshift @{$_[2]}, $cur_row) and last |
393 | ); |
76031e14 |
394 | |
4e9fc3f3 |
395 | %3$s |
76031e14 |
396 | |
4e9fc3f3 |
397 | $_[0][$result_pos++] = $collapse_idx[1]%2$s |
76031e14 |
398 | if $is_new_res; |
399 | } |
400 | |
401 | splice @{$_[0]}, $result_pos; # truncate the passed in array for cases of collapsing ->all() |
3faac878 |
402 | ### END LITERAL STRING EVAL |
76031e14 |
403 | EOS |
404 | |
2d0b795a |
405 | # !!! note - different var than the one above |
76031e14 |
406 | # change the quoted placeholders to unquoted alias-references |
407 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$cur_row->[$1]"/gex; |
4e9fc3f3 |
408 | $parser_src =~ s/ \' \xFF__IDVALPOS__(\d+)__\xFF \' /"\$cur_row_ids[$1]"/gex; |
76031e14 |
409 | } |
410 | |
76031e14 |
411 | $parser_src; |
412 | } |
413 | |
2d0b795a |
414 | # the simple non-collapsing nested structure recursor |
76031e14 |
415 | sub __visit_infmap_simple { |
416 | my ($val_idx, $args) = @_; |
417 | |
418 | my $my_cols = {}; |
419 | my $rel_cols; |
420 | for (keys %$val_idx) { |
421 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
422 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
423 | } |
424 | else { |
425 | $my_cols->{$_} = $val_idx->{$_}; |
426 | } |
427 | } |
428 | my @relperl; |
429 | for my $rel (sort keys %$rel_cols) { |
430 | |
2d0b795a |
431 | # DISABLEPRUNE |
76031e14 |
432 | #my $optional = $args->{is_optional}; |
433 | #$optional ||= ($args->{rsrc}->relationship_info($rel)->{attrs}{join_type} || '') =~ /^left/i; |
434 | |
435 | push @relperl, join ' => ', perlstring($rel), __visit_infmap_simple($rel_cols->{$rel}, { |
2d0b795a |
436 | rsrc => __get_related_source($args->{rsrc}, $rel, $rel_cols->{$rel}), |
437 | # DISABLEPRUNE |
438 | #non_top => 1, |
76031e14 |
439 | #is_optional => $optional, |
76031e14 |
440 | }); |
441 | |
2d0b795a |
442 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
443 | #if ($optional and my @branch_null_checks = map |
444 | # { "(! defined '\xFF__VALPOS__${_}__\xFF')" } |
445 | # sort { $a <=> $b } values %{$rel_cols->{$rel}} |
446 | #) { |
447 | # $relperl[-1] = sprintf ( '(%s) ? ( %s => [] ) : ( %s )', |
448 | # join (' && ', @branch_null_checks ), |
449 | # perlstring($rel), |
450 | # $relperl[-1], |
451 | # ); |
452 | #} |
453 | } |
454 | |
455 | my $me_struct = keys %$my_cols |
456 | ? __visit_dump({ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }) |
457 | : 'undef' |
458 | ; |
459 | |
460 | return sprintf '[%s]', join (',', |
461 | $me_struct, |
462 | @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (), |
463 | ); |
464 | } |
465 | |
2d0b795a |
466 | # the collapsing nested structure recursor |
76031e14 |
467 | sub __visit_infmap_collapse { |
468 | |
469 | my ($val_idx, $collapse_map, $parent_info) = @_; |
470 | |
471 | my $my_cols = {}; |
472 | my $rel_cols; |
473 | for (keys %$val_idx) { |
474 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
475 | $rel_cols->{$1}{$2} = $val_idx->{$_}; |
476 | } |
477 | else { |
478 | $my_cols->{$_} = $val_idx->{$_}; |
479 | } |
480 | } |
481 | |
482 | my $sequenced_node_id = join ('', map |
483 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } |
3faac878 |
484 | @{$collapse_map->{-idcols_current_node}} |
76031e14 |
485 | ); |
486 | |
487 | my $me_struct = keys %$my_cols |
488 | ? __visit_dump([{ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }]) |
4e9fc3f3 |
489 | : undef |
76031e14 |
490 | ; |
491 | my $node_idx_ref = sprintf '$collapse_idx[%d]%s', $collapse_map->{-node_index}, $sequenced_node_id; |
492 | |
493 | my $parent_idx_ref = sprintf( '$collapse_idx[%d]%s[1]{%s}', |
494 | @{$parent_info}{qw/node_idx sequenced_node_id/}, |
495 | perlstring($parent_info->{relname}), |
496 | ) if $parent_info; |
497 | |
498 | my @src; |
499 | if ($collapse_map->{-node_index} == 1) { |
500 | push @src, sprintf( '%s ||= %s;', |
501 | $node_idx_ref, |
502 | $me_struct, |
4e9fc3f3 |
503 | ) if $me_struct; |
76031e14 |
504 | } |
505 | elsif ($collapse_map->{-is_single}) { |
4e9fc3f3 |
506 | push @src, sprintf ( '%s ||= %s%s;', |
76031e14 |
507 | $parent_idx_ref, |
508 | $node_idx_ref, |
4e9fc3f3 |
509 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
510 | ); |
511 | } |
512 | else { |
4e9fc3f3 |
513 | push @src, sprintf('push @{%s}, %s%s unless %s;', |
76031e14 |
514 | $parent_idx_ref, |
515 | $node_idx_ref, |
4e9fc3f3 |
516 | $me_struct ? " ||= $me_struct" : '', |
76031e14 |
517 | $node_idx_ref, |
518 | ); |
519 | } |
520 | |
2d0b795a |
521 | # DISABLEPRUNE |
76031e14 |
522 | #my $known_defined = { %{ $parent_info->{known_defined} || {} } }; |
3faac878 |
523 | #$known_defined->{$_}++ for @{$collapse_map->{-idcols_current_node}}; |
76031e14 |
524 | |
525 | for my $rel (sort keys %$rel_cols) { |
526 | |
3faac878 |
527 | # push @src, sprintf( |
528 | # '%s[1]{%s} ||= [];', $node_idx_ref, perlstring($rel) |
529 | # ) unless $collapse_map->{$rel}{-is_single}; |
76031e14 |
530 | |
531 | push @src, __visit_infmap_collapse($rel_cols->{$rel}, $collapse_map->{$rel}, { |
532 | node_idx => $collapse_map->{-node_index}, |
533 | sequenced_node_id => $sequenced_node_id, |
534 | relname => $rel, |
2d0b795a |
535 | # DISABLEPRUNE |
76031e14 |
536 | #known_defined => $known_defined, |
537 | }); |
538 | |
2d0b795a |
539 | # FIXME SUBOPTIMAL DISABLEPRUNE - disabled to satisfy t/resultset/inflate_result_api.t |
76031e14 |
540 | #if ($collapse_map->{$rel}{-is_optional} and my @null_checks = map |
4e9fc3f3 |
541 | # { "(! defined '\xFF__IDVALPOS__${_}__\xFF')" } |
76031e14 |
542 | # sort { $a <=> $b } grep |
543 | # { ! $known_defined->{$_} } |
3faac878 |
544 | # @{$collapse_map->{$rel}{-idcols_current_node}} |
76031e14 |
545 | #) { |
546 | # $src[-1] = sprintf( '(%s) or %s', |
547 | # join (' || ', @null_checks ), |
548 | # $src[-1], |
549 | # ); |
550 | #} |
551 | } |
552 | |
553 | join "\n", @src; |
554 | } |
555 | |
556 | # adding a dep on MoreUtils *just* for this is retarded |
557 | sub __unique_numlist { |
3faac878 |
558 | sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }} |
76031e14 |
559 | } |
560 | |
561 | # This error must be thrown from two distinct codepaths, joining them is |
562 | # rather hard. Go for this hack instead. |
563 | sub __get_related_source { |
564 | my ($rsrc, $rel, $relcols) = @_; |
565 | try { |
566 | $rsrc->related_source ($rel) |
567 | } catch { |
568 | $rsrc->throw_exception(sprintf( |
569 | "Can't inflate prefetch into non-existent relationship '%s' from '%s', " |
570 | . "check the inflation specification (columns/as) ending in '...%s.%s'.", |
571 | $rel, |
572 | $rsrc->source_name, |
573 | $rel, |
574 | (sort { length($a) <=> length ($b) } keys %$relcols)[0], |
575 | ))}; |
576 | } |
577 | |
578 | # keep our own DD object around so we don't have to fitz with quoting |
579 | my $dumper_obj; |
580 | sub __visit_dump { |
581 | # we actually will be producing functional perl code here, |
582 | # thus no second-guessing of what these globals might have |
583 | # been set to. DO NOT CHANGE! |
584 | ($dumper_obj ||= do { |
585 | require Data::Dumper; |
586 | Data::Dumper->new([]) |
2d0b795a |
587 | ->Useperl (0) |
76031e14 |
588 | ->Purity (1) |
589 | ->Pad ('') |
590 | ->Useqq (0) |
591 | ->Terse (1) |
592 | ->Quotekeys (1) |
593 | ->Deepcopy (0) |
594 | ->Deparse (0) |
595 | ->Maxdepth (0) |
596 | ->Indent (0) # faster but harder to read, perhaps leave at 1 ? |
597 | })->Values ([$_[0]])->Dump; |
598 | } |
599 | |
600 | 1; |