Commit | Line | Data |
0446ca9c |
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 | } |
1bfa648a |
49 | $name ||= sprintf("GENSYM__%03i",++$gensym_count); |
0446ca9c |
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 { |
1bfa648a |
71 | my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count); |
0446ca9c |
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} |
1bfa648a |
124 | ? [ |
125 | @outside_select_list, |
126 | grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes} |
127 | ] |
0446ca9c |
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; |