From: Peter Rabbitson Date: Thu, 11 Aug 2016 09:06:59 +0000 (+0200) Subject: Switch reverse_relationship_info() to the relcond resolver X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=86be9bcb90213db633791fcce074b7268765f615;p=dbsrgits%2FDBIx-Class.git Switch reverse_relationship_info() to the relcond resolver Prompted by a PR from @mzealey, a code audit showed the entire implementation to be severely lacking. Switched to proper relationship resolution, with the added benefit of support for custom conds whenever possible. As of this commit every single relationship introspection now goes through a central point: _resolve_relationship_condition(). No more random ... eq 'HASH' checks all over the place. There should be zero functional changes as a result (aside from better custom cond introspection) --- diff --git a/.mailmap b/.mailmap index 3a45040..031804b 100644 --- a/.mailmap +++ b/.mailmap @@ -37,6 +37,7 @@ Jason M. Mills Jonathan Chu Jose Luis Martinez Kent Fredric +Mark Zealey Matt Phillips Matt Phillips Michael Reddick diff --git a/AUTHORS b/AUTHORS index 36e3991..9e4a962 100644 --- a/AUTHORS +++ b/AUTHORS @@ -97,6 +97,7 @@ ilmari: Dagfinn Ilmari Mannsåker ingy: Ingy döt Net initself: Mike Baas ironcamel: Naveed Massjouni +jalh: Mark Zealey jasonmay: Jason May jawnsy: Jonathan Yu jegade: Jens Gassmann diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 24403e6..2dec416 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -17,9 +17,9 @@ use base 'DBIx::Class::ResultSource::RowParser'; use DBIx::Class::Carp; use DBIx::Class::_Util qw( - UNRESOLVABLE_CONDITION + UNRESOLVABLE_CONDITION DUMMY_ALIASPAIR dbic_internal_try fail_on_internal_call - refdesc emit_loud_diag dump_value + refdesc emit_loud_diag dump_value serialize bag_eq ); use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions ); use DBIx::Class::ResultSource::FromSpec::Util 'fromspec_columns_info'; @@ -1824,85 +1824,111 @@ L. sub reverse_relationship_info { my ($self, $rel) = @_; - my $rel_info = $self->relationship_info($rel) - or $self->throw_exception("No such relationship '$rel'"); + # This may be a partial schema or something else equally esoteric + # in which case this will throw + # + my $other_rsrc = $self->related_source($rel); - my $ret = {}; + # Some custom rels may not resolve without a $schema + # + my $our_resolved_relcond = dbic_internal_try { + $self->_resolve_relationship_condition( + rel_name => $rel, - return $ret unless ((ref $rel_info->{cond}) eq 'HASH'); + # an API where these are optional would be too cumbersome, + # instead always pass in some dummy values + DUMMY_ALIASPAIR, + ) + }; - my $stripped_cond = $self->__strip_relcond ($rel_info->{cond}); + # only straight-equality is compared + return {} + unless $our_resolved_relcond->{identity_map_matches_condition}; - my $registered_source_name = $self->source_name; + my( $our_registered_source_name, $our_result_class) = + ( $self->source_name, $self->result_class ); - # this may be a partial schema or something else equally esoteric - my $other_rsrc = $self->related_source($rel); + my $ret = {}; # Get all the relationships for that source that related to this source # whose foreign column set are our self columns on $rel and whose self # columns are our foreign columns on $rel foreach my $other_rel ($other_rsrc->relationships) { + # this will happen when we have a self-referential class + next if ( + $other_rel eq $rel + and + $self == $other_rsrc + ); + # only consider stuff that points back to us # "us" here is tricky - if we are in a schema registration, we want # to use the source_names, otherwise we will use the actual classes - # the schema may be partial - my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) } - or next; + my $roundtripped_rsrc; + next unless ( - if ($registered_source_name) { - next if $registered_source_name ne ($roundtrip_rsrc->source_name || '') - } - else { - next if $self->result_class ne $roundtrip_rsrc->result_class; - } + # the schema may be partially loaded + $roundtripped_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) } + + and - my $other_rel_info = $other_rsrc->relationship_info($other_rel); + ( - # this can happen when we have a self-referential class - next if $other_rel_info eq $rel_info; + ( + $our_registered_source_name + and + ( + $our_registered_source_name + eq + $roundtripped_rsrc->source_name||'' + ) + ) - next unless ref $other_rel_info->{cond} eq 'HASH'; - my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond}); + or - $ret->{$other_rel} = $other_rel_info if ( - $self->_compare_relationship_keys ( - [ keys %$stripped_cond ], [ values %$other_stripped_cond ] + ( + $our_result_class + eq + $roundtripped_rsrc->result_class + ) ) + and - $self->_compare_relationship_keys ( - [ values %$stripped_cond ], [ keys %$other_stripped_cond ] - ) + + my $their_resolved_relcond = dbic_internal_try { + $other_rsrc->_resolve_relationship_condition( + rel_name => $other_rel, + + # an API where these are optional would be too cumbersome, + # instead always pass in some dummy values + DUMMY_ALIASPAIR, + ) + } ); - } - return $ret; -} -# all this does is removes the foreign/self prefix from a condition -sub __strip_relcond { - +{ - map - { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) } - keys %{$_[1]} - } -} + $ret->{$other_rel} = $other_rsrc->relationship_info($other_rel) if ( -sub compare_relationship_keys { - carp 'compare_relationship_keys is a private method, stop calling it'; - my $self = shift; - $self->_compare_relationship_keys (@_); -} + $their_resolved_relcond->{identity_map_matches_condition} -# Returns true if both sets of keynames are the same, false otherwise. -sub _compare_relationship_keys { -# my ($self, $keys1, $keys2) = @_; - return - join ("\x00", sort @{$_[1]}) - eq - join ("\x00", sort @{$_[2]}) - ; + and + + keys %{ $our_resolved_relcond->{identity_map} } + == + keys %{ $their_resolved_relcond->{identity_map} } + + and + + serialize( $our_resolved_relcond->{identity_map} ) + eq + serialize( { reverse %{ $their_resolved_relcond->{identity_map} } } ) + + ); + } + + return $ret; } # optionally takes either an arrayref of column names, or a hashref of already @@ -2124,6 +2150,25 @@ sub _pk_depends_on { return 1; } +sub __strip_relcond :DBIC_method_is_indirect_sugar { + DBIx::Class::Exception->throw( + '__strip_relcond() has been removed with no replacement, ' + . 'ask for advice on IRC if this affected you' + ); +} + +sub compare_relationship_keys :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + carp_unique( 'compare_relationship_keys() is deprecated, ask on IRC for a better alternative' ); + bag_eq( $_[1], $_[2] ); +} + +sub _compare_relationship_keys :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + carp_unique( '_compare_relationship_keys() is deprecated, ask on IRC for a better alternative' ); + bag_eq( $_[1], $_[2] ); +} + sub resolve_condition { carp 'resolve_condition is a private method, stop calling it'; shift->_resolve_condition (@_); @@ -2259,7 +2304,7 @@ sub _resolve_relationship_condition { if $args->{self_alias} eq $args->{foreign_alias}; # TEMP - my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'"; + my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name || $self->result_class ]}'"; my $rel_info = $self->relationship_info($args->{rel_name}) # TEMP @@ -2462,7 +2507,10 @@ sub _resolve_relationship_condition { # construct the crosstable condition and the identity map for (0..$#f_cols) { $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" }; - $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_]; + + # explicit value stringification is deliberate - leave no room for + # interpretation when comparing sets of keys + $ret->{identity_map}{$l_cols[$_]} = "$f_cols[$_]"; }; if ($args->{foreign_values}) { @@ -2666,8 +2714,11 @@ sub _resolve_relationship_condition { $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias} ) { ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} ) - ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} ) - : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} ) + + # explicit value stringification is deliberate - leave no room for + # interpretation when comparing sets of keys + ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = "$colinfos->{$rhs_ref->[0]}{-colname}" ) + : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = "$colinfos->{$lhs}{-colname}" ) ; # well, what do you know! diff --git a/lib/DBIx/Class/ResultSource/RowParser.pm b/lib/DBIx/Class/ResultSource/RowParser.pm index 32fcf31..069d331 100644 --- a/lib/DBIx/Class/ResultSource/RowParser.pm +++ b/lib/DBIx/Class/ResultSource/RowParser.pm @@ -457,12 +457,15 @@ sub _resolve_collapse { is_single => $relinfo->{$rel}{is_single}, - # if there is at least one *inner* reverse relationship which is HASH-based (equality only) + # if there is at least one *inner* reverse relationship ( meaning identity-only ) # we can safely assume that the child can not exist without us - rev_rel_is_optional => ( grep - { ref $_->{cond} eq 'HASH' and ($_->{attrs}{join_type}||'') !~ /^left/i } - values %{ $self->reverse_relationship_info($rel) }, - ) ? 0 : 1, + rev_rel_is_optional => ( + ( grep { + ($_->{attrs}{join_type}||'') !~ /^left/i + } values %{ $self->reverse_relationship_info($rel) } ) + ? 0 + : 1 + ), # if this is a 1:1 our own collapser can be used as a collapse-map # (regardless of left or not) diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 08f3b69..29b196d 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -204,7 +204,7 @@ our @EXPORT_OK = qw( scope_guard detected_reinvoked_destructor emit_loud_diag true false is_exception dbic_internal_try dbic_internal_catch visit_namespaces - quote_sub qsub perlstring serialize deep_clone dump_value uniq + quote_sub qsub perlstring serialize deep_clone dump_value uniq bag_eq parent_dir mkdir_p UNRESOLVABLE_CONDITION DUMMY_ALIASPAIR ); @@ -387,6 +387,34 @@ sub uniq { ) } @_; } +sub bag_eq ($$) { + croak "bag_eq() requiress two arrayrefs as arguments" if ( + ref($_[0]) ne 'ARRAY' + or + ref($_[1]) ne 'ARRAY' + ); + + return '' unless @{$_[0]} == @{$_[1]}; + + my( %seen, $numeric_preserving_copy ); + + ( defined $_ + ? $seen{'value' . ( $numeric_preserving_copy = $_ )}++ + : $seen{'undef'}++ + ) for @{$_[0]}; + + ( defined $_ + ? $seen{'value' . ( $numeric_preserving_copy = $_ )}-- + : $seen{'undef'}-- + ) for @{$_[1]}; + + return ( + (grep { $_ } values %seen) + ? '' + : 1 + ); +} + my $dd_obj; sub dump_value ($) { local $Data::Dumper::Indent = 1 diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index 2535783..14812ac 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -15,7 +15,7 @@ $DEBUG = 0 unless defined $DEBUG; use Exporter; use SQL::Translator::Utils qw(debug normalize_name); use DBIx::Class::Carp qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/; -use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch bag_eq ); use Class::C3::Componentised; use Scalar::Util 'blessed'; use namespace::clean; @@ -155,13 +155,11 @@ sub parse { my %unique_constraints = $source->unique_constraints; foreach my $uniq (sort keys %unique_constraints) { - if (!$source->_compare_relationship_keys($unique_constraints{$uniq}, \@primary)) { - $table->add_constraint( - type => 'unique', - name => $uniq, - fields => $unique_constraints{$uniq} - ); - } + $table->add_constraint( + type => 'unique', + name => $uniq, + fields => $unique_constraints{$uniq} + ) unless bag_eq( \@primary, $unique_constraints{$uniq} ); } my @rels = $source->relationships(); @@ -232,7 +230,7 @@ sub parse { # this is supposed to indicate a has_one/might_have... # where's the introspection!!?? :) else { - $fk_constraint = not $source->_compare_relationship_keys(\@keys, \@primary); + $fk_constraint = ! bag_eq( \@keys, \@primary ); }