add double subquery handling to MySQL code

[dbsrgits/Data-Query.git] / lib / Data / Query / Renderer / SQL / MySQL.pm

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';

with 'Data::Query::Renderer::SQL::Slice::LimitXY';

sub _insert_default_values {
  my ($self) = @_;
  $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;