Commit | Line | Data |
9f98c4b2 |
1 | package # hide from the pauses |
2 | DBIx::Class::ResultSource::RowParser::Util; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
9ceb04c6 |
7 | use DBIx::Class::_Util qw( perlstring dump_value ); |
9f98c4b2 |
8 | |
750a4ad2 |
9 | use constant HAS_DOR => ( "$]" < 5.010 ? 0 : 1 ); |
cd784aab |
10 | |
9f98c4b2 |
11 | use base 'Exporter'; |
12 | our @EXPORT_OK = qw( |
13 | assemble_simple_parser |
14 | assemble_collapsing_parser |
15 | ); |
16 | |
52864fbd |
17 | # working title - we are hoping to extract this eventually... |
18 | our $null_branch_class = 'DBIx::ResultParser::RelatedNullBranch'; |
19 | |
9f7d5590 |
20 | sub __wrap_in_strictured_scope { |
21 | " { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n }" |
22 | } |
23 | |
9f98c4b2 |
24 | sub assemble_simple_parser { |
25 | #my ($args) = @_; |
26 | |
27 | # the non-collapsing assembler is easy |
28 | # FIXME SUBOPTIMAL there could be a yet faster way to do things here, but |
29 | # need to try an actual implementation and benchmark it: |
30 | # |
31 | # <timbunce_> First setup the nested data structure you want for each row |
32 | # Then call bind_col() to alias the row fields into the right place in |
33 | # the data structure, then to fetch the data do: |
34 | # push @rows, dclone($row_data_struct) while ($sth->fetchrow); |
35 | # |
9f98c4b2 |
36 | |
970d8ca1 |
37 | __wrap_in_strictured_scope( sprintf |
38 | '$_ = %s for @{$_[0]}', |
39 | __visit_infmap_simple( $_[0] ) |
40 | ); |
9f98c4b2 |
41 | } |
42 | |
43 | # the simple non-collapsing nested structure recursor |
44 | sub __visit_infmap_simple { |
45 | my $args = shift; |
46 | |
47 | my $my_cols = {}; |
48 | my $rel_cols; |
49 | for (keys %{$args->{val_index}}) { |
50 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
51 | $rel_cols->{$1}{$2} = $args->{val_index}{$_}; |
52 | } |
53 | else { |
54 | $my_cols->{$_} = $args->{val_index}{$_}; |
55 | } |
56 | } |
57 | |
58 | my @relperl; |
59 | for my $rel (sort keys %$rel_cols) { |
60 | |
52864fbd |
61 | my $rel_struct = __visit_infmap_simple({ %$args, |
9f98c4b2 |
62 | val_index => $rel_cols->{$rel}, |
9f98c4b2 |
63 | }); |
64 | |
52864fbd |
65 | if (keys %$my_cols) { |
ce556881 |
66 | |
52864fbd |
67 | my $branch_null_checks = join ' && ', map |
970d8ca1 |
68 | { "( ! defined \$_->[$_] )" } |
ce556881 |
69 | sort { $a <=> $b } values %{$rel_cols->{$rel}} |
70 | ; |
71 | |
79adc44f |
72 | if ($args->{prune_null_branches}) { |
52864fbd |
73 | $rel_struct = sprintf ( '( (%s) ? undef : %s )', |
74 | $branch_null_checks, |
75 | $rel_struct, |
76 | ); |
77 | } |
78 | else { |
79 | $rel_struct = sprintf ( '( (%s) ? bless( (%s), %s ) : %s )', |
80 | $branch_null_checks, |
81 | $rel_struct, |
82 | perlstring($null_branch_class), |
83 | $rel_struct, |
84 | ); |
85 | } |
ce556881 |
86 | } |
52864fbd |
87 | |
88 | push @relperl, sprintf '( %s => %s )', |
89 | perlstring($rel), |
90 | $rel_struct, |
91 | ; |
92 | |
9f98c4b2 |
93 | } |
94 | |
ce556881 |
95 | my $me_struct; |
a8f62ee0 |
96 | $me_struct = __result_struct_to_source($my_cols) if keys %$my_cols; |
9f98c4b2 |
97 | |
ce556881 |
98 | if ($args->{hri_style}) { |
99 | $me_struct =~ s/^ \s* \{ | \} \s* $//gx |
100 | if $me_struct; |
101 | |
102 | return sprintf '{ %s }', join (', ', $me_struct||(), @relperl); |
103 | } |
104 | else { |
105 | return sprintf '[%s]', join (',', |
106 | $me_struct || 'undef', |
107 | @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (), |
108 | ); |
109 | } |
9f98c4b2 |
110 | } |
111 | |
112 | sub assemble_collapsing_parser { |
113 | my $args = shift; |
114 | |
c863e102 |
115 | my ($top_node_key, $top_node_key_assembler, $variant_idcols); |
9f98c4b2 |
116 | |
117 | if (scalar @{$args->{collapse_map}{-identifying_columns}}) { |
118 | $top_node_key = join ('', map |
970d8ca1 |
119 | { "{ \$cur_row_ids{$_} }" } |
9f98c4b2 |
120 | @{$args->{collapse_map}{-identifying_columns}} |
121 | ); |
5ff6d603 |
122 | |
123 | $top_node_key_assembler = ''; |
9f98c4b2 |
124 | } |
125 | elsif( my @variants = @{$args->{collapse_map}{-identifying_columns_variants}} ) { |
126 | |
127 | my @path_parts = map { sprintf |
970d8ca1 |
128 | "( ( defined \$cur_row_data->[%d] ) && (join qq(\xFF), '', %s, '') )", |
ce556881 |
129 | $_->[0], # checking just first is enough - one ID defined, all defined |
9ceb04c6 |
130 | ( join ', ', map { $variant_idcols->{$_} = 1; " \$cur_row_ids{$_} " } @$_ ), |
9f98c4b2 |
131 | } @variants; |
132 | |
133 | my $virtual_column_idx = (scalar keys %{$args->{val_index}} ) + 1; |
134 | |
970d8ca1 |
135 | $top_node_key = "{ \$cur_row_ids{$virtual_column_idx} }"; |
9f98c4b2 |
136 | |
05a5ca4b |
137 | $top_node_key_assembler = sprintf "( \$cur_row_ids{%d} = (%s) ),", |
7596ddca |
138 | $virtual_column_idx, |
139 | "\n" . join( "\n or\n", @path_parts, qq{"\0\$rows_pos\0"} ) |
140 | ; |
9f98c4b2 |
141 | |
142 | $args->{collapse_map} = { |
143 | %{$args->{collapse_map}}, |
144 | -custom_node_key => $top_node_key, |
145 | }; |
9f98c4b2 |
146 | } |
147 | else { |
9ceb04c6 |
148 | DBIx::Class::Exception->throw( |
149 | 'Unexpected collapse map contents: ' . dump_value $args->{collapse_map}, |
150 | 1, |
151 | ) |
9f98c4b2 |
152 | } |
153 | |
154 | my ($data_assemblers, $stats) = __visit_infmap_collapse ($args); |
155 | |
c863e102 |
156 | # variants do not necessarily overlap with true idcols |
157 | my @row_ids = sort { $a <=> $b } keys %{ { |
158 | %{ $variant_idcols || {} }, |
159 | %{ $stats->{idcols_seen} }, |
160 | } }; |
161 | |
05a5ca4b |
162 | my $row_id_defs = sprintf "( \@cur_row_ids{( %s )} = (\n%s\n ) ),", |
c863e102 |
163 | join (', ', @row_ids ), |
164 | # in case we prune - we will never hit undefs/NULLs as pigeon-hole-criteria |
165 | ( $args->{prune_null_branches} |
166 | ? sprintf( '@{$cur_row_data}[( %s )]', join ', ', @row_ids ) |
167 | : join (",\n", map { |
5ff6d603 |
168 | $stats->{nullchecks}{mandatory}{$_} |
169 | ? qq!( \$cur_row_data->[$_] )! |
170 | : do { |
171 | my $quoted_null_val = qq("\0NULL\xFF\${rows_pos}\xFF${_}\0"); |
172 | HAS_DOR |
173 | ? qq!( \$cur_row_data->[$_] // $quoted_null_val )! |
174 | : qq!( defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : $quoted_null_val )! |
175 | } |
c863e102 |
176 | } @row_ids) |
177 | ) |
178 | ; |
179 | |
b3a400a0 |
180 | my $null_checks = ''; |
181 | |
182 | for my $c ( sort { $a <=> $b } keys %{$stats->{nullchecks}{mandatory}} ) { |
183 | $null_checks .= sprintf <<'EOS', $c |
184 | ( defined( $cur_row_data->[%1$s] ) or $_[3]->{%1$s} = 1 ), |
185 | |
186 | EOS |
187 | } |
188 | |
189 | for my $set ( @{ $stats->{nullchecks}{from_first_encounter} || [] } ) { |
190 | my @sub_checks; |
191 | |
192 | for my $i (0 .. $#$set - 1) { |
193 | |
194 | push @sub_checks, sprintf |
195 | '( not defined $cur_row_data->[%1$s] ) ? ( %2$s or ( $_[3]->{%1$s} = 1 ) )', |
196 | $set->[$i], |
197 | join( ' and ', map |
198 | { "( not defined \$cur_row_data->[$set->[$_]] )" } |
199 | ( $i+1 .. $#$set ) |
200 | ), |
201 | ; |
202 | } |
203 | |
204 | $null_checks .= "(\n @{[ join qq(\n: ), @sub_checks, '()' ]} \n),\n"; |
205 | } |
206 | |
207 | for my $set ( @{ $stats->{nullchecks}{all_or_nothing} || [] } ) { |
208 | |
209 | $null_checks .= sprintf "(\n( %s )\n or\n(\n%s\n)\n),\n", |
210 | join ( ' and ', map |
211 | { "( not defined \$cur_row_data->[$_] )" } |
212 | sort { $a <=> $b } keys %$set |
213 | ), |
214 | join ( ",\n", map |
215 | { "( defined(\$cur_row_data->[$_]) or \$_[3]->{$_} = 1 )" } |
216 | sort { $a <=> $b } keys %$set |
217 | ), |
218 | ; |
219 | } |
220 | |
221 | # If any of the above generators produced something, we need to add the |
222 | # final "if seen any violations - croak" part |
223 | # Do not throw from within the string eval itself as it does not have |
224 | # the necessary metadata to construct a nice exception text. As a bonus |
225 | # we get to entirely avoid https://github.com/Test-More/Test2/issues/16 |
226 | # and https://rt.perl.org/Public/Bug/Display.html?id=127774 |
227 | |
228 | $null_checks .= <<'EOS' if $null_checks; |
229 | |
230 | ( keys %{$_[3]} and ( |
231 | ( @{$_[2]} = $cur_row_data ), |
232 | ( $result_pos = 0 ), |
233 | last |
234 | ) ), |
235 | EOS |
236 | |
237 | |
238 | my $parser_src = sprintf (<<'EOS', $null_checks, $row_id_defs, $top_node_key_assembler, $top_node_key, join( "\n", @$data_assemblers ) ); |
9f98c4b2 |
239 | ### BEGIN LITERAL STRING EVAL |
aa1d8a87 |
240 | my $rows_pos = 0; |
c863e102 |
241 | my ($result_pos, @collapse_idx, $cur_row_data, %%cur_row_ids ); |
aa1d8a87 |
242 | |
9f98c4b2 |
243 | # this loop is a bit arcane - the rationale is that the passed in |
244 | # $_[0] will either have only one row (->next) or will have all |
245 | # rows already pulled in (->all and/or unordered). Given that the |
246 | # result can be rather large - we reuse the same already allocated |
247 | # array, since the collapsed prefetch is smaller by definition. |
248 | # At the end we cut the leftovers away and move on. |
3b4cd124 |
249 | while ($cur_row_data = ( |
164aab8c |
250 | ( |
251 | $rows_pos >= 0 |
252 | and |
253 | ( |
254 | $_[0][$rows_pos++] |
255 | or |
256 | # It may be tempting to drop the -1 and undef $rows_pos instead |
257 | # thus saving the >= comparison above as well |
258 | # However NULL-handlers and underdefined root markers both use |
259 | # $rows_pos as a last-resort-uniqueness marker (it either is |
260 | # monotonically increasing while we parse ->all, or is set at |
261 | # a steady -1 when we are dealing with a single root node). For |
262 | # the time being the complication of changing all callsites seems |
263 | # overkill, for what is going to be a very modest saving of ops |
264 | ( ($rows_pos = -1), undef ) |
265 | ) |
266 | ) |
3b4cd124 |
267 | or |
164aab8c |
268 | ( $_[1] and $_[1]->() ) |
3b4cd124 |
269 | ) ) { |
270 | |
b3a400a0 |
271 | # column_info metadata historically hasn't been too reliable. |
272 | # We need to start fixing this somehow (the collapse resolver |
273 | # can't work without it). Add explicit checks for several cases |
274 | # of "unexpected NULL", based on the metadata returned by |
275 | # __visit_infmap_collapse |
7596ddca |
276 | # |
b3a400a0 |
277 | # FIXME - this is a temporary kludge that reduces performance |
278 | # It is however necessary for the time being, until way into the |
279 | # future when the extra errors clear out all invalid metadata |
280 | %s |
281 | |
9f98c4b2 |
282 | # due to left joins some of the ids may be NULL/undef, and |
283 | # won't play well when used as hash lookups |
284 | # we also need to differentiate NULLs on per-row/per-col basis |
ce556881 |
285 | # (otherwise folding of optional 1:1s will be greatly confused |
b3a400a0 |
286 | # |
287 | # the undef checks may or may not be there depending on whether |
288 | # we prune or not |
5ff6d603 |
289 | %s |
9f98c4b2 |
290 | |
7596ddca |
291 | # in the case of an underdefined root - calculate the virtual id (otherwise no code at all) |
5ff6d603 |
292 | %s |
9f98c4b2 |
293 | |
aa1d8a87 |
294 | # if we were supplied a coderef - we are collapsing lazily (the set |
295 | # is ordered properly) |
296 | # as long as we have a result already and the next result is new we |
297 | # return the pre-read data and bail |
5ff6d603 |
298 | ( $_[1] and $result_pos and ! $collapse_idx[0]%s and (unshift @{$_[2]}, $cur_row_data) and last ), |
9f98c4b2 |
299 | |
300 | # the rel assemblers |
5ff6d603 |
301 | %s |
9f98c4b2 |
302 | |
9f98c4b2 |
303 | } |
304 | |
aa1d8a87 |
305 | $#{$_[0]} = $result_pos - 1; # truncate the passed in array to where we filled it with results |
9f98c4b2 |
306 | ### END LITERAL STRING EVAL |
307 | EOS |
308 | |
9f7d5590 |
309 | __wrap_in_strictured_scope($parser_src); |
9f98c4b2 |
310 | } |
311 | |
312 | |
313 | # the collapsing nested structure recursor |
314 | sub __visit_infmap_collapse { |
315 | my $args = {%{ shift() }}; |
316 | |
317 | my $cur_node_idx = ${ $args->{-node_idx_counter} ||= \do { my $x = 0} }++; |
318 | |
5ff6d603 |
319 | $args->{-mandatory_ids} ||= {}; |
320 | $args->{-seen_ids} ||= {}; |
321 | $args->{-all_or_nothing_sets} ||= []; |
322 | $args->{-null_from} ||= []; |
323 | |
324 | $args->{-seen_ids}{$_} = 1 |
325 | for @{$args->{collapse_map}->{-identifying_columns}}; |
326 | |
327 | my $node_specific_ids = { map { $_ => 1 } grep |
328 | { ! $args->{-parent_ids}{$_} } |
329 | @{$args->{collapse_map}->{-identifying_columns}} |
330 | }; |
331 | |
332 | if (not ( $args->{-chain_is_optional} ||= $args->{collapse_map}{-is_optional} ) ) { |
333 | $args->{-mandatory_ids}{$_} = 1 |
334 | for @{$args->{collapse_map}->{-identifying_columns}}; |
335 | } |
336 | elsif ( keys %$node_specific_ids > 1 ) { |
337 | push @{$args->{-all_or_nothing_sets}}, $node_specific_ids; |
338 | } |
339 | |
ce556881 |
340 | my ($my_cols, $rel_cols) = {}; |
9f98c4b2 |
341 | for ( keys %{$args->{val_index}} ) { |
342 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
343 | $rel_cols->{$1}{$2} = $args->{val_index}{$_}; |
344 | } |
345 | else { |
346 | $my_cols->{$_} = $args->{val_index}{$_}; |
347 | } |
348 | } |
349 | |
ce556881 |
350 | |
ce556881 |
351 | if ($args->{hri_style}) { |
352 | delete $my_cols->{$_} for grep { $rel_cols->{$_} } keys %$my_cols; |
353 | } |
9f98c4b2 |
354 | |
52864fbd |
355 | my $me_struct; |
970d8ca1 |
356 | $me_struct = __result_struct_to_source($my_cols, 1) if keys %$my_cols; |
ce556881 |
357 | |
52864fbd |
358 | $me_struct = sprintf( '[ %s ]', $me_struct||'' ) |
359 | unless $args->{hri_style}; |
360 | |
361 | |
362 | my $node_key = $args->{collapse_map}->{-custom_node_key} || join ('', map |
970d8ca1 |
363 | { "{ \$cur_row_ids{$_} }" } |
52864fbd |
364 | @{$args->{collapse_map}->{-identifying_columns}} |
365 | ); |
ce556881 |
366 | my $node_idx_slot = sprintf '$collapse_idx[%d]%s', $cur_node_idx, $node_key; |
9f98c4b2 |
367 | |
52864fbd |
368 | |
9f98c4b2 |
369 | my @src; |
ce556881 |
370 | |
9f98c4b2 |
371 | if ($cur_node_idx == 0) { |
05a5ca4b |
372 | push @src, sprintf( '( %s %s $_[0][$result_pos++] = %s ),', |
9f98c4b2 |
373 | $node_idx_slot, |
cd784aab |
374 | (HAS_DOR ? '//=' : '||='), |
aa1d8a87 |
375 | $me_struct || '{}', |
376 | ); |
9f98c4b2 |
377 | } |
9f98c4b2 |
378 | else { |
ce556881 |
379 | my $parent_attach_slot = sprintf( '$collapse_idx[%d]%s%s{%s}', |
380 | @{$args}{qw/-parent_node_idx -parent_node_key/}, |
381 | $args->{hri_style} ? '' : '[1]', |
a5f5e470 |
382 | perlstring($args->{-node_rel_name}), |
9f98c4b2 |
383 | ); |
ce556881 |
384 | |
385 | if ($args->{collapse_map}->{-is_single}) { |
40471d46 |
386 | push @src, sprintf ( '( %s %s %s = %s ),', |
ce556881 |
387 | $parent_attach_slot, |
cd784aab |
388 | (HAS_DOR ? '//=' : '||='), |
ce556881 |
389 | $node_idx_slot, |
40471d46 |
390 | $me_struct || '{}', |
ce556881 |
391 | ); |
392 | } |
393 | else { |
40471d46 |
394 | push @src, sprintf('( (! %s) and push @{%s}, %s = %s ),', |
ce556881 |
395 | $node_idx_slot, |
396 | $parent_attach_slot, |
397 | $node_idx_slot, |
40471d46 |
398 | $me_struct || '{}', |
ce556881 |
399 | ); |
400 | } |
9f98c4b2 |
401 | } |
402 | |
ce556881 |
403 | my $known_present_ids = { map { $_ => 1 } @{$args->{collapse_map}{-identifying_columns}} }; |
5ff6d603 |
404 | my $rel_src; |
ce556881 |
405 | |
9f98c4b2 |
406 | for my $rel (sort keys %$rel_cols) { |
407 | |
ce556881 |
408 | my $relinfo = $args->{collapse_map}{$rel}; |
9f98c4b2 |
409 | |
5ff6d603 |
410 | ($rel_src) = __visit_infmap_collapse({ %$args, |
9f98c4b2 |
411 | val_index => $rel_cols->{$rel}, |
ce556881 |
412 | collapse_map => $relinfo, |
9f98c4b2 |
413 | -parent_node_idx => $cur_node_idx, |
414 | -parent_node_key => $node_key, |
5ff6d603 |
415 | -parent_id_path => [ @{$args->{-parent_id_path}||[]}, sort { $a <=> $b } keys %$node_specific_ids ], |
416 | -parent_ids => { map { %$_ } $node_specific_ids, $args->{-parent_ids}||{} }, |
a5f5e470 |
417 | -node_rel_name => $rel, |
9f98c4b2 |
418 | }); |
419 | |
ce556881 |
420 | my $rel_src_pos = $#src + 1; |
421 | push @src, @$rel_src; |
422 | |
423 | if ( |
ce556881 |
424 | $relinfo->{-is_optional} |
9ceb04c6 |
425 | ) { |
426 | |
427 | my ($first_distinct_child_idcol) = grep |
ce556881 |
428 | { ! $known_present_ids->{$_} } |
429 | @{$relinfo->{-identifying_columns}} |
9ceb04c6 |
430 | ; |
431 | |
432 | DBIx::Class::Exception->throw( |
433 | "An optional node *without* a distinct identifying set shouldn't be possible: " . dump_value $args->{collapse_map}, |
434 | 1, |
435 | ) unless defined $first_distinct_child_idcol; |
ce556881 |
436 | |
79adc44f |
437 | if ($args->{prune_null_branches}) { |
ce556881 |
438 | |
7596ddca |
439 | # start of wrap of the entire chain in a conditional |
05a5ca4b |
440 | splice @src, $rel_src_pos, 0, sprintf "( ( ! defined %s )\n ? %s%s{%s} = %s\n : do {", |
970d8ca1 |
441 | "\$cur_row_data->[$first_distinct_child_idcol]", |
52864fbd |
442 | $node_idx_slot, |
79adc44f |
443 | $args->{hri_style} ? '' : '[1]', |
52864fbd |
444 | perlstring($rel), |
79adc44f |
445 | ($args->{hri_style} && $relinfo->{-is_single}) ? 'undef' : '[]' |
7596ddca |
446 | ; |
447 | |
448 | # end of wrap |
05a5ca4b |
449 | push @src, '} ),' |
52864fbd |
450 | } |
451 | else { |
452 | |
05a5ca4b |
453 | splice @src, $rel_src_pos + 1, 0, sprintf ( '( (defined %s) or bless (%s[1]{%s}, %s) ),', |
970d8ca1 |
454 | "\$cur_row_data->[$first_distinct_child_idcol]", |
52864fbd |
455 | $node_idx_slot, |
456 | perlstring($rel), |
457 | perlstring($null_branch_class), |
458 | ); |
459 | } |
ce556881 |
460 | } |
9f98c4b2 |
461 | } |
462 | |
5ff6d603 |
463 | if ( |
464 | |
465 | # calculation only valid for leaf nodes |
466 | ! values %$rel_cols |
467 | |
468 | and |
469 | |
470 | # child of underdefined path doesn't leave us anything to test |
471 | @{$args->{-parent_id_path} || []} |
472 | |
473 | and |
474 | |
475 | (my @nullable_portion = grep |
476 | { ! $args->{-mandatory_ids}{$_} } |
477 | ( |
478 | @{$args->{-parent_id_path}}, |
479 | sort { $a <=> $b } keys %$node_specific_ids |
480 | ) |
481 | ) > 1 |
482 | ) { |
483 | # there may be 1:1 overlap with a specific all_or_nothing |
484 | push @{$args->{-null_from}}, \@nullable_portion unless grep |
485 | { |
486 | my $a_o_n_set = $_; |
487 | |
488 | keys %$a_o_n_set == @nullable_portion |
489 | and |
490 | ! grep { ! $a_o_n_set->{$_} } @nullable_portion |
491 | } |
492 | @{ $args->{-all_or_nothing_sets} || [] } |
493 | ; |
494 | } |
495 | |
9f98c4b2 |
496 | return ( |
ce556881 |
497 | \@src, |
5ff6d603 |
498 | ( $cur_node_idx != 0 ) ? () : { |
499 | idcols_seen => $args->{-seen_ids}, |
500 | nullchecks => { |
501 | ( keys %{$args->{-mandatory_ids} } |
502 | ? ( mandatory => $args->{-mandatory_ids} ) |
503 | : () |
504 | ), |
505 | ( @{$args->{-all_or_nothing_sets}} |
506 | ? ( all_or_nothing => $args->{-all_or_nothing_sets} ) |
507 | : () |
508 | ), |
509 | ( @{$args->{-null_from}} |
510 | ? ( from_first_encounter => $args->{-null_from} ) |
511 | : () |
512 | ), |
513 | }, |
514 | }, |
9f98c4b2 |
515 | ); |
516 | } |
517 | |
a8f62ee0 |
518 | sub __result_struct_to_source { |
970d8ca1 |
519 | my ($data, $is_collapsing) = @_; |
520 | |
521 | sprintf( '{ %s }', |
522 | join (', ', map { |
523 | sprintf ( "%s => %s", |
524 | perlstring($_), |
525 | $is_collapsing |
526 | ? "\$cur_row_data->[$data->{$_}]" |
527 | : "\$_->[ $data->{$_} ]" |
528 | ) |
529 | } sort keys %{$data} |
530 | ) |
531 | ); |
9f98c4b2 |
532 | } |
533 | |
534 | 1; |