Normalize _parse_rs_attrs - no functional changes

[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 29b7f13..b0dfe43 100644 (file)
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -17,6 +17,7 @@ use List::Util 'first';
 use Scalar::Util 'blessed';
 use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION serialize);
 use SQL::Abstract qw(is_plain_value is_literal_value);
+use DBIx::Class::Carp;
 use namespace::clean;
 
 #
@@ -429,46 +430,40 @@ sub _resolve_aliastypes_from_select_args {
       ),
     ],
     selecting => [
-      map { ($sql_maker->_recurse_fields($_))[0] } @{$attrs->{select}},
+      # kill all selectors which look like a proper subquery
+      # this is a sucky heuristic *BUT* - if we get it wrong the query will simply
+      # fail to run, so we are relatively safe
+      grep
+        { $_ !~ / \A \s* \( \s* SELECT \s+ .+? \s+ FROM \s+ .+? \) \s* \z /xsi }
+        map
+          { ($sql_maker->_recurse_fields($_))[0] }
+          @{$attrs->{select}}
     ],
     ordering => [
       map { $_->[0] } $self->_extract_order_criteria ($attrs->{order_by}, $sql_maker),
     ],
   };
 
-  # throw away empty chunks and all 2-value arrayrefs: the thinking is that these are
-  # bind value specs left in by the sloppy renderer above. It is ok to do this
-  # at this point, since we are going to end up rewriting this crap anyway
-  for my $v (values %$to_scan) {
-    my @nv;
-    for (@$v) {
-      next if (
-        ! defined $_
-          or
-        (
-          ref $_ eq 'ARRAY'
-            and
-          ( @$_ == 0 or @$_ == 2 )
-        )
-      );
+  # throw away empty-string chunks, and make sure no binds snuck in
+  # note that we operate over @{$to_scan->{$type}}, hence the
+  # semi-mindbending ... map ... for values ...
+  ( $_ = [ map {
 
-      if (ref $_) {
-        require Data::Dumper::Concise;
-        $self->throw_exception("Unexpected ref in scan-plan: " . Data::Dumper::Concise::Dumper($v) );
-      }
+      (not $_)        ? ()
+    : (length ref $_) ? (require Data::Dumper::Concise && $self->throw_exception(
+                          "Unexpected ref in scan-plan: " . Data::Dumper::Concise::Dumper($_)
+                        ))
+    :                   $_
 
-      push @nv, $_;
-    }
+  } @$_ ] ) for values %$to_scan;
 
-    $v = \@nv;
-  }
+  # throw away empty to-scan's
+  (
+    @{$to_scan->{$_}}
+      or
+    delete $to_scan->{$_}
+  ) for keys %$to_scan;
 
-  # kill all selectors which look like a proper subquery
-  # this is a sucky heuristic *BUT* - if we get it wrong the query will simply
-  # fail to run, so we are relatively safe
-  $to_scan->{selecting} = [ grep {
-    $_ !~ / \A \s* \( \s* SELECT \s+ .+? \s+ FROM \s+ .+? \) \s* \z /xsi
-  } @{ $to_scan->{selecting} || [] } ];
 
   # first see if we have any exact matches (qualified or unqualified)
   for my $type (keys %$to_scan) {
@@ -1000,13 +995,29 @@ sub _collapse_cond {
       my $chunk = shift @pieces;
 
       if (ref $chunk eq 'HASH') {
-        push @pairs, map { $_ => $chunk->{$_} } sort keys %$chunk;
+        for (sort keys %$chunk) {
+
+          # Match SQLA 1.79 behavior
+          if ($_ eq '') {
+            is_literal_value($chunk->{$_})
+              ? carp 'Hash-pairs consisting of an empty string with a literal are deprecated, use -and => [ $literal ] instead'
+              : $self->throw_exception("Supplying an empty left hand side argument is not supported in hash-pairs")
+            ;
+          }
+
+          push @pairs, $_ => $chunk->{$_};
+        }
       }
       elsif (ref $chunk eq 'ARRAY') {
         push @pairs, -or => $chunk
           if @$chunk;
       }
       elsif ( ! length ref $chunk) {
+
+        # Match SQLA 1.79 behavior
+        $self->throw_exception("Supplying an empty left hand side argument is not supported in array-pairs")
+          if $where_is_anded_array and (! defined $chunk or $chunk eq '');
+
         push @pairs, $chunk, shift @pieces;
       }
       else {
@@ -1059,6 +1070,11 @@ sub _collapse_cond {
 
     for (my $i = 0; $i <= $#$where; $i++ ) {
 
+      # Match SQLA 1.79 behavior
+      $self->throw_exception(
+        "Supplying an empty left hand side argument is not supported in array-pairs"
+      ) if (! defined $where->[$i] or ! length $where->[$i]);
+
       my $logic_mod = lc ( ($where->[$i] =~ /^(\-(?:and|or))$/i)[0] || '' );
 
       if ($logic_mod) {
@@ -1069,7 +1085,13 @@ sub _collapse_cond {
         my $sub_elt = $self->_collapse_cond({ $logic_mod => $where->[$i] })
           or next;
 
-        $fin_idx->{ "SER_" . serialize $sub_elt } = $sub_elt;
+        my @keys = keys %$sub_elt;
+        if ( @keys == 1 and $keys[0] !~ /^\-/ ) {
+          $fin_idx->{ "COL_$keys[0]_" . serialize $sub_elt } = $sub_elt;
+        }
+        else {
+          $fin_idx->{ "SER_" . serialize $sub_elt } = $sub_elt;
+        }
       }
       elsif (! length ref $where->[$i] ) {
         my $sub_elt = $self->_collapse_cond({ @{$where}[$i, $i+1] })