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=ef890921d6c179e3715a0ea165bfddc459c81126;hpb=b5ce6748f58040ca877fd05e8f004b14d46b2ba9;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index ef89092..da09d12 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -15,8 +15,7 @@ use mro 'c3';
 
 use List::Util 'first';
 use Scalar::Util 'blessed';
-use Sub::Name 'subname';
-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;
 
@@ -112,8 +111,8 @@ sub _adjust_select_args_for_complex_prefetch {
   my $outer_attrs = { %$attrs };
   delete @{$outer_attrs}{qw(from bind rows offset group_by _grouped_by_distinct having)};
 
-  my $inner_attrs = { %$attrs };
-  delete @{$inner_attrs}{qw(for collapse select as _related_results_construction)};
+  my $inner_attrs = { %$attrs, _simple_passthrough_construction => 1 };
+  delete @{$inner_attrs}{qw(for collapse select as)};
 
   # there is no point of ordering the insides if there is no limit
   delete $inner_attrs->{order_by} if (
@@ -987,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;
   }
@@ -999,17 +1000,17 @@ sub _collapse_cond {
       my $chunk = shift @pieces;
 
       if (ref $chunk eq 'HASH') {
-        push @pairs, map { [ $_ => $chunk->{$_} ] } sort keys %$chunk;
+        push @pairs, map { $_ => $chunk->{$_} } sort keys %$chunk;
       }
       elsif (ref $chunk eq 'ARRAY') {
-        push @pairs, [ -or => $chunk ]
+        push @pairs, -or => $chunk
           if @$chunk;
       }
-      elsif ( ! ref $chunk) {
-        push @pairs, [ $chunk, shift @pieces ];
+      elsif ( ! length ref $chunk) {
+        push @pairs, $chunk, shift @pieces;
       }
       else {
-        push @pairs, [ '', $chunk ];
+        push @pairs, '', $chunk;
       }
     }
 
@@ -1019,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] eq '-and') {
-              $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};
@@ -1045,57 +1052,90 @@ sub _collapse_cond {
         }
       }
     }
-
-    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;
-      }
-    }
-
-    return $fin;
   }
   elsif (ref $where eq 'ARRAY') {
-    my @w = @$where;
+    # we are always at top-level here, it is safe to dump empty *standalone* pieces
+    my $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 };
+    for (my $i = 0; $i <= $#$where; $i++ ) {
 
-    return unless @w;
+      my $logic_mod = lc ( ($where->[$i] =~ /^(\-(?:and|or))$/i)[0] || '' );
 
-    if ( @w == 1 ) {
-      return ( ref $w[0] )
-        ? $self->_collapse_cond($w[0])
-        : { $w[0] => undef }
-      ;
-    }
-    elsif ( @w == 2 and ! 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] ]")
-        ;
+      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;
+
+        $fin_idx->{ "COL_$where->[$i]_" . serialize $sub_elt } = $sub_elt;
+        $i++;
       }
       else {
-        return $self->_collapse_cond({ @w });
+        $fin_idx->{ "SER_" . serialize $where->[$i] } = $self->_collapse_cond( $where->[$i] ) || next;
       }
     }
-    else {
-      return { -or => \@w };
-    }
+
+    return unless $fin_idx;
+
+    $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
-    return { '' => $where };
+    $fin = { '' => $where };
+  }
+
+  # unroll single-element -and's
+  while (
+    $fin->{-and}
+      and
+    @{$fin->{-and}} < 2
+  ) {
+    my $and = delete $fin->{-and};
+    last if @$and == 0;
+
+    # at this point we have @$and == 1
+    if (
+      ref $and->[0] eq 'HASH'
+        and
+      ! grep { exists $fin->{$_} } keys %{$and->[0]}
+    ) {
+      $fin = {
+        %$fin, %{$and->[0]}
+      };
+    }
+  }
+
+  # 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 {
+      $fin->{$col} = [ -and => map { $val_bag->{$_} } sort keys %$val_bag ];
+    }
   }
 
-  die 'should not get here';
+  return keys %$fin ? $fin : ();
 }
 
 sub _collapse_cond_unroll_pairs {
@@ -1104,7 +1144,7 @@ sub _collapse_cond_unroll_pairs {
   my @conds;
 
   while (@$pairs) {
-    my ($lhs, $rhs) = @{ shift @$pairs };
+    my ($lhs, $rhs) = splice @$pairs, 0, 2;
 
     if ($lhs eq '') {
       push @conds, $self->_collapse_cond($rhs);
@@ -1132,7 +1172,7 @@ sub _collapse_cond_unroll_pairs {
           push @conds, { $lhs => $rhs };
         }
         else {
-          for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) {
+          for my $p ($self->_collapse_cond_unroll_pairs([ $lhs => $rhs->{'='} ])) {
 
             # extra sanity check
             if (keys %$p > 1) {
@@ -1164,18 +1204,18 @@ sub _collapse_cond_unroll_pairs {
             if  @$rhs == 1;
 
           if( $rhs->[0] =~ /^\-and$/i ) {
-            unshift @$pairs, map { [ $lhs => $_ ] } @{$rhs}[1..$#$rhs];
+            unshift @$pairs, map { $lhs => $_ } @{$rhs}[1..$#$rhs];
           }
           # if not an AND then it's an OR
           elsif(@$rhs == 2) {
-            unshift @$pairs, [ $lhs => $rhs->[1] ];
+            unshift @$pairs, $lhs => $rhs->[1];
           }
           else {
-            push @conds, { $lhs => $rhs };
+            push @conds, { $lhs => [ @{$rhs}[1..$#$rhs] ] };
           }
         }
         elsif (@$rhs == 1) {
-          unshift @$pairs, [ $lhs => $rhs->[0] ];
+          unshift @$pairs, $lhs => $rhs->[0];
         }
         else {
           push @conds, { $lhs => $rhs };
@@ -1206,7 +1246,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]);
@@ -1217,7 +1256,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'
@@ -1226,15 +1265,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 (
@@ -1242,19 +1281,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;