File Coverage

blib/lib/SQL/Wizard/Renderer.pm
Criterion Covered Total %
statement 569 616 92.3
branch 216 264 81.8
condition 51 82 62.2
subroutine 35 35 100.0
pod 0 2 0.0
total 871 999 87.1


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