X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource%2FRowParser%2FUtil.pm;h=6ef758903fe3871bae213cb3730f0a91b357c8b5;hb=821edc0964a64b9d20b7d02c4a738b87e806f32d;hp=6203efa392a1b7f32c29940185fa4c393fb38502;hpb=a5f5e47019daf25c0b0f9708cbd3ab2695584c5a;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/ResultSource/RowParser/Util.pm b/lib/DBIx/Class/ResultSource/RowParser/Util.pm index 6203efa..6ef7589 100644 --- a/lib/DBIx/Class/ResultSource/RowParser/Util.pm +++ b/lib/DBIx/Class/ResultSource/RowParser/Util.pm @@ -5,7 +5,7 @@ use strict; use warnings; use List::Util 'first'; -use B 'perlstring'; +use DBIx::Class::_Util 'perlstring'; use constant HAS_DOR => ( $] < 5.010 ? 0 : 1 ); @@ -18,6 +18,10 @@ our @EXPORT_OK = qw( # working title - we are hoping to extract this eventually... our $null_branch_class = 'DBIx::ResultParser::RelatedNullBranch'; +sub __wrap_in_strictured_scope { + " { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n }" +} + sub assemble_simple_parser { #my ($args) = @_; @@ -30,12 +34,11 @@ sub assemble_simple_parser { # the data structure, then to fetch the data do: # push @rows, dclone($row_data_struct) while ($sth->fetchrow); # - my $parser_src = sprintf('$_ = %s for @{$_[0]}', __visit_infmap_simple($_[0]) ); - # change the quoted placeholders to unquoted alias-references - $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$_->[$1]"/gex; - - $parser_src = " { use strict; use warnings FATAL => 'all';\n$parser_src\n }"; + __wrap_in_strictured_scope( sprintf + '$_ = %s for @{$_[0]}', + __visit_infmap_simple( $_[0] ) + ); } # the simple non-collapsing nested structure recursor @@ -63,7 +66,7 @@ sub __visit_infmap_simple { if (keys %$my_cols) { my $branch_null_checks = join ' && ', map - { "( ! defined '\xFF__VALPOS__${_}__\xFF' )" } + { "( ! defined \$_->[$_] )" } sort { $a <=> $b } values %{$rel_cols->{$rel}} ; @@ -110,30 +113,27 @@ sub __visit_infmap_simple { sub assemble_collapsing_parser { my $args = shift; - # it may get unset further down - my $no_rowid_container = $args->{prune_null_branches}; - - my ($top_node_key, $top_node_key_assembler); + my ($top_node_key, $top_node_key_assembler, $variant_idcols); if (scalar @{$args->{collapse_map}{-identifying_columns}}) { $top_node_key = join ('', map - { "{'\xFF__IDVALPOS__${_}__\xFF'}" } + { "{ \$cur_row_ids{$_} }" } @{$args->{collapse_map}{-identifying_columns}} ); } elsif( my @variants = @{$args->{collapse_map}{-identifying_columns_variants}} ) { my @path_parts = map { sprintf - "( ( defined '\xFF__VALPOS__%d__\xFF' ) && (join qq(\xFF), '', %s, '') )", + "( ( defined \$cur_row_data->[%d] ) && (join qq(\xFF), '', %s, '') )", $_->[0], # checking just first is enough - one ID defined, all defined - ( join ', ', map { "'\xFF__VALPOS__${_}__\xFF'" } @$_ ), + ( join ', ', map { ++$variant_idcols->{$_} and " \$cur_row_ids{$_} " } @$_ ), } @variants; my $virtual_column_idx = (scalar keys %{$args->{val_index}} ) + 1; - $top_node_key = "{'\xFF__IDVALPOS__${virtual_column_idx}__\xFF'}"; + $top_node_key = "{ \$cur_row_ids{$virtual_column_idx} }"; - $top_node_key_assembler = sprintf "'\xFF__IDVALPOS__%d__\xFF' = (%s);", + $top_node_key_assembler = sprintf "( \$cur_row_ids{%d} = (%s) ),", $virtual_column_idx, "\n" . join( "\n or\n", @path_parts, qq{"\0\$rows_pos\0"} ) ; @@ -142,8 +142,6 @@ sub assemble_collapsing_parser { %{$args->{collapse_map}}, -custom_node_key => $top_node_key, }; - - $no_rowid_container = 0; } else { die('Unexpected collapse map contents'); @@ -151,20 +149,30 @@ sub assemble_collapsing_parser { my ($data_assemblers, $stats) = __visit_infmap_collapse ($args); - my @idcol_args = $no_rowid_container ? ('', '') : ( - ', %cur_row_ids', # only declare the variable if we'll use it - join ("\n", map { qq(\$cur_row_ids{$_} = ) . ( - # in case we prune - we will never hit these undefs - $args->{prune_null_branches} ? qq(\$cur_row_data->[$_];) - : HAS_DOR ? qq(\$cur_row_data->[$_] // "\0NULL\xFF\$rows_pos\xFF$_\0";) - : qq(defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : "\0NULL\xFF\$rows_pos\xFF$_\0";) - ) } sort { $a <=> $b } keys %{ $stats->{idcols_seen} } ), - ); - - my $parser_src = sprintf (<<'EOS', @idcol_args, $top_node_key_assembler||'', $top_node_key, join( "\n", @{$data_assemblers||[]} ) ); + # variants do not necessarily overlap with true idcols + my @row_ids = sort { $a <=> $b } keys %{ { + %{ $variant_idcols || {} }, + %{ $stats->{idcols_seen} }, + } }; + + my $row_id_defs = sprintf "( \@cur_row_ids{( %s )} = (\n%s\n ) ),", + join (', ', @row_ids ), + # in case we prune - we will never hit undefs/NULLs as pigeon-hole-criteria + ( $args->{prune_null_branches} + ? sprintf( '@{$cur_row_data}[( %s )]', join ', ', @row_ids ) + : join (",\n", map { + my $quoted_null_val = qq("\0NULL\xFF\${rows_pos}\xFF${_}\0"); + HAS_DOR + ? qq!( \$cur_row_data->[$_] // $quoted_null_val )! + : qq!( defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : $quoted_null_val )! + } @row_ids) + ) + ; + + my $parser_src = sprintf (<<'EOS', $row_id_defs, $top_node_key_assembler||'', $top_node_key, join( "\n", @{$data_assemblers||[]} ) ); ### BEGIN LITERAL STRING EVAL my $rows_pos = 0; - my ($result_pos, @collapse_idx, $cur_row_data %1$s); + my ($result_pos, @collapse_idx, $cur_row_data, %%cur_row_ids ); # this loop is a bit arcane - the rationale is that the passed in # $_[0] will either have only one row (->next) or will have all @@ -173,32 +181,47 @@ sub assemble_collapsing_parser { # array, since the collapsed prefetch is smaller by definition. # At the end we cut the leftovers away and move on. while ($cur_row_data = ( - ( $rows_pos >= 0 and $_[0][$rows_pos++] ) + ( + $rows_pos >= 0 + and + ( + $_[0][$rows_pos++] + or + # It may be tempting to drop the -1 and undef $rows_pos instead + # thus saving the >= comparison above as well + # However NULL-handlers and underdefined root markers both use + # $rows_pos as a last-resort-uniqueness marker (it either is + # monotonically increasing while we parse ->all, or is set at + # a steady -1 when we are dealing with a single root node). For + # the time being the complication of changing all callsites seems + # overkill, for what is going to be a very modest saving of ops + ( ($rows_pos = -1), undef ) + ) + ) or - ( $_[1] and $rows_pos = -1 and $_[1]->() ) + ( $_[1] and $_[1]->() ) ) ) { - # this code exists only when we are using a cur_row_ids - # furthermore the undef checks may or may not be there + # the undef checks may or may not be there # depending on whether we prune or not # # due to left joins some of the ids may be NULL/undef, and # won't play well when used as hash lookups # we also need to differentiate NULLs on per-row/per-col basis # (otherwise folding of optional 1:1s will be greatly confused -%2$s +%1$s # in the case of an underdefined root - calculate the virtual id (otherwise no code at all) -%3$s +%2$s # if we were supplied a coderef - we are collapsing lazily (the set # is ordered properly) # as long as we have a result already and the next result is new we # return the pre-read data and bail -$_[1] and $result_pos and ! $collapse_idx[0]%4$s and (unshift @{$_[2]}, $cur_row_data) and last; +( $_[1] and $result_pos and ! $collapse_idx[0]%3$s and (unshift @{$_[2]}, $cur_row_data) and last ), # the rel assemblers -%5$s +%4$s } @@ -206,16 +229,7 @@ $_[1] and $result_pos and ! $collapse_idx[0]%4$s and (unshift @{$_[2]}, $cur_row ### END LITERAL STRING EVAL EOS - # !!! note - different var than the one above - # change the quoted placeholders to unquoted alias-references - $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /"\$cur_row_data->[$1]"/gex; - $parser_src =~ s/ - \' \xFF__IDVALPOS__(\d+)__\xFF \' - / - $no_rowid_container ? "\$cur_row_data->[$1]" : "\$cur_row_ids{$1}" - /gex; - - $parser_src = " { use strict; use warnings FATAL => 'all';\n$parser_src\n }"; + __wrap_in_strictured_scope($parser_src); } @@ -241,14 +255,14 @@ sub __visit_infmap_collapse { } my $me_struct; - $me_struct = __result_struct_to_source($my_cols) if keys %$my_cols; + $me_struct = __result_struct_to_source($my_cols, 1) if keys %$my_cols; $me_struct = sprintf( '[ %s ]', $me_struct||'' ) unless $args->{hri_style}; my $node_key = $args->{collapse_map}->{-custom_node_key} || join ('', map - { "{'\xFF__IDVALPOS__${_}__\xFF'}" } + { "{ \$cur_row_ids{$_} }" } @{$args->{collapse_map}->{-identifying_columns}} ); my $node_idx_slot = sprintf '$collapse_idx[%d]%s', $cur_node_idx, $node_key; @@ -257,7 +271,7 @@ sub __visit_infmap_collapse { my @src; if ($cur_node_idx == 0) { - push @src, sprintf( '%s %s $_[0][$result_pos++] = %s;', + push @src, sprintf( '( %s %s $_[0][$result_pos++] = %s ),', $node_idx_slot, (HAS_DOR ? '//=' : '||='), $me_struct || '{}', @@ -271,7 +285,7 @@ sub __visit_infmap_collapse { ); if ($args->{collapse_map}->{-is_single}) { - push @src, sprintf ( '%s %s %s%s;', + push @src, sprintf ( '( %s %s %s%s ),', $parent_attach_slot, (HAS_DOR ? '//=' : '||='), $node_idx_slot, @@ -279,7 +293,7 @@ sub __visit_infmap_collapse { ); } else { - push @src, sprintf('(! %s) and push @{%s}, %s%s;', + push @src, sprintf('( (! %s) and push @{%s}, %s%s ),', $node_idx_slot, $parent_attach_slot, $node_idx_slot, @@ -318,8 +332,8 @@ sub __visit_infmap_collapse { if ($args->{prune_null_branches}) { # start of wrap of the entire chain in a conditional - splice @src, $rel_src_pos, 0, sprintf "( ! defined %s )\n ? %s%s{%s} = %s\n : do {", - "'\xFF__VALPOS__${first_distinct_child_idcol}__\xFF'", + splice @src, $rel_src_pos, 0, sprintf "( ( ! defined %s )\n ? %s%s{%s} = %s\n : do {", + "\$cur_row_data->[$first_distinct_child_idcol]", $node_idx_slot, $args->{hri_style} ? '' : '[1]', perlstring($rel), @@ -327,12 +341,12 @@ sub __visit_infmap_collapse { ; # end of wrap - push @src, '};' + push @src, '} ),' } else { - splice @src, $rel_src_pos + 1, 0, sprintf ( '(defined %s) or bless (%s[1]{%s}, %s);', - "'\xFF__VALPOS__${first_distinct_child_idcol}__\xFF'", + splice @src, $rel_src_pos + 1, 0, sprintf ( '( (defined %s) or bless (%s[1]{%s}, %s) ),', + "\$cur_row_data->[$first_distinct_child_idcol]", $node_idx_slot, perlstring($rel), perlstring($null_branch_class), @@ -353,10 +367,19 @@ sub __visit_infmap_collapse { } sub __result_struct_to_source { - sprintf( '{ %s }', join (', ', map - { sprintf "%s => '\xFF__VALPOS__%d__\xFF'", perlstring($_), $_[0]{$_} } - sort keys %{$_[0]} - )); + my ($data, $is_collapsing) = @_; + + sprintf( '{ %s }', + join (', ', map { + sprintf ( "%s => %s", + perlstring($_), + $is_collapsing + ? "\$cur_row_data->[$data->{$_}]" + : "\$_->[ $data->{$_} ]" + ) + } sort keys %{$data} + ) + ); } 1;