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