File Coverage

blib/lib/SQL/Wizard/Renderer.pm
Criterion Covered Total %
statement 560 607 92.2
branch 210 256 82.0
condition 51 82 62.2
subroutine 35 35 100.0
pod 0 2 0.0
total 856 982 87.1


line stmt bran cond sub pod time code
1             package SQL::Wizard::Renderer;
2              
3 14     14   92 use strict;
  14         33  
  14         475  
4 14     14   61 use warnings;
  14         24  
  14         641  
5 14     14   112 use Carp;
  14         37  
  14         1028  
6 14     14   83 use Scalar::Util qw(blessed);
  14         24  
  14         142849  
7              
8             my $INJECTION_GUARD = qr/
9             \;
10             |
11             ^ \s* go \s
12             /xmi;
13              
14             my %VALID_OPS = map { $_ => 1 }
15             '=', '!=', '<>', '<', '>', '<=', '>=',
16             'LIKE', 'NOT LIKE', 'ILIKE', 'NOT ILIKE',
17             '-IN', '-NOT_IN';
18              
19             sub new {
20 14     14 0 106 my ($class, %args) = @_;
21 14         91 bless \%args, $class;
22             }
23              
24             # Combined reserved words (PostgreSQL + MySQL + ANSI SQL)
25             my %RESERVED = map { $_ => 1 } qw(
26             ACCESSIBLE ADD ALL ALTER ANALYZE AND ANY ARRAY AS ASC ASENSITIVE ASYMMETRIC
27             BEFORE BETWEEN BIGINT BINARY BLOB BOTH BY
28             CALL CASCADE CASE CAST CHANGE CHAR CHARACTER CHECK COLLATE COLUMN CONCURRENTLY
29             CONDITION CONSTRAINT CONTINUE CONVERT CREATE CROSS CUBE CUME_DIST CURRENT_DATE
30             CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER CURSOR
31             DATABASE DATABASES DAY_HOUR DAY_MICROSECOND DAY_MINUTE DAY_SECOND DEC DECIMAL
32             DECLARE DEFAULT DEFERRABLE DELAYED DELETE DENSE_RANK DESC DESCRIBE DETERMINISTIC
33             DISTINCT DISTINCTROW DIV DO DOUBLE DROP DUAL
34             EACH ELSE ELSEIF EMPTY ENCLOSED END ESCAPED EXCEPT EXISTS EXIT EXPLAIN
35             FALSE FETCH FIRST_VALUE FLOAT FLOAT4 FLOAT8 FOR FORCE FOREIGN FREEZE FROM
36             FULL FULLTEXT FUNCTION
37             GENERATED GET GRANT GROUP GROUPING GROUPS
38             HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE HOUR_SECOND
39             IF IGNORE IN INDEX INFILE INITIALLY INNER INOUT INSENSITIVE INSERT INT INT1
40             INT2 INT3 INT4 INT8 INTEGER INTERSECT INTERVAL INTO IO_AFTER_GTIDS
41             IO_BEFORE_GTIDS IS ISNULL ITERATE
42             JOIN JSON_TABLE
43             KEY KEYS KILL
44             LAG LAST_VALUE LATERAL LEAD LEADING LEAVE LEFT LIKE LIMIT LINEAR LINES LOAD
45             LOCALTIME LOCALTIMESTAMP LOCK LONG LONGBLOB LONGTEXT LOOP LOW_PRIORITY
46             MASTER_BIND MASTER_SSL_VERIFY_SERVER_CERT MATCH MAXVALUE MEDIUMBLOB MEDIUMINT
47             MEDIUMTEXT MIDDLEINT MOD MODIFIES
48             NATURAL NOT NOTNULL NO_WRITE_TO_BINLOG NTH_VALUE NTILE NULL NUMERIC
49             OF ON ONLY OPTIMIZE OPTIMIZER_COSTS OPTION OPTIONALLY OR ORDER OUT OUTER
50             OUTFILE OVER OVERLAPS
51             PARTITION PRECISION PRIMARY PROCEDURE PURGE
52             RANGE READ READS READ_WRITE REAL RECURSIVE REFERENCES REGEXP RELEASE RENAME
53             REPEAT REPLACE REQUIRE RESIGNAL RESTRICT RETURN REVOKE RIGHT RLIKE ROW ROWS
54             ROW_NUMBER
55             SCHEMA SCHEMAS SELECT SENSITIVE SEPARATOR SET SHOW SIGNAL SIMILAR SOME SPATIAL
56             SPECIFIC SQL SQLEXCEPTION SQLSTATE SQLWARNING SQL_BIG_RESULT SQL_CALC_FOUND_ROWS
57             SQL_SMALL_RESULT SSL STARTING STORED STRAIGHT_JOIN SYMMETRIC SYSTEM
58             TABLE TABLESAMPLE TERMINATED THEN TINYBLOB TINYINT TINYTEXT TO TRAILING
59             TRIGGER TRUE
60             UNDO UNION UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE UTC_TIME
61             UTC_TIMESTAMP
62             VALUES VARBINARY VARCHAR VARCHARACTER VARIADIC VARYING VERBOSE VIRTUAL
63             WHEN WHERE WHILE WINDOW WITH WRITE
64             XOR YEAR_MONTH ZEROFILL
65             );
66              
67             sub _needs_quoting {
68 647     647   1124 my ($self, $part) = @_;
69 647 100       1711 return 0 if $part eq '*';
70 554 100       1434 return 1 if $RESERVED{uc $part};
71 551 50       1343 return 1 if $part =~ /[A-Z]/;
72 551 50       1176 return 1 if $part =~ /[^a-z0-9_]/;
73 551         2508 return 0;
74             }
75              
76             sub _quote_ident {
77 3     3   7 my ($self, $name) = @_;
78 3 50 50     12 my $q = ($self->{dialect} || 'ansi') eq 'mysql' ? '`' : '"';
79             return join('.', map {
80 3 50       11 $_ eq '*' ? $_ : $q . (s/\Q$q\E/$q$q/gr) . $q
  3         44  
81             } split /\./, $name, -1);
82             }
83              
84             sub _quote_ident_if_needed {
85 611     611   1124 my ($self, $name) = @_;
86 611         1425 my @parts = split /\./, $name, -1;
87 611 100       1923 return $name unless grep { $self->_needs_quoting($_) } @parts;
  647         1259  
88 3         10 return $self->_quote_ident($name);
89             }
90              
91             sub _injection_guard {
92 316     316   528 my ($self, $string) = @_;
93 316 50       2920 if ($string =~ $INJECTION_GUARD) {
94 0         0 confess "Possible SQL injection attempt '$string'. "
95             . "If this is indeed a part of the desired SQL, use raw()";
96             }
97             }
98              
99             sub _assert_column {
100 28     28   61 my ($self, $col) = @_;
101 28 50       218 confess "Invalid column name '$col'"
102             unless $col =~ /^(\w+\.)*(\w+|\*)$/;
103             }
104              
105             sub _assert_order_column {
106 14     14   33 my ($self, $col) = @_;
107 14 50       91 confess "Invalid order_by column '$col'"
108             unless $col =~ /^(\w+\.)*\w+$/;
109             }
110              
111             sub _assert_integer {
112 9     9   23 my ($self, $name, $value) = @_;
113 9 50       44 confess "$name must be an integer, got '$value'"
114             unless $value =~ /^\d+$/;
115             }
116              
117             # Main dispatch
118             sub render {
119 405     405 0 799 my ($self, $node) = @_;
120 405         837 my $type = ref $node;
121              
122 405         3611 my %dispatch = (
123             'SQL::Wizard::Expr::Column' => \&_render_column,
124             'SQL::Wizard::Expr::Value' => \&_render_value,
125             'SQL::Wizard::Expr::Raw' => \&_render_raw,
126             'SQL::Wizard::Expr::Alias' => \&_render_alias,
127             'SQL::Wizard::Expr::Order' => \&_render_order,
128             'SQL::Wizard::Expr::Func' => \&_render_func,
129             'SQL::Wizard::Expr::BinaryOp' => \&_render_binop,
130             'SQL::Wizard::Expr::Select' => \&_render_select,
131             'SQL::Wizard::Expr::Join' => \&_render_join,
132             'SQL::Wizard::Expr::Case' => \&_render_case,
133             'SQL::Wizard::Expr::Window' => \&_render_window,
134             'SQL::Wizard::Expr::Compound' => \&_render_compound,
135             'SQL::Wizard::Expr::CTE' => \&_render_cte,
136             'SQL::Wizard::Expr::Insert' => \&_render_insert,
137             'SQL::Wizard::Expr::Update' => \&_render_update,
138             'SQL::Wizard::Expr::Delete' => \&_render_delete,
139             );
140              
141 405 50       1255 my $handler = $dispatch{$type}
142             or croak "No renderer for node type: $type";
143 405         1113 $handler->($self, $node);
144             }
145              
146             # Render any expression or plain string (column name)
147             sub _render_expr {
148 275     275   570 my ($self, $thing) = @_;
149 275 50       597 return ('', ()) unless defined $thing;
150 275 100 66     1126 if (blessed($thing) && $thing->isa('SQL::Wizard::Expr')) {
151 93         300 return $self->render($thing);
152             }
153             # Plain string = column name
154 182         480 $self->_injection_guard($thing);
155 182         501 return ($self->_quote_ident_if_needed($thing), ());
156             }
157              
158             # table|alias => table alias
159             sub _expand_table {
160 160     160   291 my ($self, $thing) = @_;
161 160 100 66     413 if (blessed($thing) && $thing->isa('SQL::Wizard::Expr')) {
162 3         11 return $self->render($thing);
163             }
164 157 50       967 confess "Invalid table name '$thing'"
165             unless $thing =~ /^(\w+\.)*\w+(\|\w+)?$/;
166 157         496 my ($table, $alias) = split /\|/, $thing, 2;
167 157         449 my $qt = $self->_quote_ident_if_needed($table);
168 157 100       519 return $alias ? ("$qt " . $self->_quote_ident_if_needed($alias), ()) : ($qt, ());
169             }
170              
171             ## Leaf renderers
172              
173             sub _render_column {
174 63     63   141 my ($self, $node) = @_;
175 63         442 return ($self->_quote_ident_if_needed($node->{name}), ());
176             }
177              
178             sub _render_value {
179 45     45   85 my ($self, $node) = @_;
180 45         490 return ('?', $node->{value});
181             }
182              
183             sub _render_raw {
184 18     18   46 my ($self, $node) = @_;
185              
186             # TRUNCATE
187 18 50       148 if ($node->{_truncate}) {
188 0         0 my $table = $node->{_truncate};
189 0 0       0 confess "Invalid table name '$table'"
190             unless $table =~ /^(\w+\.)*\w+$/;
191 0         0 return ("TRUNCATE TABLE " . $self->_quote_ident_if_needed($table), ());
192             }
193              
194             # EXISTS / NOT EXISTS
195 18 100       97 if ($node->{_subquery}) {
196 7         21 my ($s, @b) = $self->render($node->{_subquery});
197 7         42 return ("$node->{sql}($s)", @b);
198             }
199              
200             # BETWEEN / NOT BETWEEN
201 11 100 100     70 if ($node->{_between} || $node->{_not_between}) {
202 2   66     13 my $spec = $node->{_between} || $node->{_not_between};
203 2 100       13 my $op = $node->{_between} ? 'BETWEEN' : 'NOT BETWEEN';
204 2         10 my ($cs, @cb) = $self->render($spec->{col});
205 2         11 my ($ls, @lb) = $self->render($spec->{lo});
206 2         9 my ($hs, @hb) = $self->render($spec->{hi});
207 2         25 return ("$cs $op $ls AND $hs", @cb, @lb, @hb);
208             }
209              
210             # CAST
211 9 100       29 if ($node->{_cast}) {
212 1         5 my $type = $node->{_cast}{type};
213 1 50       11 confess "Invalid CAST type '$type'"
214             unless $type =~ /^\w[\w\s(),]*$/;
215 1         7 my ($es, @eb) = $self->render($node->{_cast}{expr});
216 1         11 return ("CAST($es AS $type)", @eb);
217             }
218              
219             # AND / OR
220 8 100       33 if ($node->{_logic}) {
221 2         9 my $op = $node->{_logic}{op};
222 2         4 my @conds = @{$node->{_logic}{conds}};
  2         10  
223 2         5 my @parts;
224             my @bind;
225 2         6 for my $c (@conds) {
226 4         16 my ($s, @b) = $self->_render_where($c);
227 4         10 push @parts, $s;
228 4         13 push @bind, @b;
229             }
230 2         11 my $joined = join(" $op ", @parts);
231 2 50       14 $joined = "($joined)" if @parts > 1;
232 2         25 return ($joined, @bind);
233             }
234              
235             # NOT
236 6 100       34 if ($node->{_not}) {
237 1         7 my ($s, @b) = $self->_render_where($node->{_not});
238 1         12 return ("NOT ($s)", @b);
239             }
240              
241 5         10 return ($node->{sql}, @{$node->{bind}});
  5         34  
242             }
243              
244             sub _render_alias {
245 28     28   83 my ($self, $node) = @_;
246 28         392 my ($sql, @bind) = $self->render($node->{expr});
247             # Wrap subselects in parens
248 28 100       210 if ($node->{expr}->isa('SQL::Wizard::Expr::Select')) {
249 4         15 $sql = "($sql)";
250             }
251 28         89 return ("$sql AS " . $self->_quote_ident_if_needed($node->{alias}), @bind);
252             }
253              
254             sub _render_order {
255 6     6   12 my ($self, $node) = @_;
256 6         55 my ($sql, @bind) = $self->_render_expr($node->{expr});
257 6         15 $sql .= " $node->{direction}";
258 6 100       18 $sql .= " NULLS $node->{nulls}" if $node->{nulls};
259 6         28 return ($sql, @bind);
260             }
261              
262             sub _render_func {
263 31     31   71 my ($self, $node) = @_;
264 31         75 my @arg_sqls;
265             my @bind;
266 31         72 for my $arg (@{$node->{args}}) {
  31         191  
267 28         73 my ($s, @b) = $self->_render_expr($arg);
268 28         80 push @arg_sqls, $s;
269 28         71 push @bind, @b;
270             }
271 31         147 my $args_str = join(', ', @arg_sqls);
272 31         226 return ("$node->{name}($args_str)", @bind);
273             }
274              
275             sub _render_binop {
276 14     14   42 my ($self, $node) = @_;
277 14         86 my ($lsql, @lbind) = $self->render($node->{left});
278 14         42 my ($rsql, @rbind) = $self->render($node->{right});
279 14         103 return ("$lsql $node->{op} $rsql", @lbind, @rbind);
280             }
281              
282             ## SELECT
283              
284             sub _render_select {
285 140     140   273 my ($self, $node) = @_;
286 140         252 my @parts;
287             my @bind;
288              
289             # CTE
290 140 100       460 if ($node->{_cte}) {
291 4         11 my ($cte_sql, @cte_bind) = $self->render($node->{_cte});
292 4         7 push @parts, $cte_sql;
293 4         6 push @bind, @cte_bind;
294             }
295              
296             # SELECT columns
297 140         226 my @col_sqls;
298 140 100       223 for my $col (@{$node->{columns} || ['*']}) {
  140         539  
299 172         424 my ($s, @b) = $self->_render_expr($col);
300 172         378 push @col_sqls, $s;
301 172         392 push @bind, @b;
302             }
303 140 100       446 my $select_keyword = $node->{distinct} ? "SELECT DISTINCT" : "SELECT";
304 140         506 push @parts, "$select_keyword " . join(', ', @col_sqls);
305              
306             # FROM
307 140 50       353 if ($node->{from}) {
308 140         223 my @from_sqls;
309 140 100       436 my @from_items = ref $node->{from} eq 'ARRAY' ? @{$node->{from}} : ($node->{from});
  12         28  
310 140         391 for my $i (0 .. $#from_items) {
311 152         280 my $item = $from_items[$i];
312 152 100 100     447 if (blessed($item) && $item->isa('SQL::Wizard::Expr::Join')) {
313 12         30 my ($s, @b) = $self->render($item);
314 12         19 push @from_sqls, $s;
315 12         21 push @bind, @b;
316             } else {
317 140         326 my ($s, @b) = $self->_expand_table($item);
318             # First item or non-join items
319 140 50       316 if ($i == 0) {
320 140         275 push @from_sqls, $s;
321             } else {
322 0         0 push @from_sqls, $s;
323             }
324 140         306 push @bind, @b;
325             }
326             }
327 140         449 push @parts, "FROM " . join(' ', @from_sqls);
328             }
329              
330             # WHERE
331 140 100       341 if ($node->{where}) {
332 72         212 my ($wsql, @wbind) = $self->_render_where($node->{where});
333 71 100 66     273 if (defined $wsql && $wsql ne '') {
334 69         132 push @parts, "WHERE $wsql";
335 69         154 push @bind, @wbind;
336             }
337             }
338              
339             # GROUP BY
340 139 100       316 if ($node->{group_by}) {
341 7 50       35 my @items = ref $node->{group_by} eq 'ARRAY' ? @{$node->{group_by}} : ($node->{group_by});
  0         0  
342 7         14 my @gsqls;
343 7         19 for my $g (@items) {
344 7         34 my ($s, @b) = $self->_render_expr($g);
345 7         18 push @gsqls, $s;
346 7         18 push @bind, @b;
347             }
348 7         23 push @parts, "GROUP BY " . join(', ', @gsqls);
349             }
350              
351             # HAVING
352 139 100       347 if ($node->{having}) {
353 3         14 my ($hsql, @hbind) = $self->_render_where($node->{having});
354 3 100 66     20 if (defined $hsql && $hsql ne '') {
355 1         3 push @parts, "HAVING $hsql";
356 1         3 push @bind, @hbind;
357             }
358             }
359              
360             # WINDOW
361 139 100       282 if ($node->{window}) {
362 2         5 my @wdefs;
363 2         4 for my $name (sort keys %{$node->{window}}) {
  2         13  
364 2 50       23 confess "Invalid window name '$name'" unless $name =~ /^\w+$/;
365 2         8 my $spec = $node->{window}{$name};
366 2         9 my ($s, @b) = $self->_render_window_spec($spec);
367 2         8 push @wdefs, $self->_quote_ident_if_needed($name) . " AS ($s)";
368 2         6 push @bind, @b;
369             }
370 2         9 push @parts, "WINDOW " . join(', ', @wdefs);
371             }
372              
373             # ORDER BY
374 139 100       312 if ($node->{order_by}) {
375 7 100       26 my @items = ref $node->{order_by} eq 'ARRAY' ? @{$node->{order_by}} : ($node->{order_by});
  3         10  
376 7         11 my @osqls;
377 7         19 for my $o (@items) {
378 8 100 66     54 if (ref $o eq 'HASH') {
    50          
    100          
379             # { -desc => 'col' } or { -asc => 'col' }
380 2         7 my ($dir, $col) = each %$o;
381 2         6 $dir = uc($dir);
382 2         12 $dir =~ s/^-//;
383 2 50       13 $self->_assert_order_column($col) unless ref $col;
384 2         7 my ($s, @b) = $self->_render_expr($col);
385 2         7 push @osqls, "$s $dir";
386 2         5 push @bind, @b;
387             } elsif (!ref $o && $o =~ /^-(.+)/) {
388             # '-col' shorthand for col DESC
389 0         0 $self->_assert_order_column($1);
390 0         0 my ($s, @b) = $self->_render_expr($1);
391 0         0 push @osqls, "$s DESC";
392 0         0 push @bind, @b;
393             } elsif (!ref $o) {
394 4         15 $self->_assert_order_column($o);
395 4         10 my ($s, @b) = $self->_render_expr($o);
396 4         9 push @osqls, $s;
397 4         8 push @bind, @b;
398             } else {
399 2         8 my ($s, @b) = $self->_render_expr($o);
400 2         5 push @osqls, $s;
401 2         4 push @bind, @b;
402             }
403             }
404 7         53 push @parts, "ORDER BY " . join(', ', @osqls);
405             }
406              
407             # LIMIT / OFFSET
408 139 100       353 if (defined $node->{limit}) {
409 4         15 $self->_assert_integer('-limit', $node->{limit});
410 4         7 push @parts, "LIMIT ?";
411 4         7 push @bind, $node->{limit};
412             }
413 139 100       303 if (defined $node->{offset}) {
414 3         10 $self->_assert_integer('-offset', $node->{offset});
415 3         7 push @parts, "OFFSET ?";
416 3         5 push @bind, $node->{offset};
417             }
418              
419 139         1276 return (join(' ', @parts), @bind);
420             }
421              
422             ## JOIN
423              
424             sub _render_join {
425 13     13   23 my ($self, $node) = @_;
426 13         16 my @bind;
427              
428 13         146 my ($table_sql, @tb) = $self->_expand_table($node->{table});
429 13         22 push @bind, @tb;
430              
431 13         26 my $sql = "$node->{type} $table_sql";
432              
433 13 100       26 if (defined $node->{on}) {
434 12 100       43 if (ref $node->{on} eq 'HASH') {
435 1         4 my ($on_sql, @ob) = $self->_render_where($node->{on});
436 1         1 $sql .= " ON $on_sql";
437 1         6 push @bind, @ob;
438             } else {
439             # String ON condition
440 11         29 $self->_injection_guard($node->{on});
441 11         26 $sql .= " ON $node->{on}";
442             }
443             }
444              
445 13         55 return ($sql, @bind);
446             }
447              
448             ## CASE
449              
450             sub _render_case {
451 6     6   15 my ($self, $node) = @_;
452 6         10 my @parts;
453             my @bind;
454              
455 6         11 push @parts, 'CASE';
456              
457             # CASE ON (simple case with operand)
458 6 100       42 if ($node->{operand}) {
459 1         5 my ($os, @ob) = $self->_render_expr($node->{operand});
460 1         4 $parts[0] .= " $os";
461 1         2 push @bind, @ob;
462             }
463              
464 6         7 for my $when (@{$node->{whens}}) {
  6         18  
465 9 100       19 if ($node->{operand}) {
466             # Simple CASE: WHEN value THEN result
467 2         4 my ($ws, @wb) = $self->_render_expr($when->{condition});
468 2         4 my ($ts, @tb) = $self->_render_expr($when->{then});
469 2         5 push @parts, "WHEN $ws THEN $ts";
470 2         4 push @bind, @wb, @tb;
471             } else {
472             # Searched CASE: WHEN condition THEN result
473 7         46 my ($ws, @wb) = $self->_render_where($when->{condition});
474 7         13 my ($ts, @tb) = $self->_render_expr($when->{then});
475 7         15 push @parts, "WHEN $ws THEN $ts";
476 7         15 push @bind, @wb, @tb;
477             }
478             }
479              
480 6 100       13 if (defined $node->{else}) {
481 5         7 my ($es, @eb) = $self->_render_expr($node->{else});
482 5         11 push @parts, "ELSE $es";
483 5         7 push @bind, @eb;
484             }
485              
486 6         9 push @parts, 'END';
487 6         37 return (join(' ', @parts), @bind);
488             }
489              
490             ## Window
491              
492             sub _render_window {
493 9     9   21 my ($self, $node) = @_;
494 9         32 my ($expr_sql, @bind) = $self->render($node->{expr});
495              
496 9         26 my $spec = $node->{spec};
497 9 100       26 if ($spec->{name}) {
498 4 50       28 confess "Invalid window name '$spec->{name}'" unless $spec->{name} =~ /^\w+$/;
499 4         20 return ("$expr_sql OVER " . $self->_quote_ident_if_needed($spec->{name}), @bind);
500             }
501              
502 5         17 my ($spec_sql, @sb) = $self->_render_window_spec($spec);
503 5         9 push @bind, @sb;
504 5         39 return ("$expr_sql OVER ($spec_sql)", @bind);
505             }
506              
507             sub _render_window_spec {
508 7     7   18 my ($self, $spec) = @_;
509 7         13 my @parts;
510             my @bind;
511              
512 7 100       22 if ($spec->{'-partition_by'}) {
513             my @items = ref $spec->{'-partition_by'} eq 'ARRAY'
514 6 100       27 ? @{$spec->{'-partition_by'}} : ($spec->{'-partition_by'});
  1         3  
515 6         12 my @sqls;
516 6         13 for my $p (@items) {
517 7         20 my ($s, @b) = $self->_render_expr($p);
518 7         53 push @sqls, $s;
519 7         19 push @bind, @b;
520             }
521 6         28 push @parts, "PARTITION BY " . join(', ', @sqls);
522             }
523              
524 7 50       24 if ($spec->{'-order_by'}) {
525             my @items = ref $spec->{'-order_by'} eq 'ARRAY'
526 7 100       27 ? @{$spec->{'-order_by'}} : ($spec->{'-order_by'});
  3         11  
527 7         12 my @sqls;
528 7         16 for my $o (@items) {
529 7 100 33     39 if (ref $o eq 'HASH') {
    50          
    50          
530 3         12 my ($dir, $col) = each %$o;
531 3         9 $dir = uc($dir);
532 3         13 $dir =~ s/^-//;
533 3 50       17 $self->_assert_order_column($col) unless ref $col;
534 3         8 my ($s, @b) = $self->_render_expr($col);
535 3         12 push @sqls, "$s $dir";
536 3         10 push @bind, @b;
537             } elsif (!ref $o && $o =~ /^-(.+)/) {
538 0         0 $self->_assert_order_column($1);
539 0         0 my ($s, @b) = $self->_render_expr($1);
540 0         0 push @sqls, "$s DESC";
541 0         0 push @bind, @b;
542             } elsif (!ref $o) {
543 4         13 $self->_assert_order_column($o);
544 4         9 my ($s, @b) = $self->_render_expr($o);
545 4         11 push @sqls, $s;
546 4         10 push @bind, @b;
547             } else {
548 0         0 my ($s, @b) = $self->_render_expr($o);
549 0         0 push @sqls, $s;
550 0         0 push @bind, @b;
551             }
552             }
553 7         28 push @parts, "ORDER BY " . join(', ', @sqls);
554             }
555              
556 7 100       20 if ($spec->{'-frame'}) {
557 1         5 $self->_injection_guard($spec->{'-frame'});
558 1         3 push @parts, $spec->{'-frame'};
559             }
560              
561 7         28 return (join(' ', @parts), @bind);
562             }
563              
564             ## Compound (UNION/INTERSECT/EXCEPT)
565              
566             sub _render_compound {
567 9     9   20 my ($self, $node) = @_;
568 9         15 my @parts;
569             my @bind;
570              
571 9         14 for my $entry (@{$node->{queries}}) {
  9         30  
572 20         60 my ($s, @b) = $self->render($entry->{query});
573 20 100       62 if ($entry->{type}) {
574 11         26 push @parts, $entry->{type};
575             }
576 20         48 push @parts, "($s)";
577 20         49 push @bind, @b;
578             }
579              
580             # ORDER BY / LIMIT / OFFSET on the compound
581 9 100       27 if ($node->{order_by}) {
582 1 50       7 my @items = ref $node->{order_by} eq 'ARRAY' ? @{$node->{order_by}} : ($node->{order_by});
  0         0  
583 1         2 my @osqls;
584 1         3 for my $o (@items) {
585 1 50 33     16 if (ref $o eq 'HASH') {
    50          
    50          
586 0         0 my ($dir, $col) = each %$o;
587 0         0 $dir = uc($dir);
588 0         0 $dir =~ s/^-//;
589 0 0       0 $self->_assert_order_column($col) unless ref $col;
590 0         0 my ($s, @b) = $self->_render_expr($col);
591 0         0 push @osqls, "$s $dir";
592 0         0 push @bind, @b;
593             } elsif (!ref $o && $o =~ /^-(.+)/) {
594 0         0 $self->_assert_order_column($1);
595 0         0 my ($s, @b) = $self->_render_expr($1);
596 0         0 push @osqls, "$s DESC";
597 0         0 push @bind, @b;
598             } elsif (!ref $o) {
599 1         6 $self->_assert_order_column($o);
600 1         4 my ($s, @b) = $self->_render_expr($o);
601 1         3 push @osqls, $s;
602 1         3 push @bind, @b;
603             } else {
604 0         0 my ($s, @b) = $self->_render_expr($o);
605 0         0 push @osqls, $s;
606 0         0 push @bind, @b;
607             }
608             }
609 1         5 push @parts, "ORDER BY " . join(', ', @osqls);
610             }
611 9 100       26 if (defined $node->{limit}) {
612 1         5 $self->_assert_integer('-limit', $node->{limit});
613 1         2 push @parts, "LIMIT ?";
614 1         3 push @bind, $node->{limit};
615             }
616 9 50       26 if (defined $node->{offset}) {
617 0         0 $self->_assert_integer('-offset', $node->{offset});
618 0         0 push @parts, "OFFSET ?";
619 0         0 push @bind, $node->{offset};
620             }
621              
622 9         79 return (join(' ', @parts), @bind);
623             }
624              
625             ## CTE
626              
627             sub _render_cte {
628 4     4   7 my ($self, $node) = @_;
629 4         8 my @parts;
630             my @bind;
631              
632 4 100       11 my $keyword = $node->{recursive} ? 'WITH RECURSIVE' : 'WITH';
633              
634 4         6 my @cte_sqls;
635 4         5 for my $cte (@{$node->{ctes}}) {
  4         14  
636 5         9 my $name = $cte->{name};
637 5         11 $self->_injection_guard($name);
638 5         9 my $query = $cte->{query};
639              
640             # Recursive CTE with -initial and -recurse
641 5 100 66     45 if (ref $query eq 'HASH' && $query->{'-initial'}) {
642 1         5 my ($is, @ib) = $self->render($query->{'-initial'});
643 1         3 my ($rs, @rb) = $self->render($query->{'-recurse'});
644 1         5 push @cte_sqls, $self->_quote_ident_if_needed($name) . " AS ($is UNION ALL $rs)";
645 1         5 push @bind, @ib, @rb;
646             } else {
647 4         8 my ($s, @b) = $self->render($query);
648 4         7 push @cte_sqls, $self->_quote_ident_if_needed($name) . " AS ($s)";
649 4         9 push @bind, @b;
650             }
651             }
652              
653 4         20 return ("$keyword " . join(', ', @cte_sqls), @bind);
654             }
655              
656             ## INSERT
657              
658             sub _render_insert {
659 7     7   16 my ($self, $node) = @_;
660 7         13 my @parts;
661             my @bind;
662              
663 7         43 $self->_injection_guard($node->{into});
664 7         23 push @parts, "INSERT INTO " . $self->_quote_ident_if_needed($node->{into});
665              
666 7 100       35 if ($node->{select}) {
    100          
    50          
667             # INSERT ... SELECT
668 1 50       4 if ($node->{columns}) {
669 1         2 $self->_assert_column($_) for @{$node->{columns}};
  1         5  
670 1         3 push @parts, "(" . join(', ', map { $self->_quote_ident_if_needed($_) } @{$node->{columns}}) . ")";
  2         6  
  1         3  
671             }
672 1         5 my ($s, @b) = $self->render($node->{select});
673 1         3 push @parts, $s;
674 1         3 push @bind, @b;
675             } elsif (ref $node->{values} eq 'HASH') {
676             # Single row insert from hash
677 5         10 my @cols = sort keys %{$node->{values}};
  5         26  
678 5         17 $self->_assert_column($_) for @cols;
679 5         10 my @vals;
680 5         11 for my $col (@cols) {
681 9         22 my $v = $node->{values}{$col};
682 9         20 my ($s, @b) = $self->_render_expr($v);
683 9         31 push @vals, $s;
684 9         25 push @bind, @b;
685             }
686 5         13 push @parts, "(" . join(', ', map { $self->_quote_ident_if_needed($_) } @cols) . ")";
  9         23  
687 5         21 push @parts, "VALUES (" . join(', ', @vals) . ")";
688             } elsif (ref $node->{values} eq 'ARRAY') {
689             # Multi-row insert
690 1 50       4 if ($node->{columns}) {
691 1         3 $self->_assert_column($_) for @{$node->{columns}};
  1         5  
692 1         4 push @parts, "(" . join(', ', map { $self->_quote_ident_if_needed($_) } @{$node->{columns}}) . ")";
  2         5  
  1         3  
693             }
694 1         3 my @row_sqls;
695 1         3 for my $row (@{$node->{values}}) {
  1         3  
696 2         3 my @vals;
697 2         4 for my $v (@$row) {
698 4         27 my ($s, @b) = $self->_render_expr($v);
699 4         8 push @vals, $s;
700 4         11 push @bind, @b;
701             }
702 2         9 push @row_sqls, "(" . join(', ', @vals) . ")";
703             }
704 1         5 push @parts, "VALUES " . join(', ', @row_sqls);
705             }
706              
707             # ON CONFLICT (PostgreSQL)
708 7 100       26 if ($node->{on_conflict}) {
709 1         3 my $oc = $node->{on_conflict};
710 1         3 my $target = $oc->{'-target'};
711 1         4 $self->_injection_guard($target);
712 1         3 my $update = $oc->{'-update'};
713 1         3 my @set_parts;
714 1         5 for my $col (sort keys %$update) {
715 1         4 $self->_assert_column($col);
716 1         4 my ($s, @b) = $self->_render_expr($update->{$col});
717 1         4 push @set_parts, $self->_quote_ident_if_needed($col) . " = $s";
718 1         11 push @bind, @b;
719             }
720 1         4 my $quoted_target = join(', ', map { $self->_quote_ident_if_needed(s/^\s+|\s+$//gr) } split /,/, $target);
  1         6  
721 1         6 push @parts, "ON CONFLICT ($quoted_target) DO UPDATE SET " . join(', ', @set_parts);
722             }
723              
724             # ON DUPLICATE KEY (MySQL)
725 7 100       17 if ($node->{on_duplicate}) {
726 1         2 my @set_parts;
727 1         3 for my $col (sort keys %{$node->{on_duplicate}}) {
  1         4  
728 1         5 $self->_assert_column($col);
729 1         5 my ($s, @b) = $self->_render_expr($node->{on_duplicate}{$col});
730 1         4 push @set_parts, $self->_quote_ident_if_needed($col) . " = $s";
731 1         4 push @bind, @b;
732             }
733 1         4 push @parts, "ON DUPLICATE KEY UPDATE " . join(', ', @set_parts);
734             }
735              
736             # RETURNING
737 7 100       56 if ($node->{returning}) {
738 1         2 $self->_assert_column($_) for @{$node->{returning}};
  1         5  
739 1         2 push @parts, "RETURNING " . join(', ', map { $self->_quote_ident_if_needed($_) } @{$node->{returning}});
  2         6  
  1         3  
740             }
741              
742 7         64 return (join(' ', @parts), @bind);
743             }
744              
745             ## UPDATE
746              
747             sub _render_update {
748 6     6   14 my ($self, $node) = @_;
749 6         12 my @parts;
750             my @bind;
751              
752             # Table (possibly with joins)
753 6 100       22 if (ref $node->{table} eq 'ARRAY') {
754 1         2 my @table_parts;
755 1         3 for my $item (@{$node->{table}}) {
  1         3  
756 2 100 66     19 if (blessed($item) && $item->isa('SQL::Wizard::Expr::Join')) {
757 1         3 my ($s, @b) = $self->render($item);
758 1         2 push @table_parts, $s;
759 1         4 push @bind, @b;
760             } else {
761 1         4 my ($s, @b) = $self->_expand_table($item);
762 1         3 push @table_parts, $s;
763 1         3 push @bind, @b;
764             }
765             }
766 1         6 push @parts, "UPDATE " . join(' ', @table_parts);
767             } else {
768 5         16 my ($ts, @tb) = $self->_expand_table($node->{table});
769 5         16 push @parts, "UPDATE $ts";
770 5         28 push @bind, @tb;
771             }
772              
773             # SET
774 6         10 my @set_parts;
775 6         9 for my $col (sort keys %{$node->{set}}) {
  6         31  
776 7         22 $self->_assert_column($col);
777 7         24 my ($s, @b) = $self->_render_expr($node->{set}{$col});
778 7         19 push @set_parts, $self->_quote_ident_if_needed($col) . " = $s";
779 7         21 push @bind, @b;
780             }
781 6         21 push @parts, "SET " . join(', ', @set_parts);
782              
783             # FROM (PostgreSQL)
784 6 100       18 if ($node->{from}) {
785 1 50       6 my @from_items = ref $node->{from} eq 'ARRAY' ? @{$node->{from}} : ($node->{from});
  1         5  
786 1         2 my @from_sqls;
787 1         3 for my $item (@from_items) {
788 1         19 my ($s, @b) = $self->_expand_table($item);
789 1         4 push @from_sqls, $s;
790 1         3 push @bind, @b;
791             }
792 1         29 push @parts, "FROM " . join(', ', @from_sqls);
793             }
794              
795             # WHERE
796 6 100       18 if ($node->{where}) {
797 5         17 my ($ws, @wb) = $self->_render_where($node->{where});
798 5 50 33     31 if (defined $ws && $ws ne '') {
799 5         11 push @parts, "WHERE $ws";
800 5         13 push @bind, @wb;
801             }
802             }
803              
804             # LIMIT (MySQL UPDATE ... LIMIT n)
805 6 100       17 if (defined $node->{limit}) {
806 1         6 $self->_assert_integer('-limit', $node->{limit});
807 1         2 push @parts, "LIMIT ?";
808 1         3 push @bind, $node->{limit};
809             }
810              
811             # RETURNING
812 6 100       17 if ($node->{returning}) {
813 1         3 $self->_assert_column($_) for @{$node->{returning}};
  1         5  
814 1         4 push @parts, "RETURNING " . join(', ', map { $self->_quote_ident_if_needed($_) } @{$node->{returning}});
  2         6  
  1         3  
815             }
816              
817 6         62 return (join(' ', @parts), @bind);
818             }
819              
820             ## DELETE
821              
822             sub _render_delete {
823 6     6   8 my ($self, $node) = @_;
824 6         9 my @parts;
825             my @bind;
826              
827 6         14 $self->_injection_guard($node->{from});
828 6         14 push @parts, "DELETE FROM " . $self->_quote_ident_if_needed($node->{from});
829              
830             # USING (PostgreSQL)
831 6 100       17 if ($node->{using}) {
832 1         3 $self->_injection_guard($node->{using});
833 1         2 push @parts, "USING " . $self->_quote_ident_if_needed($node->{using});
834             }
835              
836             # WHERE
837 6 100       10 if ($node->{where}) {
838 5         13 my ($ws, @wb) = $self->_render_where($node->{where});
839 5 50 33     17 if (defined $ws && $ws ne '') {
840 5         7 push @parts, "WHERE $ws";
841 5         7 push @bind, @wb;
842             }
843             }
844              
845             # RETURNING
846 6 100       15 if ($node->{returning}) {
847 1         2 $self->_assert_column($_) for @{$node->{returning}};
  1         4  
848 1         2 push @parts, "RETURNING " . join(', ', map { $self->_quote_ident_if_needed($_) } @{$node->{returning}});
  2         3  
  1         2  
849             }
850              
851 6         33 return (join(' ', @parts), @bind);
852             }
853              
854             ## WHERE clause rendering (self-contained, SQL::Abstract-compatible syntax)
855              
856             sub _render_where {
857 109     109   217 my ($self, $where) = @_;
858              
859             # Expression object
860 109 100 66     317 if (blessed($where) && $where->isa('SQL::Wizard::Expr')) {
861 1         5 return $self->render($where);
862             }
863              
864             # Hashref: { col => val, col2 => { '>' => 3 } }
865 108 100       314 if (ref $where eq 'HASH') {
866 99         166 my @parts;
867             my @bind;
868 99         354 for my $key (sort keys %$where) {
869 101         208 my $val = $where->{$key};
870              
871             # Expression object as key (e.g. $q->func(...) => { '>' => 5 })
872 101 50 33     243 if (blessed($key) && $key->isa('SQL::Wizard::Expr')) {
873 0         0 my ($ks, @kb) = $self->render($key);
874 0         0 my ($vs, @vb) = $self->_render_where_value($ks, $val);
875 0         0 push @parts, $vs;
876 0         0 push @bind, @kb, @vb;
877 0         0 next;
878             }
879              
880 101         262 $self->_injection_guard($key);
881 101         227 my $qkey = $self->_quote_ident_if_needed($key);
882              
883 101 100 66     577 if (!defined $val) {
    100          
    100          
    100          
884 2         7 push @parts, "$qkey IS NULL";
885             } elsif (blessed($val) && $val->isa('SQL::Wizard::Expr')) {
886 6         40 my ($vs, @vb) = $self->render($val);
887 6         22 push @parts, "$qkey = $vs";
888 6         16 push @bind, @vb;
889             } elsif (ref $val eq 'HASH') {
890 42         139 my ($s, @b) = $self->_render_where_value($qkey, $val);
891 41         83 push @parts, $s;
892 41         87 push @bind, @b;
893             } elsif (ref $val eq 'ARRAY') {
894             # { col => [1,2,3] } => col IN (?,?,?)
895 2 100       6 if (!@$val) {
896 1         3 push @parts, '1 = 0';
897             } else {
898 1         3 my @placeholders;
899 1         3 for my $v (@$val) {
900 3 50 33     12 if (blessed($v) && $v->isa('SQL::Wizard::Expr')) {
901 0         0 my ($s, @b) = $self->render($v);
902 0         0 push @placeholders, $s;
903 0         0 push @bind, @b;
904             } else {
905 3         7 push @placeholders, '?';
906 3         5 push @bind, $v;
907             }
908             }
909 1         6 push @parts, "$qkey IN (" . join(', ', @placeholders) . ")";
910             }
911             } else {
912 49         112 push @parts, "$qkey = ?";
913 49         113 push @bind, $val;
914             }
915             }
916 98         394 return (join(' AND ', @parts), @bind);
917             }
918              
919             # Arrayref: [-and => ..., -or => ...]
920 9 100       36 if (ref $where eq 'ARRAY') {
921 8         35 return $self->_render_where_array($where);
922             }
923              
924             # Plain string
925 1         4 $self->_injection_guard($where);
926 1         3 return ($where, ());
927             }
928              
929             sub _render_where_value {
930 42     42   103 my ($self, $col, $val) = @_;
931              
932 42 50       139 if (ref $val eq 'HASH') {
933 42         82 my @parts;
934             my @bind;
935 42         135 for my $op (sort keys %$val) {
936 42         79 my $rhs = $val->{$op};
937 42         81 my $sql_op = uc($op);
938              
939             confess "Unknown operator '$op' in WHERE clause"
940 42 100       637 unless $VALID_OPS{$sql_op};
941              
942             # -in / -not_in
943 41 100 100     265 if ($sql_op eq '-IN' || $sql_op eq '-NOT_IN') {
    100 66        
    100          
944 10 100       38 my $neg = $sql_op eq '-NOT_IN' ? 'NOT ' : '';
945 10 100 66     67 if (blessed($rhs) && $rhs->isa('SQL::Wizard::Expr')) {
    50          
946 4         15 my ($s, @b) = $self->render($rhs);
947 4         16 push @parts, "$col ${neg}IN ($s)";
948 4         10 push @bind, @b;
949             } elsif (ref $rhs eq 'ARRAY') {
950 6 100       15 if (!@$rhs) {
951             # Empty list: -in => always false, -not_in => always true
952 2 100       9 push @parts, $neg ? '1 = 1' : '1 = 0';
953             } else {
954 4         7 my @ph;
955 4         11 for my $v (@$rhs) {
956 9 50 33     43 if (blessed($v) && $v->isa('SQL::Wizard::Expr')) {
957 0         0 my ($s, @b) = $self->render($v);
958 0         0 push @ph, $s;
959 0         0 push @bind, @b;
960             } else {
961 9         15 push @ph, '?';
962 9         37 push @bind, $v;
963             }
964             }
965 4         26 push @parts, "$col ${neg}IN (" . join(', ', @ph) . ")";
966             }
967             }
968             } elsif (!defined $rhs) {
969 3 100 100     13 if ($sql_op eq '!=' || $sql_op eq '<>') {
970 2         23 push @parts, "$col IS NOT NULL";
971             } else {
972 1         5 push @parts, "$col IS NULL";
973             }
974             } elsif (blessed($rhs) && $rhs->isa('SQL::Wizard::Expr')) {
975 3         11 my ($s, @b) = $self->render($rhs);
976 3 100       22 $s = "($s)" if $rhs->isa('SQL::Wizard::Expr::Select');
977 3         12 push @parts, "$col $sql_op $s";
978 3         9 push @bind, @b;
979             } else {
980 25         78 push @parts, "$col $sql_op ?";
981 25         58 push @bind, $rhs;
982             }
983             }
984 41         196 return (join(' AND ', @parts), @bind);
985             }
986              
987 0         0 return ("$col = ?", $val);
988             }
989              
990             sub _render_where_array {
991 13     13   33 my ($self, $arr, $default_logic) = @_;
992 13         31 my @items = @$arr;
993 13         27 my @parts;
994             my @bind;
995              
996 13   100     59 my $logic = $default_logic || 'AND';
997              
998 13         22 my $i = 0;
999 13         68 while ($i <= $#items) {
1000 19         34 my $item = $items[$i];
1001              
1002 19 100 66     90 if (!ref $item && $item =~ /^-(and|or)$/i) {
1003 6         22 $logic = uc($1);
1004 6         11 $i++;
1005             # Next item could be arrayref of conditions
1006 6 100 66     30 if ($i <= $#items && ref $items[$i] eq 'ARRAY') {
1007 4         19 my ($s, @b) = $self->_render_where_array($items[$i], $logic);
1008 4         10 push @parts, $s;
1009 4         7 push @bind, @b;
1010 4         9 $i++;
1011             }
1012 6         17 next;
1013             }
1014              
1015 13 100 33     51 if (ref $item eq 'HASH') {
    100          
    50          
1016 11         48 my ($s, @b) = $self->_render_where($item);
1017 11         24 push @parts, $s;
1018 11         21 push @bind, @b;
1019             } elsif (ref $item eq 'ARRAY') {
1020 1         8 my ($s, @b) = $self->_render_where_array($item);
1021 1         4 push @parts, "($s)";
1022 1         3 push @bind, @b;
1023             } elsif (blessed($item) && $item->isa('SQL::Wizard::Expr')) {
1024 1         9 my ($s, @b) = $self->render($item);
1025 1         2 push @parts, $s;
1026 1         3 push @bind, @b;
1027             }
1028              
1029 13         32 $i++;
1030             }
1031              
1032 13         43 my $joined = join(" $logic ", @parts);
1033 13 100       43 $joined = "($joined)" if @parts > 1;
1034 13         65 return ($joined, @bind);
1035             }
1036              
1037             1;