X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=b51e05cbc1ad9a29622ec18d4929f62d975461b6;hb=87b1255103d7b8873b225416cb381c50011f4c06;hp=3da8a7979154e60131fd2b143dfe012eb6acc29d;hpb=4c41a8757c6dd3ff786f27891ad763ebbd54f346;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 3da8a79..b51e05c 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -8,13 +8,11 @@ use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultClass::HashRefInflator; use Scalar::Util qw/blessed weaken reftype/; use DBIx::Class::_Util qw( + dbic_internal_try dump_value fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION ); use Try::Tiny; -# not importing first() as it will clash with our own method -use List::Util (); - BEGIN { # De-duplication in _merge_attr() is disabled, but left in for reference # (the merger is used for other things that ought not to be de-duped) @@ -442,7 +440,7 @@ sub search_rs { $call_cond = shift; } # fish out attrs in the ($condref, $attr) case - elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) { + elsif (@_ == 2 and ( ! defined $_[0] or length ref $_[0] ) ) { ($call_cond, $call_attrs) = @_; } elsif (@_ % 2) { @@ -456,7 +454,7 @@ sub search_rs { for my $i (0 .. $#_) { next if $i % 2; $self->throw_exception ('All keys in condition key/value pairs must be plain scalars') - if (! defined $_[$i] or ref $_[$i] ne ''); + if (! defined $_[$i] or length ref $_[$i] ); } $call_cond = { @_ }; @@ -465,7 +463,7 @@ sub search_rs { # see if we can keep the cache (no $rs changes) my $cache; my %safe = (alias => 1, cache => 1); - if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and ( + if ( ! grep { !$safe{$_} } keys %$call_attrs and ( ! defined $call_cond or ref $call_cond eq 'HASH' && ! keys %$call_cond @@ -489,9 +487,8 @@ sub search_rs { my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/; # reset the current selector list if new selectors are supplied - if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { - delete @{$old_attrs}{(@selector_attrs, '_dark_selector')}; - } + delete @{$old_attrs}{(@selector_attrs, '_dark_selector')} + if grep { exists $call_attrs->{$_} } qw(columns cols select as); # Normalize the new selector list (operates on the passed-in attr structure) # Need to do it on every chain instead of only once on _resolved_attrs, in @@ -553,7 +550,6 @@ sub search_rs { return $rs; } -my $dark_sel_dumper; sub _normalize_selection { my ($self, $attrs) = @_; @@ -618,11 +614,10 @@ sub _normalize_selection { else { $attrs->{_dark_selector} = { plus_stage => $pref, - string => ($dark_sel_dumper ||= do { - require Data::Dumper::Concise; - Data::Dumper::Concise::DumperObject()->Indent(0); - })->Values([$_])->Dump - , + string => do { + local $Data::Dumper::Indent = 0; + dump_value $_; + }, }; last SELECTOR; } @@ -878,7 +873,7 @@ sub find { join "\x00", sort $rsrc->unique_constraint_columns($c_name) }++; - try { + dbic_internal_try { push @unique_queries, $self->_qualify_cond_columns( $self->result_source->_minimal_valueset_satisfying_constraint( constraint_name => $c_name, @@ -1414,7 +1409,7 @@ sub _construct_results { : '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows' ), ( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) ) - ); + ) . '; 1' or die; } } else { @@ -1424,60 +1419,30 @@ sub _construct_results { : 'classic_nonpruning' ; - # $args and $attrs to _mk_row_parser are separated to delineate what is - # core collapser stuff and what is dbic $rs specific - @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $rsrc->_mk_row_parser({ - eval => 1, - inflate_map => $infmap, - collapse => $attrs->{collapse}, - premultiplied => $attrs->{_main_source_premultiplied}, - hri_style => $self->{_result_inflator}{is_hri}, - prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row}, - }, $attrs) unless $self->{_row_parser}{$parser_type}{cref}; - - # 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 an explicit check for the *main* - # result, hopefully this will gradually weed out such errors - # - # FIXME - this is a temporary kludge that reduces performance - # It is however necessary for the time being - my ($unrolled_non_null_cols_to_check, $err); + unless( $self->{_row_parser}{$parser_type}{cref} ) { - if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) { + # $args and $attrs to _mk_row_parser are separated to delineate what is + # core collapser stuff and what is dbic $rs specific + $self->{_row_parser}{$parser_type}{src} = $rsrc->_mk_row_parser({ + inflate_map => $infmap, + collapse => $attrs->{collapse}, + premultiplied => $attrs->{_main_source_premultiplied}, + hri_style => $self->{_result_inflator}{is_hri}, + prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row}, + }, $attrs); - $err = - 'Collapse aborted due to invalid ResultSource metadata - the following ' - . 'selections are declared non-nullable but NULLs were retrieved: ' - ; - - my @violating_idx; - COL: for my $i (@$check_non_null_cols) { - ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows; - } + $self->{_row_parser}{$parser_type}{cref} = do { + package # hide form PAUSE + DBIx::Class::__GENERATED_ROW_PARSER__; - $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) - if @violating_idx; - - $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols); - - utf8::upgrade($unrolled_non_null_cols_to_check) - if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE; + eval $self->{_row_parser}{$parser_type}{src}; + } || die $@; } - my $next_cref = - ($did_fetch_all or ! $attrs->{collapse}) ? undef - : defined $unrolled_non_null_cols_to_check ? eval sprintf <<'EOS', $unrolled_non_null_cols_to_check -sub { - # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref - my @r = $cursor->next or return; - if (my @violating_idx = grep { ! defined $r[$_] } (%s) ) { - $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) - } - \@r -} -EOS - : sub { + # this needs to close over the *current* cursor, hence why it is not cached above + my $next_cref = ($did_fetch_all or ! $attrs->{collapse}) + ? undef + : sub { # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref my @r = $cursor->next or return; \@r @@ -1486,9 +1451,25 @@ EOS $self->{_row_parser}{$parser_type}{cref}->( $rows, - $next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (), + $next_cref, + ( $self->{_stashed_rows} = [] ), + ( my $null_violations = {} ), ); + $self->throw_exception( + 'Collapse aborted - the following columns are declared (or defaulted to) ' + . 'non-nullable within DBIC but NULLs were retrieved from storage: ' + . join( ', ', map { "'$infmap->[$_]'" } sort { $a <=> $b } keys %$null_violations ) + . ' within data row ' . dump_value({ + map { + $infmap->[$_] => + ( ! defined $self->{_stashed_rows}[0][$_] or length $self->{_stashed_rows}[0][$_] < 50 ) + ? $self->{_stashed_rows}[0][$_] + : substr( $self->{_stashed_rows}[0][$_], 0, 50 ) . '...' + } 0 .. $#{$self->{_stashed_rows}[0]} + }) + ) if keys %$null_violations; + # simple in-place substitution, does not regrow $rows if ($self->{_result_inflator}{is_core_row}) { $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows @@ -1903,7 +1884,7 @@ sub _rs_update_delete { $storage->_prune_unused_joins ($attrs); # any non-pruneable non-local restricting joins imply subq - $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; + $needs_subq = grep { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; } # check if the head is composite (by now all joins are thrown out unless $needs_subq) @@ -3546,7 +3527,7 @@ sub _resolved_attrs { # default selection list $attrs->{columns} = [ $source->columns ] - unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/; + unless grep { exists $attrs->{$_} } qw/columns cols select as/; # merge selectors together for (qw/columns select as/) { @@ -3707,7 +3688,7 @@ sub _resolved_attrs { if ( ! $attrs->{_main_source_premultiplied} and - ! List::Util::first { ! $_->[0]{-is_single} } @fromlist + ! grep { ! $_->[0]{-is_single} } @fromlist ) { $attrs->{collapse} = 0; } @@ -3937,7 +3918,7 @@ sub _merge_joinpref_attr { }, ARRAY => sub { return $_[1] if !defined $_[0]; - return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; + return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]}; return [$_[0], @{$_[1]}] }, HASH => sub { @@ -3950,7 +3931,7 @@ sub _merge_joinpref_attr { ARRAY => { SCALAR => sub { return $_[0] if !defined $_[1]; - return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; + return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]}; return [@{$_[0]}, $_[1]] }, ARRAY => sub { @@ -3963,7 +3944,7 @@ sub _merge_joinpref_attr { HASH => sub { return [ $_[1] ] if ! @{$_[0]}; return $_[0] if !keys %{$_[1]}; - return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; + return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]}; return [ @{$_[0]}, $_[1] ]; }, }, @@ -3978,7 +3959,7 @@ sub _merge_joinpref_attr { return [] if !keys %{$_[0]} and !@{$_[1]}; return [ $_[0] ] if !@{$_[1]}; return $_[1] if !keys %{$_[0]}; - return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; + return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]}; return [ $_[0], @{$_[1]} ]; }, HASH => sub { @@ -4645,7 +4626,7 @@ revisit rows in your ResultSet: ... do stuff ... } - $rs->first; # without cache, this would issue a query + $resultset->first; # without cache, this would issue a query By default, searches are not cached.