Adjust things for the is_literal_value and -ident SQLA 1.80 fixes

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index f13be43..29b7f13 100644 (file)
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -416,7 +416,7 @@ sub _resolve_aliastypes_from_select_args {
   # generate sql chunks
   my $to_scan = {
     restricting => [
-      $sql_maker->_recurse_where ($attrs->{where}),
+      ($sql_maker->_recurse_where ($attrs->{where}))[0],
       $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }),
     ],
     grouping => [
@@ -1083,20 +1083,57 @@ sub _collapse_cond {
       }
     }
 
-    return unless $fin_idx;
+    if (! $fin_idx) {
+      return;
+    }
+    elsif ( keys %$fin_idx == 1 ) {
+      $fin = (values %$fin_idx)[0];
+    }
+    else {
+      my @or;
+
+      # at this point everything is at most one level deep - unroll if needed
+      for (sort keys %$fin_idx) {
+        if ( ref $fin_idx->{$_} eq 'HASH' and keys %{$fin_idx->{$_}} == 1 ) {
+          my ($l, $r) = %{$fin_idx->{$_}};
+
+          if (
+            ref $r eq 'ARRAY'
+              and
+            (
+              ( @$r == 1 and $l =~ /^\-and$/i )
+                or
+              $l =~ /^\-or$/i
+            )
+          ) {
+            push @or, @$r
+          }
 
-    $fin = ( keys %$fin_idx == 1 ) ? (values %$fin_idx)[0] : {
-      -or => [ map {
-        # unroll single-element hashes
-        ( ref $fin_idx->{$_} eq 'HASH' and keys %{$fin_idx->{$_}} == 1 )
-          ? %{$fin_idx->{$_}}
-          : $fin_idx->{$_}
-      } sort keys %$fin_idx ]
-    };
+          elsif (
+            ref $r eq 'HASH'
+              and
+            keys %$r == 1
+              and
+            $l =~ /^\-(?:and|or)$/i
+          ) {
+            push @or, %$r;
+          }
+
+          else {
+            push @or, $l, $r;
+          }
+        }
+        else {
+          push @or, $fin_idx->{$_};
+        }
+      }
+
+      $fin->{-or} = \@or;
+    }
   }
   else {
     # not a hash not an array
-    $fin = { '' => $where };
+    $fin = { -and => [ $where ] };
   }
 
   # unroll single-element -and's
@@ -1118,14 +1155,18 @@ sub _collapse_cond {
         %$fin, %{$and->[0]}
       };
     }
+    else {
+      $fin->{-and} = $and;
+      last;
+    }
   }
 
   # 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_$_" => $_ )
+      (! defined $_ )                          ? ( UNDEF => undef )
+    : ( ! length ref $_ or is_plain_value $_ ) ? ( "VAL_$_" => $_ )
     : ( ( 'SER_' . serialize $_ ) => $_ )
     } @{$fin->{$col}}[1 .. $#{$fin->{$col}}] };
 
@@ -1163,6 +1204,7 @@ sub _collapse_cond_unroll_pairs {
       if (ref $rhs eq 'HASH' and ! keys %$rhs) {
         # FIXME - SQLA seems to be doing... nothing...?
       }
+      # normalize top level -ident, for saner extract_fixed_condition_columns code
       elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-ident}) {
         push @conds, { $lhs => { '=', $rhs } };
       }
@@ -1170,7 +1212,7 @@ sub _collapse_cond_unroll_pairs {
         push @conds, { $lhs => $rhs->{-value} };
       }
       elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{'='}) {
-        if( is_literal_value $rhs->{'='}) {
+        if ( length ref $rhs->{'='} and is_literal_value $rhs->{'='} ) {
           push @conds, { $lhs => $rhs };
         }
         else {
@@ -1188,7 +1230,14 @@ sub _collapse_cond_unroll_pairs {
 
             my ($l, $r) = %$p;
 
-            push @conds, ( ! length ref $r or is_plain_value($r) )
+            push @conds, (
+              ! length ref $r
+                or
+              # the unroller recursion may return a '=' prepended value already
+              ref $r eq 'HASH' and keys %$rhs == 1 and exists $rhs->{'='}
+                or
+              is_plain_value($r)
+            )
               ? { $l => $r }
               : { $l => { '=' => $r } }
             ;
@@ -1223,6 +1272,18 @@ sub _collapse_cond_unroll_pairs {
           push @conds, { $lhs => $rhs };
         }
       }
+      # unroll func + { -value => ... }
+      elsif (
+        ref $rhs eq 'HASH'
+          and
+        ( my ($subop) = keys %$rhs ) == 1
+          and
+        length ref ((values %$rhs)[0])
+          and
+        my $vref = is_plain_value( (values %$rhs)[0] )
+      ) {
+        push @conds, { $lhs => { $subop => $$vref } }
+      }
       else {
         push @conds, { $lhs => $rhs };
       }
@@ -1274,7 +1335,15 @@ sub _extract_fixed_condition_columns {
         }
       }
       # do not need to check for plain values - _collapse_cond did it for us
-      elsif(length ref $v->{'='} and is_literal_value($v->{'='}) ) {
+      elsif(
+        length ref $v->{'='}
+          and
+        (
+          ( ref $v->{'='} eq 'HASH' and keys %{$v->{'='}} == 1 and exists $v->{'='}{-ident} )
+            or
+          is_literal_value($v->{'='})
+        )
+       ) {
         $vals->{ 'SER_' . serialize $v->{'='} } = $v->{'='};
       }
     }