X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource%2FRowParser%2FUtil.pm;h=7192e1b8c05fb0cf21205571963e54d73f0789ac;hb=5ff6d6034ddcb696d24c4b716b5c12f109004d1f;hp=f80fd7dc8ff85bc85b522cf4f0d6497a1cc7373d;hpb=79adc44f8b50de05a1d31f9b3d4a64b137c7d0d8;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource/RowParser/Util.pm b/lib/DBIx/Class/ResultSource/RowParser/Util.pm index f80fd7d..7192e1b 100644 --- a/lib/DBIx/Class/ResultSource/RowParser/Util.pm +++ b/lib/DBIx/Class/ResultSource/RowParser/Util.pm @@ -4,8 +4,9 @@ package # hide from the pauses use strict; use warnings; -use List::Util 'first'; -use B 'perlstring'; +use DBIx::Class::_Util qw( perlstring dump_value ); + +use constant HAS_DOR => ( "$]" < 5.010 ? 0 : 1 ); use base 'Exporter'; our @EXPORT_OK = qw( @@ -16,6 +17,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) = @_; @@ -28,12 +33,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 @@ -61,7 +65,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}} ; @@ -108,30 +112,29 @@ 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}} ); + + $top_node_key_assembler = ''; } 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->{$_} = 1; " \$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"} ) ; @@ -140,26 +143,44 @@ sub assemble_collapsing_parser { %{$args->{collapse_map}}, -custom_node_key => $top_node_key, }; - - $no_rowid_container = 0; } else { - die('Unexpected collapse map contents'); + DBIx::Class::Exception->throw( + 'Unexpected collapse map contents: ' . dump_value $args->{collapse_map}, + 1, + ) } 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{$_} = 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 { + $stats->{nullchecks}{mandatory}{$_} + ? qq!( \$cur_row_data->[$_] )! + : do { + 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 @@ -168,30 +189,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 *not* assembling direct to HRI + # 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 +%s # in the case of an underdefined root - calculate the virtual id (otherwise no code at all) -%3$s +%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]%s and (unshift @{$_[2]}, $cur_row_data) and last ), # the rel assemblers -%5$s +%s } @@ -199,16 +237,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); } @@ -218,6 +247,27 @@ sub __visit_infmap_collapse { my $cur_node_idx = ${ $args->{-node_idx_counter} ||= \do { my $x = 0} }++; + $args->{-mandatory_ids} ||= {}; + $args->{-seen_ids} ||= {}; + $args->{-all_or_nothing_sets} ||= []; + $args->{-null_from} ||= []; + + $args->{-seen_ids}{$_} = 1 + for @{$args->{collapse_map}->{-identifying_columns}}; + + my $node_specific_ids = { map { $_ => 1 } grep + { ! $args->{-parent_ids}{$_} } + @{$args->{collapse_map}->{-identifying_columns}} + }; + + if (not ( $args->{-chain_is_optional} ||= $args->{collapse_map}{-is_optional} ) ) { + $args->{-mandatory_ids}{$_} = 1 + for @{$args->{collapse_map}->{-identifying_columns}}; + } + elsif ( keys %$node_specific_ids > 1 ) { + push @{$args->{-all_or_nothing_sets}}, $node_specific_ids; + } + my ($my_cols, $rel_cols) = {}; for ( keys %{$args->{val_index}} ) { if ($_ =~ /^ ([^\.]+) \. (.+) /x) { @@ -234,14 +284,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; @@ -250,8 +300,9 @@ sub __visit_infmap_collapse { my @src; if ($cur_node_idx == 0) { - push @src, sprintf( '%s ||= $_[0][$result_pos++] = %s;', + push @src, sprintf( '( %s %s $_[0][$result_pos++] = %s ),', $node_idx_slot, + (HAS_DOR ? '//=' : '||='), $me_struct || '{}', ); } @@ -259,39 +310,42 @@ sub __visit_infmap_collapse { my $parent_attach_slot = sprintf( '$collapse_idx[%d]%s%s{%s}', @{$args}{qw/-parent_node_idx -parent_node_key/}, $args->{hri_style} ? '' : '[1]', - perlstring($args->{-node_relname}), + perlstring($args->{-node_rel_name}), ); if ($args->{collapse_map}->{-is_single}) { - push @src, sprintf ( '%s ||= %s%s;', + push @src, sprintf ( '( %s %s %s = %s ),', $parent_attach_slot, + (HAS_DOR ? '//=' : '||='), $node_idx_slot, - $me_struct ? " = $me_struct" : '', + $me_struct || '{}', ); } 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, - $me_struct ? " = $me_struct" : '', + $me_struct || '{}', ); } } my $known_present_ids = { map { $_ => 1 } @{$args->{collapse_map}{-identifying_columns}} }; - my ($stats, $rel_src); + my $rel_src; for my $rel (sort keys %$rel_cols) { my $relinfo = $args->{collapse_map}{$rel}; - ($rel_src, $stats->{$rel}) = __visit_infmap_collapse({ %$args, + ($rel_src) = __visit_infmap_collapse({ %$args, val_index => $rel_cols->{$rel}, collapse_map => $relinfo, -parent_node_idx => $cur_node_idx, -parent_node_key => $node_key, - -node_relname => $rel, + -parent_id_path => [ @{$args->{-parent_id_path}||[]}, sort { $a <=> $b } keys %$node_specific_ids ], + -parent_ids => { map { %$_ } $node_specific_ids, $args->{-parent_ids}||{} }, + -node_rel_name => $rel, }); my $rel_src_pos = $#src + 1; @@ -299,18 +353,23 @@ sub __visit_infmap_collapse { if ( $relinfo->{-is_optional} - and - defined ( my $first_distinct_child_idcol = first + ) { + + my ($first_distinct_child_idcol) = grep { ! $known_present_ids->{$_} } @{$relinfo->{-identifying_columns}} - ) - ) { + ; + + DBIx::Class::Exception->throw( + "An optional node *without* a distinct identifying set shouldn't be possible: " . dump_value $args->{collapse_map}, + 1, + ) unless defined $first_distinct_child_idcol; 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), @@ -318,12 +377,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), @@ -332,22 +391,75 @@ sub __visit_infmap_collapse { } } + if ( + + # calculation only valid for leaf nodes + ! values %$rel_cols + + and + + # child of underdefined path doesn't leave us anything to test + @{$args->{-parent_id_path} || []} + + and + + (my @nullable_portion = grep + { ! $args->{-mandatory_ids}{$_} } + ( + @{$args->{-parent_id_path}}, + sort { $a <=> $b } keys %$node_specific_ids + ) + ) > 1 + ) { + # there may be 1:1 overlap with a specific all_or_nothing + push @{$args->{-null_from}}, \@nullable_portion unless grep + { + my $a_o_n_set = $_; + + keys %$a_o_n_set == @nullable_portion + and + ! grep { ! $a_o_n_set->{$_} } @nullable_portion + } + @{ $args->{-all_or_nothing_sets} || [] } + ; + } + return ( \@src, - { - idcols_seen => { - ( map { %{ $_->{idcols_seen} } } values %$stats ), - ( map { $_ => 1 } @{$args->{collapse_map}->{-identifying_columns}} ), - } - } + ( $cur_node_idx != 0 ) ? () : { + idcols_seen => $args->{-seen_ids}, + nullchecks => { + ( keys %{$args->{-mandatory_ids} } + ? ( mandatory => $args->{-mandatory_ids} ) + : () + ), + ( @{$args->{-all_or_nothing_sets}} + ? ( all_or_nothing => $args->{-all_or_nothing_sets} ) + : () + ), + ( @{$args->{-null_from}} + ? ( from_first_encounter => $args->{-null_from} ) + : () + ), + }, + }, ); } 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;