| Filename | /usr/share/perl5/DBIx/Class/ResultSource/RowParser/Util.pm |
| Statements | Executed 15 statements in 2.05ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 22µs | 30µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@7 |
| 1 | 1 | 1 | 14µs | 21µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@4 |
| 1 | 1 | 1 | 12µs | 43µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@10 |
| 1 | 1 | 1 | 9µs | 44µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@12 |
| 1 | 1 | 1 | 9µs | 24µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@8 |
| 1 | 1 | 1 | 9µs | 13µs | DBIx::Class::ResultSource::RowParser::Util::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::__ANON__[:320] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::__result_struct_to_source |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::__visit_infmap_collapse |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::__visit_infmap_simple |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::__wrap_in_strictured_scope |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::assemble_collapsing_parser |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::ResultSource::RowParser::Util::assemble_simple_parser |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package # hide from the pauses | ||||
| 2 | DBIx::Class::ResultSource::RowParser::Util; | ||||
| 3 | |||||
| 4 | 2 | 41µs | 2 | 28µs | # spent 21µs (14+7) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@4 which was called:
# once (14µs+7µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 4 # spent 21µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@4
# spent 7µs making 1 call to strict::import |
| 5 | 2 | 33µs | 2 | 17µs | # spent 13µs (9+4) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@5 which was called:
# once (9µs+4µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 5 # spent 13µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@5
# spent 4µs making 1 call to warnings::import |
| 6 | |||||
| 7 | 2 | 52µs | 2 | 38µs | # spent 30µs (22+8) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@7 which was called:
# once (22µs+8µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 7 # spent 30µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@7
# spent 8µs making 1 call to List::Util::import |
| 8 | 2 | 57µs | 2 | 40µs | # spent 24µs (9+15) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@8 which was called:
# once (9µs+15µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 8 # spent 24µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@8
# spent 16µs making 1 call to Exporter::import |
| 9 | |||||
| 10 | 2 | 66µs | 2 | 74µs | # spent 43µs (12+31) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@10 which was called:
# once (12µs+31µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 10 # spent 43µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@10
# spent 31µs making 1 call to constant::import |
| 11 | |||||
| 12 | 2 | 1.79ms | 2 | 44µs | # spent 44µs (9+35) within DBIx::Class::ResultSource::RowParser::Util::BEGIN@12 which was called:
# once (9µs+35µs) by DBIx::Class::ResultSource::RowParser::BEGIN@12 at line 12 # spent 44µs making 1 call to DBIx::Class::ResultSource::RowParser::Util::BEGIN@12
# spent 35µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 35µs |
| 13 | 1 | 1µs | our @EXPORT_OK = qw( | ||
| 14 | assemble_simple_parser | ||||
| 15 | assemble_collapsing_parser | ||||
| 16 | ); | ||||
| 17 | |||||
| 18 | # working title - we are hoping to extract this eventually... | ||||
| 19 | 1 | 300ns | our $null_branch_class = 'DBIx::ResultParser::RelatedNullBranch'; | ||
| 20 | |||||
| 21 | sub __wrap_in_strictured_scope { | ||||
| 22 | " { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n }" | ||||
| 23 | } | ||||
| 24 | |||||
| 25 | sub assemble_simple_parser { | ||||
| 26 | #my ($args) = @_; | ||||
| 27 | |||||
| 28 | # the non-collapsing assembler is easy | ||||
| 29 | # FIXME SUBOPTIMAL there could be a yet faster way to do things here, but | ||||
| 30 | # need to try an actual implementation and benchmark it: | ||||
| 31 | # | ||||
| 32 | # <timbunce_> First setup the nested data structure you want for each row | ||||
| 33 | # Then call bind_col() to alias the row fields into the right place in | ||||
| 34 | # the data structure, then to fetch the data do: | ||||
| 35 | # push @rows, dclone($row_data_struct) while ($sth->fetchrow); | ||||
| 36 | # | ||||
| 37 | my $parser_src = sprintf('$_ = %s for @{$_[0]}', __visit_infmap_simple($_[0]) ); | ||||
| 38 | |||||
| 39 | # change the quoted placeholders to unquoted alias-references | ||||
| 40 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$_->[$1]"/gex; | ||||
| 41 | |||||
| 42 | __wrap_in_strictured_scope($parser_src); | ||||
| 43 | } | ||||
| 44 | |||||
| 45 | # the simple non-collapsing nested structure recursor | ||||
| 46 | sub __visit_infmap_simple { | ||||
| 47 | my $args = shift; | ||||
| 48 | |||||
| 49 | my $my_cols = {}; | ||||
| 50 | my $rel_cols; | ||||
| 51 | for (keys %{$args->{val_index}}) { | ||||
| 52 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { | ||||
| 53 | $rel_cols->{$1}{$2} = $args->{val_index}{$_}; | ||||
| 54 | } | ||||
| 55 | else { | ||||
| 56 | $my_cols->{$_} = $args->{val_index}{$_}; | ||||
| 57 | } | ||||
| 58 | } | ||||
| 59 | |||||
| 60 | my @relperl; | ||||
| 61 | for my $rel (sort keys %$rel_cols) { | ||||
| 62 | |||||
| 63 | my $rel_struct = __visit_infmap_simple({ %$args, | ||||
| 64 | val_index => $rel_cols->{$rel}, | ||||
| 65 | }); | ||||
| 66 | |||||
| 67 | if (keys %$my_cols) { | ||||
| 68 | |||||
| 69 | my $branch_null_checks = join ' && ', map | ||||
| 70 | { "( ! defined '\xFF__VALPOS__${_}__\xFF' )" } | ||||
| 71 | sort { $a <=> $b } values %{$rel_cols->{$rel}} | ||||
| 72 | ; | ||||
| 73 | |||||
| 74 | if ($args->{prune_null_branches}) { | ||||
| 75 | $rel_struct = sprintf ( '( (%s) ? undef : %s )', | ||||
| 76 | $branch_null_checks, | ||||
| 77 | $rel_struct, | ||||
| 78 | ); | ||||
| 79 | } | ||||
| 80 | else { | ||||
| 81 | $rel_struct = sprintf ( '( (%s) ? bless( (%s), %s ) : %s )', | ||||
| 82 | $branch_null_checks, | ||||
| 83 | $rel_struct, | ||||
| 84 | perlstring($null_branch_class), | ||||
| 85 | $rel_struct, | ||||
| 86 | ); | ||||
| 87 | } | ||||
| 88 | } | ||||
| 89 | |||||
| 90 | push @relperl, sprintf '( %s => %s )', | ||||
| 91 | perlstring($rel), | ||||
| 92 | $rel_struct, | ||||
| 93 | ; | ||||
| 94 | |||||
| 95 | } | ||||
| 96 | |||||
| 97 | my $me_struct; | ||||
| 98 | $me_struct = __result_struct_to_source($my_cols) if keys %$my_cols; | ||||
| 99 | |||||
| 100 | if ($args->{hri_style}) { | ||||
| 101 | $me_struct =~ s/^ \s* \{ | \} \s* $//gx | ||||
| 102 | if $me_struct; | ||||
| 103 | |||||
| 104 | return sprintf '{ %s }', join (', ', $me_struct||(), @relperl); | ||||
| 105 | } | ||||
| 106 | else { | ||||
| 107 | return sprintf '[%s]', join (',', | ||||
| 108 | $me_struct || 'undef', | ||||
| 109 | @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (), | ||||
| 110 | ); | ||||
| 111 | } | ||||
| 112 | } | ||||
| 113 | |||||
| 114 | sub assemble_collapsing_parser { | ||||
| 115 | my $args = shift; | ||||
| 116 | |||||
| 117 | # it may get unset further down | ||||
| 118 | my $no_rowid_container = $args->{prune_null_branches}; | ||||
| 119 | |||||
| 120 | my ($top_node_key, $top_node_key_assembler); | ||||
| 121 | |||||
| 122 | if (scalar @{$args->{collapse_map}{-identifying_columns}}) { | ||||
| 123 | $top_node_key = join ('', map | ||||
| 124 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } | ||||
| 125 | @{$args->{collapse_map}{-identifying_columns}} | ||||
| 126 | ); | ||||
| 127 | } | ||||
| 128 | elsif( my @variants = @{$args->{collapse_map}{-identifying_columns_variants}} ) { | ||||
| 129 | |||||
| 130 | my @path_parts = map { sprintf | ||||
| 131 | "( ( defined '\xFF__VALPOS__%d__\xFF' ) && (join qq(\xFF), '', %s, '') )", | ||||
| 132 | $_->[0], # checking just first is enough - one ID defined, all defined | ||||
| 133 | ( join ', ', map { "'\xFF__VALPOS__${_}__\xFF'" } @$_ ), | ||||
| 134 | } @variants; | ||||
| 135 | |||||
| 136 | my $virtual_column_idx = (scalar keys %{$args->{val_index}} ) + 1; | ||||
| 137 | |||||
| 138 | $top_node_key = "{'\xFF__IDVALPOS__${virtual_column_idx}__\xFF'}"; | ||||
| 139 | |||||
| 140 | $top_node_key_assembler = sprintf "'\xFF__IDVALPOS__%d__\xFF' = (%s);", | ||||
| 141 | $virtual_column_idx, | ||||
| 142 | "\n" . join( "\n or\n", @path_parts, qq{"\0\$rows_pos\0"} ) | ||||
| 143 | ; | ||||
| 144 | |||||
| 145 | $args->{collapse_map} = { | ||||
| 146 | %{$args->{collapse_map}}, | ||||
| 147 | -custom_node_key => $top_node_key, | ||||
| 148 | }; | ||||
| 149 | |||||
| 150 | $no_rowid_container = 0; | ||||
| 151 | } | ||||
| 152 | else { | ||||
| 153 | die('Unexpected collapse map contents'); | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | my ($data_assemblers, $stats) = __visit_infmap_collapse ($args); | ||||
| 157 | |||||
| 158 | my @idcol_args = $no_rowid_container ? ('', '') : ( | ||||
| 159 | ', %cur_row_ids', # only declare the variable if we'll use it | ||||
| 160 | join ("\n", map { | ||||
| 161 | my $quoted_null_val = qq( "\0NULL\xFF\${rows_pos}\xFF${_}\0" ); | ||||
| 162 | qq(\$cur_row_ids{$_} = ) . ( | ||||
| 163 | # in case we prune - we will never hit these undefs | ||||
| 164 | $args->{prune_null_branches} ? qq( \$cur_row_data->[$_]; ) | ||||
| 165 | : HAS_DOR ? qq( \$cur_row_data->[$_] // $quoted_null_val; ) | ||||
| 166 | : qq( defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : $quoted_null_val; ) | ||||
| 167 | ) | ||||
| 168 | } sort { $a <=> $b } keys %{ $stats->{idcols_seen} } ), | ||||
| 169 | ); | ||||
| 170 | |||||
| 171 | my $parser_src = sprintf (<<'EOS', @idcol_args, $top_node_key_assembler||'', $top_node_key, join( "\n", @{$data_assemblers||[]} ) ); | ||||
| 172 | ### BEGIN LITERAL STRING EVAL | ||||
| 173 | my $rows_pos = 0; | ||||
| 174 | my ($result_pos, @collapse_idx, $cur_row_data %1$s); | ||||
| 175 | |||||
| 176 | # this loop is a bit arcane - the rationale is that the passed in | ||||
| 177 | # $_[0] will either have only one row (->next) or will have all | ||||
| 178 | # rows already pulled in (->all and/or unordered). Given that the | ||||
| 179 | # result can be rather large - we reuse the same already allocated | ||||
| 180 | # array, since the collapsed prefetch is smaller by definition. | ||||
| 181 | # At the end we cut the leftovers away and move on. | ||||
| 182 | while ($cur_row_data = ( | ||||
| 183 | ( $rows_pos >= 0 and $_[0][$rows_pos++] ) | ||||
| 184 | or | ||||
| 185 | ( $_[1] and $rows_pos = -1 and $_[1]->() ) | ||||
| 186 | ) ) { | ||||
| 187 | |||||
| 188 | # this code exists only when we are using a cur_row_ids | ||||
| 189 | # furthermore the undef checks may or may not be there | ||||
| 190 | # depending on whether we prune or not | ||||
| 191 | # | ||||
| 192 | # due to left joins some of the ids may be NULL/undef, and | ||||
| 193 | # won't play well when used as hash lookups | ||||
| 194 | # we also need to differentiate NULLs on per-row/per-col basis | ||||
| 195 | # (otherwise folding of optional 1:1s will be greatly confused | ||||
| 196 | %2$s | ||||
| 197 | |||||
| 198 | # in the case of an underdefined root - calculate the virtual id (otherwise no code at all) | ||||
| 199 | %3$s | ||||
| 200 | |||||
| 201 | # if we were supplied a coderef - we are collapsing lazily (the set | ||||
| 202 | # is ordered properly) | ||||
| 203 | # as long as we have a result already and the next result is new we | ||||
| 204 | # return the pre-read data and bail | ||||
| 205 | $_[1] and $result_pos and ! $collapse_idx[0]%4$s and (unshift @{$_[2]}, $cur_row_data) and last; | ||||
| 206 | |||||
| 207 | # the rel assemblers | ||||
| 208 | %5$s | ||||
| 209 | |||||
| 210 | } | ||||
| 211 | |||||
| 212 | $#{$_[0]} = $result_pos - 1; # truncate the passed in array to where we filled it with results | ||||
| 213 | ### END LITERAL STRING EVAL | ||||
| 214 | EOS | ||||
| 215 | |||||
| 216 | # !!! note - different var than the one above | ||||
| 217 | # change the quoted placeholders to unquoted alias-references | ||||
| 218 | $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$cur_row_data->[$1]"/gex; | ||||
| 219 | $parser_src =~ s/ | ||||
| 220 | $no_rowid_container ? "\$cur_row_data->[$1]" : "\$cur_row_ids{$1}" | ||||
| 221 | /gex; | ||||
| 222 | |||||
| - - | |||||
| 225 | __wrap_in_strictured_scope($parser_src); | ||||
| 226 | } | ||||
| 227 | |||||
| 228 | |||||
| 229 | # the collapsing nested structure recursor | ||||
| 230 | sub __visit_infmap_collapse { | ||||
| 231 | my $args = {%{ shift() }}; | ||||
| 232 | |||||
| 233 | my $cur_node_idx = ${ $args->{-node_idx_counter} ||= \do { my $x = 0} }++; | ||||
| 234 | |||||
| 235 | my ($my_cols, $rel_cols) = {}; | ||||
| 236 | for ( keys %{$args->{val_index}} ) { | ||||
| 237 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { | ||||
| 238 | $rel_cols->{$1}{$2} = $args->{val_index}{$_}; | ||||
| 239 | } | ||||
| 240 | else { | ||||
| 241 | $my_cols->{$_} = $args->{val_index}{$_}; | ||||
| 242 | } | ||||
| 243 | } | ||||
| 244 | |||||
| 245 | |||||
| 246 | if ($args->{hri_style}) { | ||||
| 247 | delete $my_cols->{$_} for grep { $rel_cols->{$_} } keys %$my_cols; | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | my $me_struct; | ||||
| 251 | $me_struct = __result_struct_to_source($my_cols) if keys %$my_cols; | ||||
| 252 | |||||
| 253 | $me_struct = sprintf( '[ %s ]', $me_struct||'' ) | ||||
| 254 | unless $args->{hri_style}; | ||||
| 255 | |||||
| 256 | |||||
| 257 | my $node_key = $args->{collapse_map}->{-custom_node_key} || join ('', map | ||||
| 258 | { "{'\xFF__IDVALPOS__${_}__\xFF'}" } | ||||
| 259 | @{$args->{collapse_map}->{-identifying_columns}} | ||||
| 260 | ); | ||||
| 261 | my $node_idx_slot = sprintf '$collapse_idx[%d]%s', $cur_node_idx, $node_key; | ||||
| 262 | |||||
| 263 | |||||
| 264 | my @src; | ||||
| 265 | |||||
| 266 | if ($cur_node_idx == 0) { | ||||
| 267 | push @src, sprintf( '%s %s $_[0][$result_pos++] = %s;', | ||||
| 268 | $node_idx_slot, | ||||
| 269 | (HAS_DOR ? '//=' : '||='), | ||||
| 270 | $me_struct || '{}', | ||||
| 271 | ); | ||||
| 272 | } | ||||
| 273 | else { | ||||
| 274 | my $parent_attach_slot = sprintf( '$collapse_idx[%d]%s%s{%s}', | ||||
| 275 | @{$args}{qw/-parent_node_idx -parent_node_key/}, | ||||
| 276 | $args->{hri_style} ? '' : '[1]', | ||||
| 277 | perlstring($args->{-node_rel_name}), | ||||
| 278 | ); | ||||
| 279 | |||||
| 280 | if ($args->{collapse_map}->{-is_single}) { | ||||
| 281 | push @src, sprintf ( '%s %s %s%s;', | ||||
| 282 | $parent_attach_slot, | ||||
| 283 | (HAS_DOR ? '//=' : '||='), | ||||
| 284 | $node_idx_slot, | ||||
| 285 | $me_struct ? " = $me_struct" : '', | ||||
| 286 | ); | ||||
| 287 | } | ||||
| 288 | else { | ||||
| 289 | push @src, sprintf('(! %s) and push @{%s}, %s%s;', | ||||
| 290 | $node_idx_slot, | ||||
| 291 | $parent_attach_slot, | ||||
| 292 | $node_idx_slot, | ||||
| 293 | $me_struct ? " = $me_struct" : '', | ||||
| 294 | ); | ||||
| 295 | } | ||||
| 296 | } | ||||
| 297 | |||||
| 298 | my $known_present_ids = { map { $_ => 1 } @{$args->{collapse_map}{-identifying_columns}} }; | ||||
| 299 | my ($stats, $rel_src); | ||||
| 300 | |||||
| 301 | for my $rel (sort keys %$rel_cols) { | ||||
| 302 | |||||
| 303 | my $relinfo = $args->{collapse_map}{$rel}; | ||||
| 304 | |||||
| 305 | ($rel_src, $stats->{$rel}) = __visit_infmap_collapse({ %$args, | ||||
| 306 | val_index => $rel_cols->{$rel}, | ||||
| 307 | collapse_map => $relinfo, | ||||
| 308 | -parent_node_idx => $cur_node_idx, | ||||
| 309 | -parent_node_key => $node_key, | ||||
| 310 | -node_rel_name => $rel, | ||||
| 311 | }); | ||||
| 312 | |||||
| 313 | my $rel_src_pos = $#src + 1; | ||||
| 314 | push @src, @$rel_src; | ||||
| 315 | |||||
| 316 | if ( | ||||
| 317 | $relinfo->{-is_optional} | ||||
| 318 | and | ||||
| 319 | defined ( my $first_distinct_child_idcol = first | ||||
| 320 | { ! $known_present_ids->{$_} } | ||||
| 321 | @{$relinfo->{-identifying_columns}} | ||||
| 322 | ) | ||||
| 323 | ) { | ||||
| 324 | |||||
| 325 | if ($args->{prune_null_branches}) { | ||||
| 326 | |||||
| 327 | # start of wrap of the entire chain in a conditional | ||||
| 328 | splice @src, $rel_src_pos, 0, sprintf "( ! defined %s )\n ? %s%s{%s} = %s\n : do {", | ||||
| 329 | "'\xFF__VALPOS__${first_distinct_child_idcol}__\xFF'", | ||||
| 330 | $node_idx_slot, | ||||
| 331 | $args->{hri_style} ? '' : '[1]', | ||||
| 332 | perlstring($rel), | ||||
| 333 | ($args->{hri_style} && $relinfo->{-is_single}) ? 'undef' : '[]' | ||||
| 334 | ; | ||||
| 335 | |||||
| 336 | # end of wrap | ||||
| 337 | push @src, '};' | ||||
| 338 | } | ||||
| 339 | else { | ||||
| 340 | |||||
| 341 | splice @src, $rel_src_pos + 1, 0, sprintf ( '(defined %s) or bless (%s[1]{%s}, %s);', | ||||
| 342 | "'\xFF__VALPOS__${first_distinct_child_idcol}__\xFF'", | ||||
| 343 | $node_idx_slot, | ||||
| 344 | perlstring($rel), | ||||
| 345 | perlstring($null_branch_class), | ||||
| 346 | ); | ||||
| 347 | } | ||||
| 348 | } | ||||
| 349 | } | ||||
| 350 | |||||
| 351 | return ( | ||||
| 352 | \@src, | ||||
| 353 | { | ||||
| 354 | idcols_seen => { | ||||
| 355 | ( map { %{ $_->{idcols_seen} } } values %$stats ), | ||||
| 356 | ( map { $_ => 1 } @{$args->{collapse_map}->{-identifying_columns}} ), | ||||
| 357 | } | ||||
| 358 | } | ||||
| 359 | ); | ||||
| 360 | } | ||||
| 361 | |||||
| 362 | sub __result_struct_to_source { | ||||
| 363 | sprintf( '{ %s }', join (', ', map | ||||
| 364 | { sprintf "%s => '\xFF__VALPOS__%d__\xFF'", perlstring($_), $_[0]{$_} } | ||||
| 365 | sort keys %{$_[0]} | ||||
| 366 | )); | ||||
| 367 | } | ||||
| 368 | |||||
| 369 | 1 | 4µs | 1; |