Commit | Line | Data |
410dc8ab |
1 | package Data::Query::Renderer::SQL::Slice::GenericSubQ; |
2 | |
3 | use Data::Query::Constants qw( |
4 | DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE |
5 | DQ_WHERE DQ_OPERATOR |
6 | ); |
7 | use Moo::Role; |
8 | |
9 | sub _render_slice { |
10 | my ($self, $dq) = @_; |
11 | unless ($dq->{order_is_stable}) { |
12 | die "GenericSubQ limit style requires a stable order"; |
13 | } |
14 | die "Slice's inner is not a Select" |
15 | unless (my $orig_select = $dq->{from})->{type} eq DQ_SELECT; |
16 | my %alias_map; |
17 | my $gensym_count; |
18 | my (@inside_select_list, @outside_select_list); |
19 | my $default_inside_alias; |
20 | SELECT: foreach my $s (@{$orig_select->{select}}) { |
21 | my $name; |
22 | if ($s->{type} eq DQ_ALIAS) { |
23 | $name = $s->{to}; |
24 | $s = $s->{from}; |
25 | } |
26 | my $key; |
27 | if ($s->{type} eq DQ_IDENTIFIER) { |
28 | if (!$name and @{$s->{elements}} == 2) { |
29 | $default_inside_alias ||= $s->{elements}[0]; |
30 | if ($s->{elements}[0] eq $default_inside_alias) { |
31 | $alias_map{join('.',@{$s->{elements}})} = $s; |
32 | push @inside_select_list, $s; |
33 | push @outside_select_list, $s; |
34 | next SELECT; |
35 | } |
36 | } |
37 | $name ||= join('__', @{$s->{elements}}); |
38 | $key = join('.', @{$s->{elements}}); |
39 | } else { |
40 | die "XXX not implemented yet" unless $name; |
41 | $key = "$s"; |
42 | } |
43 | $name ||= sprintf("GENSYM__%03i",++$gensym_count); |
44 | push @inside_select_list, +{ |
45 | type => DQ_ALIAS, |
46 | from => $s, |
47 | to => $name, |
48 | }; |
49 | push @outside_select_list, $alias_map{$key} = +{ |
50 | type => DQ_IDENTIFIER, |
51 | elements => [ $name ] |
52 | }; |
53 | } |
54 | my $order = $orig_select->{from}; |
55 | my $order_gensym_count; |
56 | die "Slice's Select not followed by Order but order_is_stable set" |
57 | unless $order->{type} eq DQ_ORDER; |
58 | my (@order_nodes, %order_map); |
59 | while ($order->{type} eq DQ_ORDER) { |
60 | my $by = $order->{by}; |
61 | if ($by->{type} eq DQ_IDENTIFIER) { |
62 | $default_inside_alias ||= $by->{elements}[0] |
63 | if @{$by->{elements}} == 2; |
64 | $order_map{$by} |
65 | = $alias_map{join('.', @{$by->{elements}})} |
66 | ||= do { |
67 | if ( |
68 | @{$by->{elements}} == 2 |
69 | and $by->{elements}[0] eq $default_inside_alias |
70 | ) { |
71 | $by; |
72 | } else { |
73 | my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count); |
74 | push @inside_select_list, +{ |
75 | type => DQ_ALIAS, |
76 | from => $by, |
77 | to => $name |
78 | }; |
79 | +{ |
80 | type => DQ_IDENTIFIER, |
81 | elements => [ $name ], |
82 | }; |
83 | } |
84 | }; |
85 | } else { |
86 | die "XXX not implemented yet"; |
87 | } |
88 | push @order_nodes, $order; |
89 | $order = $order->{from}; |
90 | } |
91 | my $inside_select = +{ |
92 | type => DQ_SELECT, |
93 | select => \@inside_select_list, |
94 | from => $order, |
95 | }; |
96 | $default_inside_alias ||= 'me'; |
97 | my $bridge_from = +{ |
98 | type => DQ_ALIAS, |
99 | to => $default_inside_alias, |
100 | from => $inside_select, |
101 | }; |
102 | my $default_inside_from; |
103 | FIND_FROM: { |
104 | my @queue = $order; |
105 | my $cb_map = +{ |
106 | DQ_ALIAS ,=> sub { |
107 | if ($_[0]->{to} eq $default_inside_alias) { |
108 | $default_inside_from = $_[0]->{from}; |
109 | no warnings 'exiting'; |
110 | last FIND_FROM; |
111 | } |
112 | } |
113 | }; |
114 | # _scan_nodes from DBIHacks - maybe make this a sub somewhere? |
115 | while (my $node = shift @queue) { |
116 | if ($node->{type} and my $cb = $cb_map->{$node->{type}}) { |
117 | $cb->($node); |
118 | } |
119 | push @queue, |
120 | grep ref($_) eq 'HASH', |
121 | map +(ref($_) eq 'ARRAY' ? @$_ : $_), |
122 | @{$node}{grep !/\./, keys %$node}; |
123 | } |
124 | die "Couldn't figure out where ${default_inside_alias} came from :("; |
125 | } |
126 | my $bridge_where = +{ |
127 | type => DQ_WHERE, |
128 | from => $bridge_from, |
129 | where => { |
130 | type => DQ_OPERATOR, |
131 | operator => { |
b4b25214 |
132 | 'SQL.Naive' => ( |
133 | $dq->{offset} |
134 | ? 'BETWEEN' |
135 | : $order_nodes[0]{reverse} ? '>' : '<' |
136 | ), |
410dc8ab |
137 | }, |
138 | args => [ |
139 | { |
140 | type => DQ_SELECT, |
141 | select => [ |
142 | { |
143 | type => DQ_OPERATOR, |
144 | operator => { 'SQL.Naive' => 'apply' }, |
145 | args => [ |
146 | { |
147 | type => DQ_IDENTIFIER, |
148 | elements => [ 'COUNT' ], |
149 | }, |
150 | { |
151 | type => DQ_IDENTIFIER, |
152 | elements => [ '*' ], |
153 | } |
154 | ] |
155 | } |
156 | ], |
157 | from => { |
158 | type => DQ_WHERE, |
159 | from => { |
160 | type => DQ_ALIAS, |
161 | from => $default_inside_from, |
162 | to => 'rownum__emulation', |
163 | }, |
164 | where => { |
165 | type => DQ_OPERATOR, |
b4b25214 |
166 | operator => { |
167 | 'SQL.Naive' => $order_nodes[0]{reverse} ? '>' : '<' |
168 | }, |
410dc8ab |
169 | args => [ |
170 | map +{ |
171 | type => DQ_IDENTIFIER, |
172 | elements => [ |
173 | $_, |
174 | $order_nodes[0]{by}{elements}[-1], |
175 | ] |
176 | }, 'rownum__emulation', $default_inside_alias, |
177 | ], |
178 | } |
179 | }, |
180 | }, |
b4b25214 |
181 | ($dq->{offset} |
182 | ? ($dq->{offset}, |
183 | { %{$dq->{limit}}, |
184 | value => $dq->{offset}{value} + $dq->{limit}{value} - 1 |
185 | } |
186 | ) |
187 | : ($dq->{limit}) |
188 | ), |
410dc8ab |
189 | ] |
190 | }, |
191 | }; |
192 | my $outside_order = $bridge_where; |
193 | $outside_order = +{ |
194 | type => DQ_ORDER, |
195 | by => $order_map{$_->{by}}, |
196 | reverse => $_->{reverse}, |
197 | from => $outside_order |
198 | } for reverse @order_nodes; |
199 | my $outside_select = +{ |
200 | type => DQ_SELECT, |
201 | select => ( |
202 | $dq->{preserve_order} |
203 | ? [ |
204 | @outside_select_list, |
205 | grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes} |
206 | ] |
207 | : \@outside_select_list, |
208 | ), |
209 | from => $outside_order, |
210 | }; |
211 | return $self->_render($outside_select); |
212 | } |
213 | |
214 | 1; |