X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource%2FRowParser%2FUtil.pm;h=a64df955d38c06ec2c3e9a035899a7e59396abb1;hb=3605497bcb83ef83a4859a84e52c03f77f3cd626;hp=d82f7b4b71fc2369f2c13fd45f419cf000699b41;hpb=40471d469bc450ab29789724d94f4c3c825c158f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource/RowParser/Util.pm b/lib/DBIx/Class/ResultSource/RowParser/Util.pm index d82f7b4..a64df95 100644 --- a/lib/DBIx/Class/ResultSource/RowParser/Util.pm +++ b/lib/DBIx/Class/ResultSource/RowParser/Util.pm @@ -4,10 +4,9 @@ package # hide from the pauses use strict; use warnings; -use List::Util 'first'; -use DBIx::Class::_Util 'perlstring'; +use DBIx::Class::_Util qw( perlstring dump_value ); -use constant HAS_DOR => ( "$]" < 5.010 ? 0 : 1 ); +use constant HAS_DOR => ( ( DBIx::Class::_ENV_::PERL_VERSION < 5.010 ) ? 0 : 1 ); use base 'Exporter'; our @EXPORT_OK = qw( @@ -19,7 +18,7 @@ our @EXPORT_OK = qw( our $null_branch_class = 'DBIx::ResultParser::RelatedNullBranch'; sub __wrap_in_strictured_scope { - " { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n }" + "sub { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n }" } sub assemble_simple_parser { @@ -120,13 +119,15 @@ sub assemble_collapsing_parser { { "{ \$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 \$cur_row_data->[%d] ) && (join qq(\xFF), '', %s, '') )", $_->[0], # checking just first is enough - one ID defined, all defined - ( join ', ', map { ++$variant_idcols->{$_} and " \$cur_row_ids{$_} " } @$_ ), + ( join ', ', map { $variant_idcols->{$_} = 1; " \$cur_row_ids{$_} " } @$_ ), } @variants; my $virtual_column_idx = (scalar keys %{$args->{val_index}} ) + 1; @@ -144,7 +145,10 @@ sub assemble_collapsing_parser { }; } 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); @@ -161,15 +165,77 @@ sub assemble_collapsing_parser { ( $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 )! + $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||[]} ) ); + my $null_checks = ''; + + for my $c ( sort { $a <=> $b } keys %{$stats->{nullchecks}{mandatory}} ) { + $null_checks .= sprintf <<'EOS', $c +( defined( $cur_row_data->[%1$s] ) or $_[3]->{%1$s} = 1 ), + +EOS + } + + for my $set ( @{ $stats->{nullchecks}{from_first_encounter} || [] } ) { + my @sub_checks; + + for my $i (0 .. $#$set - 1) { + + push @sub_checks, sprintf + '( not defined $cur_row_data->[%1$s] ) ? ( %2$s or ( $_[3]->{%1$s} = 1 ) )', + $set->[$i], + join( ' and ', map + { "( not defined \$cur_row_data->[$set->[$_]] )" } + ( $i+1 .. $#$set ) + ), + ; + } + + $null_checks .= "(\n @{[ join qq(\n: ), @sub_checks, '()' ]} \n),\n"; + } + + for my $set ( @{ $stats->{nullchecks}{all_or_nothing} || [] } ) { + + $null_checks .= sprintf "(\n( %s )\n or\n(\n%s\n)\n),\n", + join ( ' and ', map + { "( not defined \$cur_row_data->[$_] )" } + sort { $a <=> $b } keys %$set + ), + join ( ",\n", map + { "( defined(\$cur_row_data->[$_]) or \$_[3]->{$_} = 1 )" } + sort { $a <=> $b } keys %$set + ), + ; + } + + # If any of the above generators produced something, we need to add the + # final "if seen any violations - croak" part + # Do not throw from within the string eval itself as it does not have + # the necessary metadata to construct a nice exception text. As a bonus + # we get to entirely avoid https://github.com/Test-More/Test2/issues/16 + # and https://rt.perl.org/Public/Bug/Display.html?id=127774 + + $null_checks .= <<'EOS' if $null_checks; + +( keys %{$_[3]} and ( + ( @{$_[2]} = $cur_row_data ), + ( $result_pos = 0 ), + last +) ), +EOS + + + my $parser_src = sprintf (<<'EOS', $null_checks, $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, %%cur_row_ids ); @@ -202,26 +268,37 @@ sub assemble_collapsing_parser { ( $_[1] and $_[1]->() ) ) ) { - # the undef checks may or may not be there - # depending on whether we prune or not + # column_info metadata historically hasn't been too reliable. + # We need to start fixing this somehow (the collapse resolver + # can't work without it). Add explicit checks for several cases + # of "unexpected NULL", based on the metadata returned by + # __visit_infmap_collapse # + # FIXME - this is a temporary kludge that reduces performance + # It is however necessary for the time being, until way into the + # future when the extra errors clear out all invalid metadata +%s + # 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 -%1$s + # + # the undef checks may or may not be there depending on whether + # we prune or not +%s # in the case of an underdefined root - calculate the virtual id (otherwise no code at all) -%2$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]%3$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 -%4$s +%s } @@ -239,6 +316,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) { @@ -303,17 +401,19 @@ sub __visit_infmap_collapse { } 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, + -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, }); @@ -322,12 +422,17 @@ 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}) { @@ -355,14 +460,58 @@ 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} ) + : () + ), + }, + }, ); }