X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBIHacks.pm;h=da09d12a0014570f42cb0db54bcd20ac2cdb7741;hb=135ac69ddafd158cbfa4082871599ee104bbd205;hp=90bade8f89bf06578d1f6b25f1669e3fa3c9d43e;hpb=953d5b7d978136fb5f43339f1b7b41d140b3e4a5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 90bade8..da09d12 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -986,6 +986,8 @@ sub _extract_colinfo_of_stable_main_source_order_by_portion { sub _collapse_cond { my ($self, $where, $where_is_anded_array) = @_; + my $fin; + if (! $where) { return; } @@ -1018,25 +1020,31 @@ sub _collapse_cond { or return; # Consolidate various @conds back into something more compact - my $fin; - for my $c (@conds) { if (ref $c ne 'HASH') { push @{$fin->{-and}}, $c; } else { for my $col (sort keys %$c) { - if (exists $fin->{$col}) { - my ($l, $r) = ($fin->{$col}, $c->{$col}); - - (ref $_ ne 'ARRAY' or !@$_) and $_ = [ -and => $_ ] for ($l, $r); - if (@$l and @$r and $l->[0] eq $r->[0] and $l->[0] =~ /^\-and$/i) { - $fin->{$col} = [ -and => map { @$_[1..$#$_] } ($l, $r) ]; - } - else { - $fin->{$col} = [ -and => $fin->{$col}, $c->{$col} ]; - } + # consolidate all -and nodes + if ($col =~ /^\-and$/i) { + push @{$fin->{-and}}, + ref $c->{$col} eq 'ARRAY' ? @{$c->{$col}} + : ref $c->{$col} eq 'HASH' ? %{$c->{$col}} + : { $col => $c->{$col} } + ; + } + elsif ($col =~ /^\-/) { + push @{$fin->{-and}}, { $col => $c->{$col} }; + } + elsif (exists $fin->{$col}) { + $fin->{$col} = [ -and => map { + (ref $_ eq 'ARRAY' and ($_->[0]||'') =~ /^\-and$/i ) + ? @{$_}[1..$#$_] + : $_ + ; + } ($fin->{$col}, $c->{$col}) ]; } else { $fin->{$col} = $c->{$col}; @@ -1044,75 +1052,90 @@ sub _collapse_cond { } } } + } + elsif (ref $where eq 'ARRAY') { + # we are always at top-level here, it is safe to dump empty *standalone* pieces + my $fin_idx; - # 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') { - $fin->{-or} = $fin->{-or} ? [ $piece, $fin->{-or} ] : $piece; - } - elsif (! exists $fin->{''}) { - $fin->{''} = $piece; + for (my $i = 0; $i <= $#$where; $i++ ) { + + my $logic_mod = lc ( ($where->[$i] =~ /^(\-(?:and|or))$/i)[0] || '' ); + + if ($logic_mod) { + $i++; + $self->throw_exception("Unsupported top-level op/arg pair: [ $logic_mod => $where->[$i] ]") + unless ref $where->[$i] eq 'HASH' or ref $where->[$i] eq 'ARRAY'; + + my $sub_elt = $self->_collapse_cond({ $logic_mod => $where->[$i] }) + or next; + + $fin_idx->{ "SER_" . serialize $sub_elt } = $sub_elt; } - } + elsif (! length ref $where->[$i] ) { + my $sub_elt = $self->_collapse_cond({ @{$where}[$i, $i+1] }) + or next; - # compress same-column conds found in $fin - for my $col ( keys %$fin ) { - next unless ref $fin->{$col} eq 'ARRAY' and ($fin->{$col}[0]||'') eq '-and'; - my $val_bag = { map { - (! defined $_ ) ? ( UNDEF => undef ) - : ( ! ref $_ or is_plain_value $_ ) ? ( "VAL_$_" => $_ ) - : ( ( 'SER_' . serialize $_ ) => $_ ) - } @{$fin->{$col}}[1 .. $#{$fin->{$col}}] }; - - if (keys %$val_bag == 1 ) { - ($fin->{$col}) = values %$val_bag; + $fin_idx->{ "COL_$where->[$i]_" . serialize $sub_elt } = $sub_elt; + $i++; } else { - $fin->{$col} = [ -and => map { $val_bag->{$_} } sort keys %$val_bag ]; + $fin_idx->{ "SER_" . serialize $where->[$i] } = $self->_collapse_cond( $where->[$i] ) || next; } } - return $fin; - } - elsif (ref $where eq 'ARRAY') { - my @w = @$where; + return unless $fin_idx; - while ( @w and ( - (ref $w[0] eq 'ARRAY' and ! @{$w[0]} ) - or - (ref $w[0] eq 'HASH' and ! keys %{$w[0]}) - )) { shift @w }; + $fin = ( keys %$fin_idx == 1 ) ? (values %$fin_idx)[0] : { + -or => [ map + { ref $fin_idx->{$_} eq 'HASH' ? %{$fin_idx->{$_}} : $fin_idx->{$_} } + sort keys %$fin_idx + ] + }; + } + else { + # not a hash not an array + $fin = { '' => $where }; + } - return unless @w; + # unroll single-element -and's + while ( + $fin->{-and} + and + @{$fin->{-and}} < 2 + ) { + my $and = delete $fin->{-and}; + last if @$and == 0; - if ( @w == 1 ) { - return ( length ref $w[0] ) - ? $self->_collapse_cond($w[0]) - : { $w[0] => undef } - ; + # at this point we have @$and == 1 + if ( + ref $and->[0] eq 'HASH' + and + ! grep { exists $fin->{$_} } keys %{$and->[0]} + ) { + $fin = { + %$fin, %{$and->[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') ) - : $self->throw_exception("Unsupported top-level op/arg pair: [ $w[0] => $w[1] ]") - ; - } - else { - return $self->_collapse_cond({ @w }); - } + } + + # compress same-column conds found in $fin + for my $col ( grep { $_ !~ /^\-/ } keys %$fin ) { + next unless ref $fin->{$col} eq 'ARRAY' and ($fin->{$col}[0]||'') =~ /^\-and$/i; + my $val_bag = { map { + (! defined $_ ) ? ( UNDEF => undef ) + : ( ! ref $_ or is_plain_value $_ ) ? ( "VAL_$_" => $_ ) + : ( ( 'SER_' . serialize $_ ) => $_ ) + } @{$fin->{$col}}[1 .. $#{$fin->{$col}}] }; + + if (keys %$val_bag == 1 ) { + ($fin->{$col}) = values %$val_bag; } else { - return { -or => \@w }; + $fin->{$col} = [ -and => map { $val_bag->{$_} } sort keys %$val_bag ]; } } - else { - # not a hash not an array - return { '' => $where }; - } - die 'should not get here'; + return keys %$fin ? $fin : (); } sub _collapse_cond_unroll_pairs {