clean up FetchFirst more

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

package Data::Query::Renderer::SQL::Slice::FetchFirst;

use List::Util qw(reduce);
use Data::Query::ExprHelpers;
use Moo::Role;

sub _render_slice_limit {
  my ($self, $dq) = @_;
  return [
    ($dq->{from} ? $self->_render($dq->{from}) : ()),
    $self->_format_keyword('FETCH FIRST'),
    sprintf("%i", $dq->{limit}{value}),
    $self->_format_keyword('ROWS ONLY')
  ];
}

sub _slice_type { 'FetchFirst' }

sub _render_slice {
  my ($self, $dq) = @_;
  unless ($dq->{offset}) {
    return $self->_render_slice_limit($dq);
  }
  unless ($dq->{order_is_stable}) {
    die $self->_slice_type." limit style requires a stable order";
  }
  die "Slice's inner is not a Select"
    unless is_Select my $orig_select = $dq->{from};
  my %alias_map;
  my $gensym_count;
  my (@inside_select_list, @outside_select_list);
  my $default_inside_alias;
  SELECT: foreach my $s (@{$orig_select->{select}}) {
    my $name;
    if (is_Alias $s) {
      $name = $s->{to};
      $s = $s->{from};
    }
    my $key;
    if (is_Identifier $s) {
      if (!$name and @{$s->{elements}} == 2) {
        $default_inside_alias ||= $s->{elements}[0];
        if ($s->{elements}[0] eq $default_inside_alias) {
          $alias_map{join('.',@{$s->{elements}})} = $s;
          push @inside_select_list, $s;
          push @outside_select_list, $s;
          next SELECT;
        }
      }
      $name ||= join('__', @{$s->{elements}});
      $key = join('.', @{$s->{elements}});
    } else {
      die "XXX not implemented yet" unless $name;
      $key = "$s";
    }
    $name ||= sprintf("GENSYM__%03i",++$gensym_count);
    push @inside_select_list, Alias($name, $s);
    push @outside_select_list, $alias_map{$key} = Identifier($name);
  }
  my $order = $orig_select->{from};
  my $order_gensym_count;
  die "Slice's Select not followed by Order but order_is_stable set"
    unless is_Order $order;
  my (@order_nodes, %order_map);
  while (is_Order $order) {
    my $by = $order->{by};
    if (is_Identifier $by) {
      $default_inside_alias ||= $by->{elements}[0]
        if @{$by->{elements}} == 2;
      $order_map{$by}
        = $alias_map{join('.', @{$by->{elements}})}
          ||= do {
                if (
                  @{$by->{elements}} == 2
                  and $by->{elements}[0] eq $default_inside_alias
                ) {
                  $by;
                } else {
                  my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count);
                  push @inside_select_list, Alias($name, $by);
                  Identifier($name);
                }
              };
    } else {
      die "XXX not implemented yet";
    }
    push @order_nodes, $order;
    $order = $order->{from};
  }
  my $inside_order = reduce {
    Order($b->{by}, $b->{reverse}, $a)
  } $order, reverse @order_nodes;
  my $inside_select = Select(\@inside_select_list, $inside_order);
  my $limit_plus_offset = +{
    %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value}
  };
  $default_inside_alias ||= 'me';
  my $bridge_from = Alias(
    $default_inside_alias,
    Slice(undef, $limit_plus_offset, $inside_select)
  );
  my $outside_order = reduce {
    Order($order_map{$b->{by}}, !$b->{reverse}, $a)
  } $bridge_from, reverse @order_nodes;
  my $outside_select = Select(
    (
      $dq->{preserve_order}
        ? [
            @outside_select_list,
            grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes}
          ]
        : \@outside_select_list,
    ),
    $outside_order,
  );
  my $final = Slice(undef, $dq->{limit}, $outside_select);
  if ($dq->{preserve_order}) {
    $final = Select(
      \@outside_select_list,
      reduce {
        Order($order_map{$b->{by}}, $b->{reverse}, $a)
      } Alias($default_inside_alias, $final), reverse @order_nodes
    );
  }
  return $self->_render($final);
}

1;