From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 17 Jul 2014 07:05:19 +0000 (+0200)
Subject: Better, consistent handling of -literal/-value in the cond collapser
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f35ba0fbddfcfe22694f8deff22da4db4f01846;p=dbsrgits%2FDBIx-Class-Historic.git

Better, consistent handling of -literal/-value in the cond collapser
---

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index ae04942..7d974cf 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -1120,25 +1120,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') {
@@ -1208,23 +1219,29 @@ sub _extract_fixed_condition_columns {
       $vals->{$undef_marker} = $v if $consider_nulls
     }
     elsif (
-      ! length ref $v
-        or
-      is_plain_value ($v)
-    ) {
-      $vals->{$v} = $v;
-    }
-    elsif (
       ref $v eq 'HASH'
         and
       keys %$v == 1
-        and
-      ref $v->{'='}
-        and
+    ) {
+      if (exists $v->{-value}) {
+        if (defined $v->{-value}) {
+          $vals->{$v->{-value}} = $v->{-value}
+        }
+        elsif( $consider_nulls ) {
+          $vals->{$undef_marker} = $v->{-value};
+        }
+      }
       # do not need to check for plain values - _collapse_cond did it for us
-      is_literal_value($v->{'='})
+      elsif(ref $v->{'='} and is_literal_value($v->{'='}) ) {
+        $vals->{$v->{'='}} = $v->{'='};
+      }
+    }
+    elsif (
+      ! length ref $v
+        or
+      is_plain_value ($v)
     ) {
-      $vals->{$v->{'='}} = $v->{'='};
+      $vals->{$v} = $v;
     }
     elsif (ref $v eq 'ARRAY' and ($v->[0]||'') eq '-and') {
       for ( @{$v}[1..$#$v] ) {
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index a7c1b50..a77f8a3 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -172,6 +172,8 @@ sub is_literal_value ($) {
   (
     ref $_[0] eq 'SCALAR'
       or
+    ( ref $_[0] eq 'HASH' and keys %{$_[0]} == 1 and defined $_[0]->{-ident} and ! length ref $_[0]->{-ident} )
+      or
     ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' )
   ) ? 1 : 0;
 }
diff --git a/t/72pg.t b/t/72pg.t
index 6e1ca7d..c02a5e3 100644
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -7,6 +7,7 @@ use Sub::Name;
 use DBIx::Class::Optional::Dependencies ();
 use lib qw(t/lib);
 use DBICTest;
+use DBIx::Class::_Util 'is_literal_value';
 
 plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_pg')
   unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_pg');
@@ -291,7 +292,10 @@ for my $use_insert_returning ($test_server_supports_insert_returning
       { -value => [3,4] },
       \[ '= ?' => [arrayfield => [3, 4]] ],
     ) {
-      local $TODO = 'No introspection of complex conditions :(';
+      local $TODO = 'No introspection of complex literal conditions :('
+        if is_literal_value $cond;
+
+
       my $arr_rs_cond = $arr_rs->search({ arrayfield => $cond });
 
       my $row = $arr_rs_cond->create({});
diff --git a/t/sqlmaker/dbihacks_internals.t b/t/sqlmaker/dbihacks_internals.t
index 66f0148..84abaf1 100644
--- a/t/sqlmaker/dbihacks_internals.t
+++ b/t/sqlmaker/dbihacks_internals.t
@@ -5,7 +5,7 @@ use Test::Warn;
 
 use lib qw(t/lib);
 use DBICTest ':DiffSQL';
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION modver_gt_or_eq);
 
 use Data::Dumper;
 
@@ -131,6 +131,36 @@ for my $t (
     sql => 'WHERE ( _macro.to LIKE ? OR _wc_macros.to LIKE ? ) AND group.is_active = ? AND me.is_active = ?',
     efcc_result => { 'group.is_active' => 1, 'me.is_active' => 1 },
   },
+
+  # need fixed SQLA to correctly work with this
+  #
+  ( modver_gt_or_eq('SQL::Abstract', '1.78_01') ? {
+    where => { -and => [
+      artistid => { -value => [1] },
+      charfield => { -ident => 'foo' },
+      name => { '=' => { -value => undef } },
+      rank => { '=' => { -ident => 'bar' } },
+    ] },
+    sql => 'WHERE artistid = ? AND charfield = foo AND name IS NULL AND rank = bar',
+    cc_result => {
+      artistid => { -value => [1] },
+      name => undef,
+      charfield => { '=', { -ident => 'foo' } },
+      rank => { '=' => { -ident => 'bar' } },
+    },
+    efcc_result => {
+      artistid => [1],
+      charfield => { -ident => 'foo' },
+      rank => { -ident => 'bar' },
+    },
+    efcc_n_result => {
+      artistid => [1],
+      name => undef,
+      charfield => { -ident => 'foo' },
+      rank => { -ident => 'bar' },
+    },
+  } : () ),
+
   {
     where => { artistid => [] },
     cc_result => { artistid => [] },