+++ /dev/null
-package Data::Query::Renderer::SQL::Slice::GenericSubQ;
-
-use Data::Query::Constants qw(
- DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE
- DQ_WHERE DQ_OPERATOR
-);
-use Moo::Role;
-
-sub _render_slice {
- my ($self, $dq) = @_;
- unless ($dq->{order_is_stable}) {
- die "GenericSubQ limit style requires a stable order";
- }
- die "Slice's inner is not a Select"
- unless (my $orig_select = $dq->{from})->{type} eq DQ_SELECT;
- 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 ($s->{type} eq DQ_ALIAS) {
- $name = $s->{to};
- $s = $s->{from};
- }
- my $key;
- if ($s->{type} eq DQ_IDENTIFIER) {
- 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, +{
- type => DQ_ALIAS,
- from => $s,
- to => $name,
- };
- push @outside_select_list, $alias_map{$key} = +{
- type => DQ_IDENTIFIER,
- elements => [ $name ]
- };
- }
- my $order = $orig_select->{from};
- my $order_gensym_count;
- die "Slice's Select not followed by Order but order_is_stable set"
- unless $order->{type} eq DQ_ORDER;
- my (@order_nodes, %order_map);
- while ($order->{type} eq DQ_ORDER) {
- my $by = $order->{by};
- if ($by->{type} eq DQ_IDENTIFIER) {
- $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, +{
- type => DQ_ALIAS,
- from => $by,
- to => $name
- };
- +{
- type => DQ_IDENTIFIER,
- elements => [ $name ],
- };
- }
- };
- } else {
- die "XXX not implemented yet";
- }
- push @order_nodes, $order;
- $order = $order->{from};
- }
- my $inside_select = +{
- type => DQ_SELECT,
- select => \@inside_select_list,
- from => $order,
- };
- $default_inside_alias ||= 'me';
- my $bridge_from = +{
- type => DQ_ALIAS,
- to => $default_inside_alias,
- from => $inside_select,
- };
- my $default_inside_from;
- FIND_FROM: {
- my @queue = $order;
- my $cb_map = +{
- DQ_ALIAS ,=> sub {
- if ($_[0]->{to} eq $default_inside_alias) {
- $default_inside_from = $_[0]->{from};
- no warnings 'exiting';
- last FIND_FROM;
- }
- }
- };
- # _scan_nodes from DBIHacks - maybe make this a sub somewhere?
- while (my $node = shift @queue) {
- if ($node->{type} and my $cb = $cb_map->{$node->{type}}) {
- $cb->($node);
- }
- push @queue,
- grep ref($_) eq 'HASH',
- map +(ref($_) eq 'ARRAY' ? @$_ : $_),
- @{$node}{grep !/\./, keys %$node};
- }
- die "Couldn't figure out where ${default_inside_alias} came from :(";
- }
- my $bridge_where = +{
- type => DQ_WHERE,
- from => $bridge_from,
- where => {
- type => DQ_OPERATOR,
- operator => {
- 'SQL.Naive' => (
- $dq->{offset}
- ? 'BETWEEN'
- : $order_nodes[0]{reverse} ? '>' : '<'
- ),
- },
- args => [
- {
- type => DQ_SELECT,
- select => [
- {
- type => DQ_OPERATOR,
- operator => { 'SQL.Naive' => 'apply' },
- args => [
- {
- type => DQ_IDENTIFIER,
- elements => [ 'COUNT' ],
- },
- {
- type => DQ_IDENTIFIER,
- elements => [ '*' ],
- }
- ]
- }
- ],
- from => {
- type => DQ_WHERE,
- from => {
- type => DQ_ALIAS,
- from => $default_inside_from,
- to => 'rownum__emulation',
- },
- where => {
- type => DQ_OPERATOR,
- operator => {
- 'SQL.Naive' => $order_nodes[0]{reverse} ? '>' : '<'
- },
- args => [
- map +{
- type => DQ_IDENTIFIER,
- elements => [
- $_,
- $order_nodes[0]{by}{elements}[-1],
- ]
- }, 'rownum__emulation', $default_inside_alias,
- ],
- }
- },
- },
- ($dq->{offset}
- ? ($dq->{offset},
- { %{$dq->{limit}},
- value => $dq->{offset}{value} + $dq->{limit}{value} - 1
- }
- )
- : ($dq->{limit})
- ),
- ]
- },
- };
- my $outside_order = $bridge_where;
- $outside_order = +{
- type => DQ_ORDER,
- by => $order_map{$_->{by}},
- reverse => $_->{reverse},
- from => $outside_order
- } for reverse @order_nodes;
- my $outside_select = +{
- type => DQ_SELECT,
- select => (
- $dq->{preserve_order}
- ? [
- @outside_select_list,
- grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes}
- ]
- : \@outside_select_list,
- ),
- from => $outside_order,
- };
- return $self->_render($outside_select);
-}
-
-1;