Switch to a sane deduplication system
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm
index ae04942..f21759c 100644 (file)
@@ -15,8 +15,8 @@ use mro 'c3';
 
 use List::Util 'first';
 use Scalar::Util 'blessed';
-use Sub::Name 'subname';
-use DBIx::Class::_Util qw(is_plain_value is_literal_value UNRESOLVABLE_CONDITION);
+use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION serialize);
+use SQL::Abstract qw(is_plain_value is_literal_value);
 use namespace::clean;
 
 #
@@ -111,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 (
@@ -998,17 +998,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;
       }
     }
 
@@ -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') )
@@ -1103,7 +1104,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);
@@ -1120,25 +1121,36 @@ sub _collapse_cond_unroll_pairs {
       if (ref $rhs eq 'HASH' and ! keys %$rhs) {
         # FIXME - SQLA seems to be doing... nothing...?
       }
+      elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-ident}) {
+        push @conds, { $lhs => { '=', $rhs } };
+      }
+      elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-value} and is_plain_value $rhs->{-value}) {
+        push @conds, { $lhs => $rhs->{-value} };
+      }
       elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{'='}) {
-        for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) {
-
-          # extra sanity check
-          if (keys %$p > 1) {
-            require Data::Dumper::Concise;
-            local $Data::Dumper::Deepcopy = 1;
-            $self->throw_exception(
-              "Internal error: unexpected collapse unroll:"
-            . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p }
-            );
-          }
+        if( is_literal_value $rhs->{'='}) {
+          push @conds, { $lhs => $rhs };
+        }
+        else {
+          for my $p ($self->_collapse_cond_unroll_pairs([ $lhs => $rhs->{'='} ])) {
+
+            # extra sanity check
+            if (keys %$p > 1) {
+              require Data::Dumper::Concise;
+              local $Data::Dumper::Deepcopy = 1;
+              $self->throw_exception(
+                "Internal error: unexpected collapse unroll:"
+              . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p }
+              );
+            }
 
-          my ($l, $r) = %$p;
+            my ($l, $r) = %$p;
 
-          push @conds, ( ! length ref $r or is_plain_value($r) )
-            ? { $l => $r }
-            : { $l => { '=' => $r } }
-          ;
+            push @conds, ( ! length ref $r or is_plain_value($r) )
+              ? { $l => $r }
+              : { $l => { '=' => $r } }
+            ;
+          }
         }
       }
       elsif (ref $rhs eq 'ARRAY') {
@@ -1152,18 +1164,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 };
           }
         }
         elsif (@$rhs == 1) {
-          unshift @$pairs, [ $lhs => $rhs->[0] ];
+          unshift @$pairs, $lhs => $rhs->[0];
         }
         else {
           push @conds, { $lhs => $rhs };
@@ -1194,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]);
@@ -1205,38 +1216,48 @@ sub _extract_fixed_condition_columns {
     my $vals;
 
     if (!defined ($v = $where_hash->{$c}) ) {
-      $vals->{$undef_marker} = $v if $consider_nulls
-    }
-    elsif (
-      ! length ref $v
-        or
-      is_plain_value ($v)
-    ) {
-      $vals->{$v} = $v;
+      $vals->{UNDEF} = $v if $consider_nulls
     }
     elsif (
       ref $v eq 'HASH'
         and
       keys %$v == 1
-        and
-      ref $v->{'='}
-        and
+    ) {
+      if (exists $v->{-value}) {
+        if (defined $v->{-value}) {
+          $vals->{"VAL_$v->{-value}"} = $v->{-value}
+        }
+        elsif( $consider_nulls ) {
+          $vals->{UNDEF} = $v->{-value};
+        }
+      }
       # do not need to check for plain values - _collapse_cond did it for us
-      is_literal_value($v->{'='})
+      elsif(length ref $v->{'='} and is_literal_value($v->{'='}) ) {
+        $vals->{ 'SER_' . serialize $v->{'='} } = $v->{'='};
+      }
+    }
+    elsif (
+      ! length ref $v
+        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;