From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 17 Nov 2013 01:38:54 +0000 (+0000)
Subject: factor out _extract_top_level_conditions and use it to rewrite _stack_cond
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f7e656eae6ef339f4966c4f02ae033e4ac60c83;p=dbsrgits%2FDBIx-Class.git

factor out _extract_top_level_conditions and use it to rewrite _stack_cond
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 615723a..4ff25f7 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -8,7 +8,7 @@ use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken reftype/;
 use DBIx::Class::_Util 'fail_on_internal_wantarray';
 use Try::Tiny;
-use Data::Compare (); # no imports!!! guard against insane architecture
+use Data::Dumper::Concise ();
 use Data::Query::Constants;
 use Data::Query::ExprHelpers;
 # not importing first() as it will clash with our own method
@@ -590,60 +590,19 @@ sub _normalize_selection {
 sub _stack_cond {
   my ($self, $left, $right) = @_;
 
-  # collapse single element top-level conditions
-  # (single pass only, unlikely to need recursion)
-  for ($left, $right) {
-    if (ref $_ eq 'ARRAY') {
-      if (@$_ == 0) {
-        $_ = undef;
-      }
-      elsif (@$_ == 1) {
-        $_ = $_->[0];
-      }
-    }
-    elsif (ref $_ eq 'HASH') {
-      my ($first, $more) = keys %$_;
-
-      # empty hash
-      if (! defined $first) {
-        $_ = undef;
-      }
-      # one element hash
-      elsif (! defined $more) {
-        if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
-          $_ = $_->{'-and'};
-        }
-        elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
-          $_ = $_->{'-or'};
-        }
-      }
-    }
-  }
+  my $source = $self->result_source;
 
-  # merge hashes with weeding out of duplicates (simple cases only)
-  if (ref $left eq 'HASH' and ref $right eq 'HASH') {
+  my $converter = $source->schema->storage->sql_maker->converter;
 
-    # shallow copy to destroy
-    $right = { %$right };
-    for (grep { exists $right->{$_} } keys %$left) {
-      # the use of eq_deeply here is justified - the rhs of an
-      # expression can contain a lot of twisted weird stuff
-      delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
-    }
+  my @top = map $source->_extract_top_level_conditions(
+    $converter->_expr_to_dq($_)
+  ), grep defined, $left, $right;
 
-    $right = undef unless keys %$right;
-  }
+  return undef unless @top;
 
+  my %top = map +(Data::Dumper::Concise::Dumper($_) => $_), @top;
 
-  if (defined $left xor defined $right) {
-    return defined $left ? $left : $right;
-  }
-  elsif (! defined $left) {
-    return undef;
-  }
-  else {
-    return { -and => [ $left, $right ] };
-  }
+  return \Operator({ 'SQL.Naive' => 'AND' }, [ values %top ]);
 }
 
 =head2 search_literal
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index c1a0b0f..3e1339b 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1554,30 +1554,48 @@ sub _extract_fixed_values_for {
 sub _extract_fixed_conditions_for {
   my ($self, $dq, $alias) = @_;
   my (@q, %found) = ($dq);
-  while (my $n = shift @q) {
-    if (is_Operator($n)) {
-      if (($n->{operator}{Perl}||'') =~ /^(?:==|eq)$/) {
-        my ($l, $r) = @{$n->{args}};
-        if (
-          is_Identifier($r) and @{$r->{elements}} == 2
-          and (!$alias or $r->{elements}[0] eq $alias)
-        ) {
-          ($l, $r) = ($r, $l);
-        }
-        if (
-          is_Identifier($l) and @{$l->{elements}} == 2
-          and (!$alias or $l->{elements}[0] eq $alias)
-        ) {
-          $found{$l->{elements}[1]} = $r;
-        } elsif (($n->{operator}{Perl}||'') eq 'and') {
-          push @q, @{$n->{args}};
-        }
+  foreach my $n ($self->_extract_top_level_conditions($dq)) {
+    if (
+      is_Operator($n)
+      and (
+        ($n->{operator}{Perl}||'') =~ /^(?:==|eq)$/
+        or ($n->{operator}{'SQL.Naive'}||'') eq '='
+     )
+    ) {
+      my ($l, $r) = @{$n->{args}};
+      if (
+        is_Identifier($r) and @{$r->{elements}} == 2
+        and (!$alias or $r->{elements}[0] eq $alias)
+      ) {
+        ($l, $r) = ($r, $l);
+      }
+      if (
+        is_Identifier($l) and @{$l->{elements}} == 2
+        and (!$alias or $l->{elements}[0] eq $alias)
+      ) {
+        $found{$l->{elements}[1]} = $r;
       }
     }
   }
   return \%found;
 }
 
+sub _extract_top_level_conditions {
+  my ($self, $dq) = @_;
+  my (@q, @found) = ($dq);
+  while (my $n = shift @q) {
+    if (
+      is_Operator($n)
+      and ($n->{operator}{Perl}||$n->{operator}{'SQL.Naive'}||'') =~ /^and$/i
+    ) {
+      push @q, @{$n->{args}};
+    } else {
+      push @found, $n;
+    }
+  }
+  return @found;
+}
+
 sub compare_relationship_keys {
   carp 'compare_relationship_keys is a private method, stop calling it';
   my $self = shift;