Commit | Line | Data |
fd0d9ec8 |
1 | package SQL::Abstract2; |
2 | |
3 | use Moose; |
4 | has known_ops => (is => 'rw', isa => 'HashRef', lazy_build => 1); |
5 | has use_value_placeholders => |
6 | ( |
7 | is => 'rw', |
8 | isa => 'Bool', |
9 | required => 1, |
10 | default => 1 |
11 | ); |
12 | has value_placeholder_char => |
13 | ( |
14 | is => 'rw', |
15 | isa => 'Str', |
16 | required => 1, |
17 | default => sub {"?"}, |
18 | ); |
19 | has value_quote_char => |
20 | ( |
21 | is => 'rw', |
22 | isa => 'Str', |
23 | required => 1, |
24 | default => sub {"'"}, |
25 | ); |
26 | |
27 | has name_quote_char => |
28 | ( |
29 | is => 'rw', |
30 | isa => 'Str', |
31 | required => 1, |
32 | default => sub {'`'}, |
33 | ); |
34 | |
35 | has name_separator => |
36 | ( |
37 | is => 'rw', |
38 | isa => 'Str', |
39 | required => 1, |
40 | default => sub {'.'}, |
41 | ); |
42 | |
43 | has logical_group_open_char => |
44 | ( |
45 | is => 'rw', |
46 | isa => 'Str', |
47 | required => 1, |
48 | default => sub {'('}, |
49 | ); |
50 | |
51 | has logical_group_close_char => |
52 | ( |
53 | is => 'rw', |
54 | isa => 'Str', |
55 | required => 1, |
56 | default => sub {')'}, |
57 | ); |
58 | |
59 | |
60 | sub _build_known_ops { |
61 | my %known = |
62 | ( |
63 | 'in' => {handler => 'handle_op_in'}, |
64 | 'date_add' => {handler => 'handle_op_date_add_sub'}, |
65 | 'date_sub' => {handler => 'handle_op_date_add_sub'}, |
66 | 'and' => {handler => 'handle_op_grouping'}, |
67 | 'xor' => {handler => 'handle_op_grouping'}, |
68 | 'or' => {handler => 'handle_op_grouping'}, |
69 | 'name' => {handler => 'handle_op_name', args_min => 1}, |
70 | 'between' => { |
71 | handler => 'handle_op_between', |
72 | args_min => 3, |
73 | args_max => 3, |
74 | }, |
75 | 'value' => { |
76 | handler => 'handle_op_value', |
77 | args_min => 1, |
78 | args_max => 1 |
79 | }, |
80 | 'asc' => { |
81 | handler => 'handle_op_asc_desc', |
82 | args_min => 1, |
83 | args_max => 1 |
84 | }, |
85 | 'desc' => { |
86 | handler => 'handle_op_asc_desc', |
87 | args_min => 1, |
88 | args_max => 1 |
89 | }, |
90 | '=' => { |
91 | args_min => 2, |
92 | args_max => 2, |
93 | handler => 'handle_op_null_aware_equality', |
94 | }, |
95 | '!=' => { |
96 | args_min => 2, |
97 | args_max => 2, |
98 | handler => 'handle_op_null_aware_equality', |
99 | }, |
100 | 'is' => { |
101 | args_min => 2, |
102 | args_max => 2, |
103 | handler => 'handle_op_is', |
104 | }, |
105 | 'where' => { |
106 | args_min => 1, |
107 | args_max => 1, |
6eaca423 |
108 | handler => 'handle_op_sql_word_and_args', |
fd0d9ec8 |
109 | }, |
110 | ); |
111 | |
112 | foreach my $bin_op (qw^ > < >= <= + - * / % <> <=> ^) { |
113 | $known{$bin_op} = { |
114 | args_min => 2, |
115 | args_max => 2, |
116 | handler => 'simple_binary_op', |
117 | }; |
118 | } |
119 | for my $word ('fields', 'from', 'order by', 'group by'){ |
120 | $known{$word} = { handler => 'handle_op_sql_word_and_list' }; |
121 | } |
122 | for my $word (qw/insert update select delete having/, 'replace into'){ |
123 | $known{$word} = { handler => 'handle_op_sql_word_and_args' }; |
124 | } |
125 | for my $join ('join','left join','right join','inner join', 'cross join', |
126 | 'straight_join','left outer join','right outer join', |
127 | 'natural join', 'natural left join', 'natural left outer join', |
128 | 'straight join', 'natural right join', 'natural right outer join', |
129 | ){ |
130 | $known{$join} = { handler => 'handle_op_join' }; |
131 | } |
132 | return \%known; |
133 | } |
134 | |
135 | sub handle_op_asc_desc { |
136 | my($self, $op, $args, $bind_vars) = @_; |
137 | return join(' ', $self->handle_op($args->[0], $bind_vars), uc($op)); |
138 | } |
139 | |
140 | sub handle_op_limit { |
141 | my($self, $op, $args, $bind_vars) = @_; |
142 | return $self->handle_op_sql_word_and_list('LIMIT', $args, $bind_vars) |
143 | } |
144 | |
145 | sub handle_op_join { |
146 | my($self, $op, $args, $bind_vars) = @_; |
147 | my @args = @$args; |
148 | my $join_type = uc $op; |
149 | my $table = $self->handle_op( shift(@args), $bind_vars); |
150 | if(@args){ |
151 | return join(" ", $join_type, $table, $self->handle_op(shift(@args), $bind_vars)) |
152 | } else { |
153 | join(" ", $join_type, $table); |
154 | } |
155 | } |
156 | |
157 | sub handle_op_sql_list { |
158 | my($self, $op, $args, $bind_vars) = @_; |
159 | my @quoted_args = map{ $self->handle_op($_, $bind_vars) } @$args; |
160 | return join ', ', @quoted_args; |
161 | } |
162 | |
163 | sub handle_op_sql_word_and_list { |
164 | my($self, $op, $args, $bind_vars) = @_; |
165 | return join ' ', uc($op), $self->handle_op_sql_list($op, $args, $bind_vars); |
166 | } |
167 | |
168 | sub handle_op_sql_word_and_args { |
169 | my($self, $op, $args, $bind_vars) = @_; |
170 | return join ' ', uc($op), map { $self->handle_op($_, $bind_vars) } @$args; |
171 | } |
172 | |
173 | sub handle_op_grouping { |
174 | my($self, $op, $args, $bind_vars) = @_; |
175 | my $sep = uc $op; |
176 | my @pieces = map { $self->handle_op($_, $bind_vars) } @$args; |
177 | if(@pieces > 1){ |
178 | return join("", |
179 | $self->logical_group_open_char, |
180 | (join " ${sep} ", @pieces), |
181 | $self->logical_group_close_char, |
182 | ); |
183 | } |
184 | return shift @pieces; |
185 | } |
186 | |
187 | sub handle_op_null_aware_equality { |
188 | my($self, $op, $args, $bind_vars) = @_; |
189 | |
190 | my($name, $value); |
191 | if ($args->[0]->[0] eq '-name' && $args->[1]->[0] eq '-value') { |
192 | ($name, $value) = @{$args}[0,1]; |
193 | } elsif ($args->[1]->[0] eq '-name' && $args->[0]->[0] eq '-value') { |
194 | ($name, $value) = @{$args}[1,0]; |
195 | } |
196 | if (defined($value) && !defined($value->[1])) { |
197 | my $is_op = $op eq '=' ? 'is' : 'is not'; |
198 | return $self->handle_op_is($is_op, [$name, $value], $bind_vars); |
199 | } |
200 | return $self->simple_binary_op($op, $args, $bind_vars); |
201 | } |
202 | |
203 | sub handle_op_date_add_sub { |
204 | my($self, $op, $args, $bind_vars) = @_; |
205 | if ($op =~ /add/i) { |
206 | $op = 'DATE_ADD'; |
207 | } elsif ($op =~ /sub/i) { |
208 | $op = 'DATE_SUB'; |
209 | } |
210 | my($date, $interval, $measure) = @$args; |
211 | $date = $self->maybe_quote_value($date, $bind_vars); |
212 | return "${op}($date, INTERVAL $interval $measure)"; |
213 | } |
214 | |
215 | sub handle_op_between { |
216 | my($self, $op, $args, $bind_vars) = @_; |
217 | my @args = @$args; #these are here so we don't destroy the refs given to us |
218 | my $left_side = $self->handle_op(shift(@args), $bind_vars); |
219 | my $sql = $op =~ /not(?:_|\w*)between/i ? 'NOT BETWEEN' : 'BETWEEN'; |
220 | return join ' ', $left_side, $sql, $self->simple_binary_op('AND', \@args, $bind_vars); |
221 | } |
222 | |
223 | sub handle_op_in { |
224 | my($self, $op, $args, $bind_vars) = @_; |
225 | my @args = @$args; |
226 | my $left_side = $self->handle_op(shift(@args), $bind_vars); |
227 | my $sql = $op =~ /not(?:_|\w*)in/i ? 'NOT IN' : 'IN'; |
228 | return join(" ", $left_side, $self->simple_function_op($sql, \@args, $bind_vars)); |
229 | } |
230 | |
231 | sub handle_op_is { |
232 | my($self, $op, $args, $bind_vars) = @_; |
233 | my $sql = $op =~ /is(?:_|\w*)not/i ? 'IS NOT' : 'IS'; |
234 | return $self->simple_binary_op($sql, $args, $bind_vars); |
235 | } |
236 | |
237 | sub simple_binary_op { |
238 | my($self, $op, $args, $bind_vars) = @_; |
239 | $op = uc $op; |
240 | my @arg_strs = map{ $self->handle_op($_, $bind_vars) } @$args; |
241 | return join(" ${op} ", @arg_strs); |
242 | } |
243 | |
244 | sub simple_function_op { |
245 | my($self, $op, $args, $bind_vars) = @_; |
246 | my $arg_str = $self->handle_op_sql_list($op, $args, $bind_vars); |
247 | my $function = uc $op; |
248 | return "${function}(${arg_str})"; |
249 | } |
250 | |
251 | sub handle_op_value { |
252 | my ($self, $op, $args, $bind_vars) = @_; |
253 | return $self->maybe_quote_value($args->[0], $bind_vars); |
254 | } |
255 | sub handle_op_name { |
256 | my ($self, $op, $args, $bind_vars) = @_; |
257 | return $self->maybe_quote_name(@$args); |
258 | } |
259 | |
260 | sub handle_op { |
261 | my ($self, $frame, $bind_vars) = @_; |
262 | use Data::Dumper; |
263 | confess( Dumper($frame) ) unless ref $frame; |
264 | my ($needle, $op, $args); |
265 | ($op, @$args) = @$frame; |
266 | |
267 | if ($op =~/^-((?:not\s*)?(.+?))$/) { |
268 | #bye bye leadin / trailing whitespace, keep needle lc for simplicity |
269 | $op = $1; |
270 | $needle = lc $2; |
271 | ($op) = ($op =~ /^\s*(.+?)\s*$/); |
272 | ($needle) = ($needle =~ /^\s*(.+?)\s*$/); |
273 | } |
274 | my $op_info; |
275 | if ( exists $self->known_ops->{$op} ) { |
276 | $op_info = $self->known_ops->{$op}; |
277 | } elsif(defined $needle) { |
278 | if ( exists $self->known_ops->{$needle} ) { |
279 | $op_info = $self->known_ops->{$needle}; |
280 | } elsif ( ($needle =~ /^\w+$/) && (my $coderef = $self->can("handle_op_${needle}"))) { |
281 | return $self->$coderef($op, $args, $bind_vars) |
282 | } else { |
283 | return $self->simple_function_op($op, $args, $bind_vars); |
284 | } |
285 | } else { |
286 | use Data::Dumper; |
287 | print Dumper $op; |
288 | die("Failed to find handle '${op}'"); |
289 | } |
290 | |
291 | #arg checking |
292 | if (exists $op_info->{args_min}) { |
293 | my $min = $op_info->{args_min}; |
294 | die("Operator ${op} needs a minimum of ${min} arguments") |
295 | unless $min <= @$args; |
296 | } |
297 | if (exists $op_info->{args_max}) { |
298 | my $max = $op_info->{args_max}; |
299 | die("Operator ${op} can only have up to ${max} arguments") |
300 | unless $max >= @$args; |
301 | } |
302 | |
303 | my $handler = $op_info->{handler}; |
304 | if ( ref($handler) eq 'CODE' ) { |
305 | return $handler->($op, $args, $bind_vars); |
306 | } elsif (my $coderef = $self->can($handler)) { |
307 | $self->$coderef($op, $args, $bind_vars); |
308 | } else { |
309 | die("can not use handler ${handler}"); |
310 | } |
311 | } |
312 | |
313 | sub maybe_quote_value{ |
314 | my($self, $value, $bind_vars) = @_; |
315 | return $$value if ref($value) eq 'SCALAR'; |
316 | if ( $self->use_value_placeholders ){ |
317 | push @$bind_vars, $value; |
318 | return $self->value_placeholder_char; |
319 | } |
320 | return 'NULL' unless defined $value; |
321 | return $value if Scalar::Util::looks_like_number( $value ); |
322 | my $q = $self->value_quote_char; |
323 | return join "", $q, $value, $q; |
324 | } |
325 | |
326 | sub maybe_quote_name{ |
327 | my($self, @parts) = @_; |
328 | my $q = $self->name_quote_char; |
329 | my $as; |
330 | if(ref($parts[-1]) eq 'ARRAY' && $parts[-1]->[0] eq '-as'){ |
331 | $as = pop(@parts)->[1]; |
332 | $as = ref($as) eq 'SCALAR' ? $$as : join("", $q, $as, $q); |
333 | } |
334 | @parts = map { ref($_) eq 'SCALAR' ? $$_ : join("", $q, $_, $q) } @parts; |
335 | my $name = join($self->name_separator, @parts); |
336 | return join ' AS ', grep { defined } ($name, $as); #XXX make 'AS' an attribute |
337 | } |
338 | |
339 | __PACKAGE__->meta->make_immutable; |
340 | |
341 | 1; |
342 | |
343 | __END__; |