lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm

   1 package Data::Query::Renderer::SQL::Slice::FetchFirst;
   2
   3 use List::Util qw(reduce);
   4 use Data::Query::ExprHelpers;
   5 use Moo::Role;
   6
   7 sub _render_slice_limit {
   8   my ($self, $dq) = @_;
   9   return [
  10     ($dq->{from} ? $self->_render($dq->{from}) : ()),
  11     $self->_format_keyword('FETCH FIRST'),
  12     sprintf("%i", $dq->{limit}{value}),
  13     $self->_format_keyword('ROWS ONLY')
  14   ];
  15 }
  16
  17 sub _slice_type { 'FetchFirst' }
  18
  19 sub _render_slice {
  20   my ($self, $dq) = @_;
  21   unless ($dq->{offset}) {
  22     return $self->_render_slice_limit($dq);
  23   }
  24   unless ($dq->{order_is_stable}) {
  25     die $self->_slice_type." limit style requires a stable order";
  26   }
  27   die "Slice's inner is not a Select"
  28     unless is_Select my $orig_select = $dq->{from};
  29   my %alias_map;
  30   my $gensym_count;
  31   my (@inside_select_list, @outside_select_list);
  32   my $default_inside_alias;
  33   SELECT: foreach my $s (@{$orig_select->{select}}) {
  34     my $name;
  35     if (is_Alias $s) {
  36       $name = $s->{to};
  37       $s = $s->{from};
  38     }
  39     my $key;
  40     if (is_Identifier $s) {
  41       if (!$name and @{$s->{elements}} == 2) {
  42         $default_inside_alias ||= $s->{elements}[0];
  43         if ($s->{elements}[0] eq $default_inside_alias) {
  44           $alias_map{join('.',@{$s->{elements}})} = $s;
  45           push @inside_select_list, $s;
  46           push @outside_select_list, $s;
  47           next SELECT;
  48         }
  49       }
  50       $name ||= join('__', @{$s->{elements}});
  51       $key = join('.', @{$s->{elements}});
  52     } else {
  53       die "XXX not implemented yet" unless $name;
  54       $key = "$s";
  55     }
  56     $name ||= sprintf("GENSYM__%03i",++$gensym_count);
  57     push @inside_select_list, Alias($name, $s);
  58     push @outside_select_list, $alias_map{$key} = Identifier($name);
  59   }
  60   my $order = $orig_select->{from};
  61   my $order_gensym_count;
  62   die "Slice's Select not followed by Order but order_is_stable set"
  63     unless is_Order $order;
  64   my (@order_nodes, %order_map);
  65   while (is_Order $order) {
  66     my $by = $order->{by};
  67     if (is_Identifier $by) {
  68       $default_inside_alias ||= $by->{elements}[0]
  69         if @{$by->{elements}} == 2;
  70       $order_map{$by}
  71         = $alias_map{join('.', @{$by->{elements}})}
  72           ||= do {
  73                 if (
  74                   @{$by->{elements}} == 2
  75                   and $by->{elements}[0] eq $default_inside_alias
  76                 ) {
  77                   $by;
  78                 } else {
  79                   my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count);
  80                   push @inside_select_list, Alias($name, $by);
  81                   Identifier($name);
  82                 }
  83               };
  84     } else {
  85       die "XXX not implemented yet";
  86     }
  87     push @order_nodes, $order;
  88     $order = $order->{from};
  89   }
  90   my $inside_order = reduce {
  91     Order($b->{by}, $b->{reverse}, $a)
  92   } $order, reverse @order_nodes;
  93   my $inside_select = Select(\@inside_select_list, $inside_order);
  94   my $limit_plus_offset = +{
  95     %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value}
  96   };
  97   $default_inside_alias ||= 'me';
  98   my $bridge_from = Alias(
  99     $default_inside_alias,
 100     Slice(undef, $limit_plus_offset, $inside_select)
 101   );
 102   my $outside_order = reduce {
 103     Order($order_map{$b->{by}}, !$b->{reverse}, $a)
 104   } $bridge_from, reverse @order_nodes;
 105   my $outside_select = Select(
 106     (
 107       $dq->{preserve_order}
 108         ? [
 109             @outside_select_list,
 110             grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes}
 111           ]
 112         : \@outside_select_list,
 113     ),
 114     $outside_order,
 115   );
 116   my $final = Slice(undef, $dq->{limit}, $outside_select);
 117   if ($dq->{preserve_order}) {
 118     $final = Select(
 119       \@outside_select_list,
 120       reduce {
 121         Order($order_map{$b->{by}}, $b->{reverse}, $a)
 122       } Alias($default_inside_alias, $final), reverse @order_nodes
 123     );
 124   }
 125   return $self->_render($final);
 126 }
 127
 128 1;