From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 1 Nov 2013 06:59:31 +0000 (+0000)
Subject: add double subquery handling to MySQL code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=944c72bcfdce01071f01f0179ebbf3b99630d5a1;p=dbsrgits%2FData-Query.git

add double subquery handling to MySQL code
---

diff --git a/lib/Data/Query/Renderer/SQL/MySQL.pm b/lib/Data/Query/Renderer/SQL/MySQL.pm
index 9120e0f..116bbb2 100644
--- a/lib/Data/Query/Renderer/SQL/MySQL.pm
+++ b/lib/Data/Query/Renderer/SQL/MySQL.pm
@@ -1,5 +1,24 @@
 package Data::Query::Renderer::SQL::MySQL;
 
+sub map_descending (&;@) {
+  my ($block, $in) = @_;
+  local $_ = $in;
+  $_ = $block->($_) if ref($_) eq 'HASH';
+  if (ref($_) eq 'REF' and ref($$_) eq 'HASH') {
+    $$_;
+  } elsif (ref($_) eq 'HASH') {
+    my $mapped = $_;
+    local $_;
+    +{ map +($_ => &map_descending($block, $mapped->{$_})), keys %$mapped };
+  } elsif (ref($_) eq 'ARRAY') {
+    [ map &map_descending($block, $_), @$_ ]
+  } else {
+    $_
+  }
+}
+
+use Data::Query::Constants;
+use Data::Query::ExprHelpers;
 use Moo;
 
 extends 'Data::Query::Renderer::SQL::Naive';
@@ -11,4 +30,52 @@ sub _insert_default_values {
   $self->_format_keyword('VALUES'), qw( ( ) );
 }
 
+foreach my $type (qw(update delete)) {
+  around "_render_${type}" => sub {
+    my ($orig, $self) = (shift, shift);
+    $self->$orig($self->_maybe_double_subquery(@_));
+  };
+}
+
+sub _maybe_double_subquery {
+  my ($self, $dq) = @_;
+  my $target = $dq->{target};
+  my $new = { %$dq };
+  foreach my $key (qw(set where)) {
+    next unless $dq->{$key};
+    $new->{$key} = map_descending {
+      if (is_Select) {
+        my $found;
+        scan_dq_nodes(do {
+          if (is_Identifier($target)) {
+            my $ident = $target->{elements}[0];
+            +{ DQ_IDENTIFIER ,=> sub {
+                 my @el = @{$_[0]->{elements}};
+                 $found = 1 if @el == 1 and $el[0] eq $ident;
+               }
+            };
+          } elsif (is_Literal($target)) {
+            my $ident = $target->{literal} or die "Can't handle complex literal";
+            +{ DQ_LITERAL ,=> sub {
+                 my $lit = $_[0]->{literal};
+                 $found = 1 if $lit and $lit eq $ident;
+               }
+            };
+          } else {
+            die "Can't handle target type ".$target->{type};
+          }
+        }, $_);
+        if ($found) {
+          \Select([ Identifier('*') ], Alias('_forced_double_subquery', $_));
+        } else {
+          $_
+        }
+      } else {
+        $_
+      }
+    } $dq->{$key};
+  }
+  $new;
+}
+
 1;