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

   1 package Data::Query::Renderer::SQL::Slice::FetchFirst;
   2
   3 use Data::Query::Constants qw(
   4   DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE
   5 );
   6 use Moo::Role;
   7
   8 sub _render_slice_limit {
   9   my ($self, $dq) = @_;
  10   return [
  11     ($dq->{from} ? $self->_render($dq->{from}) : ()),
  12     $self->_format_keyword('FETCH FIRST'),
  13     sprintf("%i", $dq->{limit}{value}),
  14     $self->_format_keyword('ROWS ONLY')
  15   ];
  16 }
  17
  18 sub _slice_type { 'FetchFirst' }
  19
  20 sub _render_slice {
  21   my ($self, $dq) = @_;
  22   unless ($dq->{offset}) {
  23     return $self->_render_slice_limit($dq);
  24   }
  25   unless ($dq->{order_is_stable}) {
  26     die $self->_slice_type." limit style requires a stable order";
  27   }
  28   die "Slice's inner is not a Select"
  29     unless (my $orig_select = $dq->{from})->{type} eq DQ_SELECT;
  30   my %alias_map;
  31   my $gensym_count;
  32   my (@inside_select_list, @outside_select_list);
  33   my $default_inside_alias;
  34   SELECT: foreach my $s (@{$orig_select->{select}}) {
  35     my $name;
  36     if ($s->{type} eq DQ_ALIAS) {
  37       $name = $s->{to};
  38       $s = $s->{from};
  39     }
  40     my $key;
  41     if ($s->{type} eq DQ_IDENTIFIER) {
  42       if (!$name and @{$s->{elements}} == 2) {
  43         $default_inside_alias ||= $s->{elements}[0];
  44         if ($s->{elements}[0] eq $default_inside_alias) {
  45           $alias_map{join('.',@{$s->{elements}})} = $s;
  46           push @inside_select_list, $s;
  47           push @outside_select_list, $s;
  48           next SELECT;
  49         }
  50       }
  51       $name ||= join('__', @{$s->{elements}});
  52       $key = join('.', @{$s->{elements}});
  53     } else {
  54       die "XXX not implemented yet" unless $name;
  55       $key = "$s";
  56     }
  57     $name ||= sprintf("GENSYM__%03i",++$gensym_count);
  58     push @inside_select_list, +{
  59       type => DQ_ALIAS,
  60       from => $s,
  61       to => $name,
  62     };
  63     push @outside_select_list, $alias_map{$key} = +{
  64       type => DQ_IDENTIFIER,
  65       elements => [ $name ]
  66     };
  67   }
  68   my $order = $orig_select->{from};
  69   my $order_gensym_count;
  70   die "Slice's Select not followed by Order but order_is_stable set"
  71     unless $order->{type} eq DQ_ORDER;
  72   my (@order_nodes, %order_map);
  73   while ($order->{type} eq DQ_ORDER) {
  74     my $by = $order->{by};
  75     if ($by->{type} eq DQ_IDENTIFIER) {
  76       $default_inside_alias ||= $by->{elements}[0]
  77         if @{$by->{elements}} == 2;
  78       $order_map{$by}
  79         = $alias_map{join('.', @{$by->{elements}})}
  80           ||= do {
  81                 if (
  82                   @{$by->{elements}} == 2
  83                   and $by->{elements}[0] eq $default_inside_alias
  84                 ) {
  85                   $by;
  86                 } else {
  87                   my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count);
  88                   push @inside_select_list, +{
  89                     type => DQ_ALIAS,
  90                     from => $by,
  91                     to => $name
  92                   };
  93                   +{
  94                     type => DQ_IDENTIFIER,
  95                     elements => [ $name ],
  96                   };
  97                 }
  98               };
  99     } else {
 100       die "XXX not implemented yet";
 101     }
 102     push @order_nodes, $order;
 103     $order = $order->{from};
 104   }
 105   my $inside_order = $order;
 106   $inside_order = +{
 107     type => DQ_ORDER,
 108     by => $_->{by},
 109     reverse => $_->{reverse},
 110     from => $inside_order
 111   } for reverse @order_nodes;
 112   my $inside_select = +{
 113     type => DQ_SELECT,
 114     select => \@inside_select_list,
 115     from => $inside_order,
 116   };
 117   my $limit_plus_offset = +{
 118     %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value}
 119   };
 120   $default_inside_alias ||= 'me';
 121   my $bridge_from = +{
 122     type => DQ_ALIAS,
 123     to => $default_inside_alias,
 124     from => {
 125       type => DQ_SLICE,
 126       limit => $limit_plus_offset,
 127       from => $inside_select,
 128     },
 129   };
 130   my $outside_order = $bridge_from;
 131   $outside_order = +{
 132     type => DQ_ORDER,
 133     by => $order_map{$_->{by}},
 134     reverse => !$_->{reverse},
 135     from => $outside_order
 136   } for reverse @order_nodes;
 137   my $outside_select = +{
 138     type => DQ_SELECT,
 139     select => (
 140       $dq->{preserve_order}
 141         ? [
 142             @outside_select_list,
 143             grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes}
 144           ]
 145         : \@outside_select_list,
 146     ),
 147     from => $outside_order,
 148   };
 149   my $final = {
 150     type => DQ_SLICE,
 151     limit => $dq->{limit},
 152     from => $outside_select
 153   };
 154   if ($dq->{preserve_order}) {
 155     $final = {
 156       type => DQ_ALIAS,
 157       from => $final,
 158       to => $default_inside_alias,
 159     };
 160     $final = +{
 161       type => DQ_ORDER,
 162       by => $order_map{$_->{by}},
 163       reverse => $_->{reverse},
 164       from => $final
 165     } for reverse @order_nodes;
 166     $final = {
 167       type => DQ_SELECT,
 168       select => \@outside_select_list,
 169       from => $final,
 170     };
 171   }
 172   return $self->_render($final);
 173 }
 174
 175 1;