From: Peter Rabbitson Date: Fri, 22 Aug 2014 08:53:46 +0000 (+0200) Subject: Switch to a sane deduplication system X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b34d93310401fd6f4fd68dc965b4aec592913eb1;p=dbsrgits%2FDBIx-Class-Historic.git Switch to a sane deduplication system The original naive approach from 8e40a627f was utterly braindead and prone to false positives. Fix this for good --- diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 71ddf7c..f21759c 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -15,7 +15,7 @@ use mro 'c3'; use List::Util 'first'; use Scalar::Util 'blessed'; -use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION'; +use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION serialize); use SQL::Abstract qw(is_plain_value is_literal_value); use namespace::clean; @@ -1004,7 +1004,7 @@ sub _collapse_cond { push @pairs, -or => $chunk if @$chunk; } - elsif ( ! ref $chunk) { + elsif ( ! length ref $chunk) { push @pairs, $chunk, shift @pieces; } else { @@ -1045,6 +1045,7 @@ sub _collapse_cond { } } + # unroll single-element -and nodes if ( ref $fin->{-and} eq 'ARRAY' and @{$fin->{-and}} == 1 ) { my $piece = (delete $fin->{-and})->[0]; if (ref $piece eq 'ARRAY') { @@ -1069,12 +1070,12 @@ sub _collapse_cond { return unless @w; if ( @w == 1 ) { - return ( ref $w[0] ) + return ( length ref $w[0] ) ? $self->_collapse_cond($w[0]) : { $w[0] => undef } ; } - elsif ( @w == 2 and ! ref $w[0]) { + elsif ( @w == 2 and ! length ref $w[0]) { if ( ( $w[0]||'' ) =~ /^\-and$/i ) { return (ref $w[1] eq 'HASH' or ref $w[1] eq 'ARRAY') ? $self->_collapse_cond($w[1], (ref $w[1] eq 'ARRAY') ) @@ -1205,7 +1206,6 @@ sub _collapse_cond_unroll_pairs { # is instead used to infer inambiguous values from conditions # (e.g. the inheritance of resultset conditions on new_result) # -my $undef_marker = \ do{ my $x = 'undef' }; sub _extract_fixed_condition_columns { my ($self, $where, $consider_nulls) = @_; my $where_hash = $self->_collapse_cond($_[1]); @@ -1216,7 +1216,7 @@ sub _extract_fixed_condition_columns { my $vals; if (!defined ($v = $where_hash->{$c}) ) { - $vals->{$undef_marker} = $v if $consider_nulls + $vals->{UNDEF} = $v if $consider_nulls } elsif ( ref $v eq 'HASH' @@ -1225,15 +1225,15 @@ sub _extract_fixed_condition_columns { ) { if (exists $v->{-value}) { if (defined $v->{-value}) { - $vals->{$v->{-value}} = $v->{-value} + $vals->{"VAL_$v->{-value}"} = $v->{-value} } elsif( $consider_nulls ) { - $vals->{$undef_marker} = $v->{-value}; + $vals->{UNDEF} = $v->{-value}; } } # do not need to check for plain values - _collapse_cond did it for us - elsif(ref $v->{'='} and is_literal_value($v->{'='}) ) { - $vals->{$v->{'='}} = $v->{'='}; + elsif(length ref $v->{'='} and is_literal_value($v->{'='}) ) { + $vals->{ 'SER_' . serialize $v->{'='} } = $v->{'='}; } } elsif ( @@ -1241,19 +1241,23 @@ sub _extract_fixed_condition_columns { or is_plain_value ($v) ) { - $vals->{$v} = $v; + $vals->{"VAL_$v"} = $v; } elsif (ref $v eq 'ARRAY' and ($v->[0]||'') eq '-and') { for ( @{$v}[1..$#$v] ) { my $subval = $self->_extract_fixed_condition_columns({ $c => $_ }, 'consider nulls'); # always fish nulls out on recursion next unless exists $subval->{$c}; # didn't find anything - $vals->{defined $subval->{$c} ? $subval->{$c} : $undef_marker} = $subval->{$c}; + $vals->{ + ! defined $subval->{$c} ? 'UNDEF' + : ( ! length ref $subval->{$c} or is_plain_value $subval->{$c} ) ? "VAL_$subval->{$c}" + : ( 'SER_' . serialize $subval->{$c} ) + } = $subval->{$c}; } } if (keys %$vals == 1) { ($res->{$c}) = (values %$vals) - unless !$consider_nulls and exists $vals->{$undef_marker}; + unless !$consider_nulls and exists $vals->{UNDEF}; } elsif (keys %$vals > 1) { $res->{$c} = UNRESOLVABLE_CONDITION; diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 9f984d2..37dddfc 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -104,7 +104,7 @@ our @EXPORT_OK = qw( sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray fail_on_internal_call refdesc refcount hrefaddr is_exception - quote_sub qsub perlstring + quote_sub qsub perlstring serialize UNRESOLVABLE_CONDITION ); @@ -145,6 +145,12 @@ sub refcount ($) { B::svref_2object($_[0])->REFCNT; } +sub serialize ($) { + require Storable; + local $Storable::canonical = 1; + Storable::nfreeze($_[0]); +} + sub is_exception ($) { my $e = $_[0];