File Coverage

blib/lib/SQL/Format.pm
Criterion Covered Total %
statement 466 472 98.7
branch 257 272 94.4
condition 100 127 78.7
subroutine 25 25 100.0
pod 10 10 100.0
total 858 906 94.7


line stmt bran cond sub pod time code
1             package SQL::Format;
2              
3 18     18   423651 use strict;
  18         39  
  18         480  
4 18     18   84 use warnings;
  18         28  
  18         391  
5 18     18   377 use 5.010_000;
  18         58  
6             our $VERSION = '0.19';
7              
8 18     18   102 use Exporter 'import';
  18         33  
  18         551  
9 18     18   120 use Carp qw(croak carp);
  18         34  
  18         3257  
10              
11             our @EXPORT = qw(sqlf);
12              
13             our $DELIMITER = ', ';
14             our $NAME_SEP = '.';
15             our $QUOTE_CHAR = '`';
16             our $LIMIT_DIALECT = 'LimitOffset';
17              
18             our $SELF = __PACKAGE__->new;
19              
20             my $SPEC_TO_METHOD_MAP = {
21             '%c' => '_columns',
22             '%t' => '_table',
23             '%w' => '_where',
24             '%o' => '_options',
25             '%j' => '_join',
26             '%s' => '_set',
27             };
28              
29             my $OP_ALIAS = {
30             -IN => 'IN',
31             -NOT_IN => 'NOT IN',
32             -BETWEEN => 'BETWEEN',
33             -NOT_BETWEEN => 'NOT BETWEEN',
34             -LIKE => 'LIKE',
35             -NOT_LIKE => 'NOT LIKE',
36             -LIKE_BINARY => 'LIKE BINARY',
37             -NOT_LIKE_BINARY => 'NOT LIKE BINARY',
38             };
39              
40             my $OP_TYPE_MAP = {
41             in => {
42             'IN' => 1,
43             'NOT IN' => 1,
44             },
45             between => {
46             'BETWEEN' => 1,
47             'NOT BETWEEN' => 1,
48             },
49             like => {
50             'LIKE' => 1,
51             'NOT LIKE' => 1,
52             'LIKE BINARY' => 1,
53             'NOT LIKE BINARY' => 1,
54             },
55             };
56              
57             my $SORT_OP_ALIAS = {
58             -ASC => 'ASC',
59             -DESC => 'DESC',
60             };
61              
62             my $SUPPORTED_INDEX_TYPE_MAP = {
63             USE => 1,
64             FORCE => 1,
65             IGNORE => 1,
66             };
67              
68             use constant {
69 18         84842 _LIMIT_OFFSET => 1,
70             _LIMIT_XY => 2,
71             _LIMIT_YX => 3,
72 18     18   101 };
  18         38  
73             my $LIMIT_DIALECT_MAP = {
74             LimitOffset => _LIMIT_OFFSET, # PostgreSQL, SQLite, MySQL 5.0
75             LimitXY => _LIMIT_XY, # MySQL
76             LimitYX => _LIMIT_YX, # SQLite
77             };
78              
79             sub sqlf {
80 190     190 1 377263 my $format = shift;
81              
82 190         251 my @bind;
83 190         1000 my @tokens = split m#(%[ctwosj])(?=\W|$)#, $format;
84 190         526 for (my $i = 1; $i < @tokens; $i += 2) {
85 213         321 my $spec = $tokens[$i];
86 213         356 my $method = $SPEC_TO_METHOD_MAP->{$spec};
87 213 50       374 croak "'$spec' does not supported format" unless $method;
88 213 100       616 croak sprintf "missing arguments nummber of %i and '%s' format in sqlf",
89             ($i + 1) / 2, $spec unless @_;
90              
91 211         593 $tokens[$i] = $SELF->$method(shift(@_), \@bind);
92             }
93              
94 185         762 return join('',@tokens), @bind;
95             }
96              
97             sub _columns {
98 30     30   63 my ($self, $val, $bind) = @_;
99 30         48 my $ret;
100              
101 30 100       97 if (!defined $val) {
    100          
    100          
102 3         5 $ret = '*';
103             }
104             elsif (ref $val eq 'ARRAY') {
105 17 100       32 if (@$val) {
106             $ret = join $DELIMITER, map {
107 16         31 my $ret;
  26         32  
108 26         46 my $ref = ref $_;
109 26 100 66     102 if ($ref eq 'HASH') {
    100          
    100          
110 1         4 my ($term, $col) = %$_;
111 1         3 $ret = _quote($term).' '._quote($col);
112             }
113             elsif ($ref eq 'ARRAY') {
114 4         6 my ($term, $col) = @$_;
115 4         6 my @params;
116 4 100 66     17 if (ref $term eq 'ARRAY') {
    100          
117 1         3 ($term, @params) = @$term;
118             }
119             elsif (ref $term eq 'REF' && ref $$term eq 'ARRAY') {
120 1         2 ($term, @params) = @{$$term};
  1         3  
121             }
122              
123             $ret = (
124 4 100       13 ref $term eq 'SCALAR' ? $$term : _quote($term)
125             ).' '._quote($col);
126 4         10 push @$bind, @params;
127             }
128             elsif ($ref eq 'REF' && ref $$_ eq 'ARRAY') {
129 1         2 my ($term, $col, @params) = @{$$_};
  1         3  
130 1 50       5 $ret = (
131             ref $term eq 'SCALAR' ? $$term : _quote($term)
132             ).' '._quote($col);
133 1         3 push @$bind, @params;
134             }
135             else {
136 20         38 $ret = _quote($_)
137             }
138 26         58 $ret;
139             } @$val;
140             }
141             else {
142 1         1 $ret = '*';
143             }
144             }
145             elsif (ref $val eq 'SCALAR') {
146 1         2 $ret = $$val;
147             }
148             else {
149 9         19 $ret = _quote($val);
150             }
151              
152 30         123 return $ret;
153             }
154              
155             sub _table {
156 39     39   77 my ($self, $val, $bind) = @_;
157 39         52 my $ret;
158              
159 39 100       136 if (ref $val eq 'ARRAY') {
    100          
    50          
160             $ret = join $DELIMITER, map {
161 2         5 my $v = $_;
  5         7  
162 5         5 my $ret;
163 5 100       11 if (ref $v eq 'HASH') {
164 2         4 $ret = _complex_table_expr($v);
165             }
166             else {
167 3         5 $ret = _quote($v);
168             }
169 5         11 $ret;
170             } @$val;
171             }
172             elsif (ref $val eq 'HASH') {
173 12         26 $ret = _complex_table_expr($val);
174             }
175             elsif (defined $val) {
176 25         45 $ret = _quote($val);
177             }
178             else {
179             # noop
180             }
181              
182 39         109 return $ret;
183             }
184              
185             sub _where {
186 138     138   251 my ($self, $val, $bind, $logic) = @_;
187              
188 138 100       278 if (ref $val eq 'ARRAY') {
189 8         10 my @ret;
190 8         14 for my $v (@$val) {
191 19         54 push @ret, $self->_where($v, $bind);
192             }
193 8   100     23 $logic ||= 'OR';
194 8 50       16 return @ret == 1 ? $ret[0] : join " $logic ", map { "($_)" } @ret;
  17         48  
195             }
196              
197 130 100       237 return unless ref $val eq 'HASH';
198              
199 128 100       233 return '(1=1)' unless %$val;
200              
201             my $ret = join ' AND ', map {
202 126         394 my $org_key = $_;
  144         232  
203 144         169 my $no_paren = 0;
204 144         232 my ($k, $v) = (_quote($org_key), $val->{$org_key});
205 144 100 66     724 if (uc $org_key eq '-OR') {
    100          
    100          
    100          
    100          
    100          
    100          
206 3         6 $k = $self->_where($v, $bind);
207             }
208             elsif (uc $org_key eq '-AND') {
209 4         11 $k = $self->_where($v, $bind, 'AND');
210             }
211             elsif (ref $v eq 'ARRAY') {
212 15 100 100     85 if (
    100 100        
      100        
      100        
213             ref $v->[0]
214             or (($v->[0]||'') eq '-and')
215             or (($v->[0]||'') eq '-or')
216             ) {
217             # [-and => qw/foo bar baz/]
218             # [-and => { '>' => 10 }, { '<' => 20 } ]
219             # [-or => qw/foo bar baz/]
220             # [-or => { '>' => 10 }, { '<' => 20 } ]
221             # [{ '>' => 10 }, { '<' => 20 } ]
222 9         15 my $logic = 'OR';
223 9         16 my @values = @$v;
224 9 100 66     42 if ($v->[0] && $v->[0] eq '-and') {
    100 66        
225 4         8 $logic = 'AND';
226 4         11 @values = @values[1..$#values];
227             }
228             elsif ($v->[0] && $v->[0] eq '-or') {
229 4         12 @values = @values[1..$#values];
230             }
231 9         12 my @statements;
232 9         15 for my $arg (@values) {
233 20         45 my ($_stmt, @_bind) = sqlf('%w', { $org_key => $arg });
234 20         43 push @statements, $_stmt;
235 20         38 push @$bind, @_bind;
236             }
237 9         24 $k = join " $logic ", @statements;
238             }
239             elsif (@$v == 0) {
240             # []
241 1         3 $k = '0=1';
242             }
243             else {
244             # [qw/1 2 3/]
245 5         17 $k .= ' IN ('.join($DELIMITER, ('?')x@$v).')';
246 5         10 push @$bind, @$v;
247             }
248             }
249             elsif (ref $v eq 'HASH') {
250 60 100       156 my $no_paren = scalar keys %$v > 1 ? 0 : 1;
251             $k = join ' AND ', map {
252 60         130 my $k = $k;
  62         97  
253 62         124 my ($op, $v) = (uc($_), $v->{$_});
254 62   66     193 $op = $OP_ALIAS->{$op} || $op;
255 62 100 66     259 if ($OP_TYPE_MAP->{in}{$op}) {
    100          
    100          
    100          
    100          
    100          
256 18         29 my $ref = ref $v;
257 18 100       48 if ($ref eq 'ARRAY') {
    100          
    100          
    100          
258 10 100       19 unless (@$v) {
259             # { IN => [] }
260 2 100       6 $k = $op eq 'IN' ? '0=1' : '1=1';
261             }
262             else {
263             # { IN => [qw/1 2 3/] }
264 8         33 $k .= " $op (".join($DELIMITER, ('?')x@$v).')';
265 8         15 push @$bind, @$v;
266             }
267             }
268             elsif ($ref eq 'REF') {
269             # { IN => \['SELECT foo FROM bar WHERE hoge = ?', 'fuga']
270 2         5 $k .= " $op (${$v}->[0])";
  2         6  
271 2         6 push @$bind, @{$$v}[1..$#$$v];
  2         6  
272             }
273             elsif ($ref eq 'SCALAR') {
274             # { IN => \'SELECT foo FROM bar' }
275 2         8 $k .= " $op ($$v)";
276             }
277             elsif (defined $v) {
278             # { IN => 'foo' }
279 2 100       6 $k .= $op eq 'IN' ? ' = ?' : ' <> ?';
280 2         4 push @$bind, $v;
281             }
282             else {
283             # { IN => undef }
284 2 100       5 $k .= $op eq 'IN' ? ' IS NULL' : ' IS NOT NULL';
285             }
286             }
287             elsif ($OP_TYPE_MAP->{between}{$op}) {
288 10         17 my $ref = ref $v;
289 10 100       31 if ($ref eq 'ARRAY') {
    100          
    50          
290             # { BETWEEN => ['foo', 'bar'] }
291             # { BETWEEN => [\'lower(x)', \['upper(?)', 'y']] }
292 6         12 my ($va, $vb) = @$v;
293 6         9 my @stmt;
294 6         13 for my $value ($va, $vb) {
295 12 100       29 if (ref $value eq 'SCALAR') {
    100          
296 2         6 push @stmt, $$value;
297             }
298             elsif (ref $value eq 'REF') {
299 2         4 push @stmt, ${$value}->[0];
  2         6  
300 2         8 push @$bind, @{$$value}[1..$#$$value];
  2         6  
301             }
302             else {
303 8         12 push @stmt, '?';
304 8         13 push @$bind, $value;
305             }
306             }
307 6         27 $k .= " $op ".join ' AND ', @stmt;
308             }
309             elsif ($ref eq 'REF') {
310             # { BETWEEN => \["? AND ?", 1, 2] }
311 2         6 $k .= " $op ${$v}->[0]";
  2         6  
312 2         7 push @$bind, @{$$v}[1..$#$$v];
  2         6  
313             }
314             elsif ($ref eq 'SCALAR') {
315             # { BETWEEN => \'lower(x) AND upper(y)' }
316 2         8 $k .= " $op $$v";
317             }
318             else {
319             # { BETWEEN => $scalar }
320             # noop
321             }
322             }
323             elsif ($OP_TYPE_MAP->{like}{$op}) {
324 15         26 my $ref = ref $v;
325 15         18 my $escape_char;
326 15 100       34 if ($ref eq 'HASH') {
327 3         7 ($escape_char, $v) = %$v;
328 3         6 $ref = ref $v;
329             }
330 15 100       37 if ($ref eq 'ARRAY') {
    100          
331             # { LIKE => ['%foo', 'bar%'] }
332             # { LIKE => [\'"%foo"', \'"bar%"'] }
333 3         4 my @stmt;
334 3         7 for my $value (@$v) {
335 6 100       15 if (ref $value eq 'SCALAR') {
336 3         27 push @stmt, $$value;
337             }
338             else {
339 3         6 push @stmt, '?';
340 3         4 push @$bind, $value;
341             }
342 6 100       27 if ($escape_char) {
343 2         5 $stmt[-1] .= ' ESCAPE ?';
344 2         3 push @$bind, $escape_char;
345             }
346             }
347 3         7 $k = join ' OR ', map { "$k $op $_" } @stmt;
  6         20  
348             }
349             elsif ($ref eq 'SCALAR') {
350             # { LIKE => \'"foo%"' }
351 3         10 $k .= " $op $$v";
352 3 100       12 if ($escape_char) {
353 1         2 $k .= ' ESCAPE ?';
354 1         3 push @$bind, $escape_char;
355             }
356             }
357             else {
358 9         18 $k .= " $op ?";
359 9         16 push @$bind, $v;
360 9 100       19 if ($escape_char) {
361 1         3 $k .= ' ESCAPE ?';
362 1         2 push @$bind, $escape_char;
363             }
364             }
365             }
366             elsif (ref $v eq 'SCALAR') {
367             # { '>' => \'foo' }
368 1         3 $k .= " $op $$v";
369             }
370             elsif (ref $v eq 'ARRAY') {
371 6 100       15 if ($op eq '=') {
    50          
372 3 100       5 unless (@$v) {
373 1         3 $k = '0=1';
374             }
375             else {
376 2         7 $k .= " IN (".join($DELIMITER, ('?')x@$v).')';
377 2         4 push @$bind, @$v;
378             }
379             }
380             elsif ($op eq '!=') {
381 3 100       6 unless (@$v) {
382 1         2 $k = '1=1';
383             }
384             else {
385 2         8 $k .= " NOT IN (".join($DELIMITER, ('?')x@$v).')';
386 2         4 push @$bind, @$v;
387             }
388             }
389             else {
390             # { '>' => [qw/1 2 3/] }
391 0         0 $k .= join ' OR ', map { "$op ?" } @$v;
  0         0  
392 0         0 push @$bind, @$v;
393             }
394             }
395             elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') {
396             # { '>' => \['UNIX_TIMESTAMP(?)', '2012-12-12 00:00:00'] }
397 2         6 $k .= " $op ${$v}->[0]";
  2         6  
398 2         7 push @$bind, @{$$v}[1..$#$$v];
  2         4  
399             }
400             else {
401             # { '>' => 'foo' }
402 10         20 $k .= " $op ?";
403 10         14 push @$bind, $v;
404             }
405 62 100       196 $no_paren ? $k : "($k)";
406             } sort keys %$v;
407             }
408             elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') {
409 2         7 $k .= " IN ($$v->[0])";
410 2         7 push @$bind, @{$$v}[1..$#$$v];
  2         5  
411             }
412             elsif (ref $v eq 'SCALAR') {
413             # \'foo'
414 1         4 $k .= " $$v";
415             }
416             elsif (!defined $v) {
417             # undef
418 1         2 $k .= ' IS NULL';
419             }
420             else {
421             # 'foo'
422 58         91 $k .= ' = ?';
423 58         86 push @$bind, $v;
424             }
425 144 50       465 $no_paren ? $k : "($k)";
426             } sort keys %$val;
427              
428 126         401 return $ret;
429             }
430              
431             sub _options {
432 24     24   53 my ($self, $val, $bind) = @_;
433              
434 24         36 my @exprs;
435 24 100       57 if (exists $val->{group_by}) {
436 7         20 my $ret = _sort_expr($val->{group_by});
437 7         18 push @exprs, 'GROUP BY '.$ret;
438             }
439 24 100       53 if (exists $val->{having}) {
440 2         6 my ($ret, @new_bind) = sqlf('%w', $val->{having});
441 2         5 push @exprs, 'HAVING '.$ret;
442 2         6 push @$bind, @new_bind;
443             }
444 24 100       55 if (exists $val->{order_by}) {
445 10         28 my $ret = _sort_expr($val->{order_by});
446 10         29 push @exprs, 'ORDER BY '.$ret;
447             }
448 24 100       58 if (defined $val->{limit}) {
449 8 100       110 croak "limit must be numeric specified ($val->{limit})" if $val->{limit} =~ /\D/;
450 7         14 my $ret = 'LIMIT ';
451 7 100       18 if ($val->{offset}) { # defined and > 0
452 5 100       100 croak "offset must be numeric specified ($val->{offset})" if $val->{offset} =~ /\D/;
453 4   100     17 my $limit_dialect = $LIMIT_DIALECT_MAP->{$LIMIT_DIALECT} || 0;
454 4 100       27 if ($limit_dialect == _LIMIT_OFFSET) {
    50          
    50          
455 3         12 $ret .= "$val->{limit} OFFSET $val->{offset}";
456             }
457             elsif ($limit_dialect == _LIMIT_XY) {
458 0         0 $ret .= "$val->{offset}, $val->{limit}";
459             }
460             elsif ($limit_dialect == _LIMIT_YX) {
461 0         0 $ret .= "$val->{limit}, $val->{offset}";
462             }
463             else {
464 1         108 croak "Unkown LIMIT_DIALECT `$LIMIT_DIALECT`";
465 0         0 $ret .= $val->{limit};
466             }
467             }
468             else {
469 2         4 $ret .= $val->{limit};
470             }
471 5         10 push @exprs, $ret;
472             }
473              
474 21         93 return join ' ', @exprs;
475             }
476              
477             sub _join {
478 12     12   24 my ($self, $val, $bind) = @_;
479              
480 12         15 my @statements;
481 12 100       39 $val = [$val] unless ref $val eq 'ARRAY';
482 12         21 for my $param (@$val) {
483 13 50       34 croak '%j mast be HASH ref specified' unless ref $param eq 'HASH';
484             croak 'table and condition options must be specified at %j'
485 13 50 33     62 unless $param->{table} && $param->{condition};
486              
487 13   100     80 my $ret = sprintf '%s JOIN ', uc($param->{type} || 'INNER');
488 13         37 $ret .= $self->_table($param->{table}, $bind);
489              
490 13 100       45 if (ref $param->{condition} eq 'ARRAY') {
    100          
491             $ret .= ' USING ('.(
492 2         5 join $DELIMITER, map { _quote($_) } @{$param->{condition}}
  3         8  
  2         6  
493             ).')';
494             }
495             elsif (ref $param->{condition} eq 'HASH') {
496 10         15 my $cond = $param->{condition};
497 10 100       30 my $no_paren = keys %$cond > 1 ? 0 : 1;
498             $ret .= ' ON '.(join ' AND ', map {
499 10         27 my ($k, $v) = ($_, $cond->{$_});
  11         25  
500 11         15 my $ret;
501 11 100 66     43 if (uc $k eq '-WHERE') {
    100          
    100          
502 1         4 $ret = $self->_where($v, $bind);
503             }
504             elsif (ref $v eq 'HASH') {
505 2 100       7 my $no_paren = keys %$v > 1 ? 0 : 1;
506             $ret = join ' AND ', map {
507 2         8 my $op = $_;
  3         5  
508 3         4 my $ret;
509 3 100 66     11 if (ref $v->{$op} eq 'REF' && ref ${$v->{$op}} eq 'ARRAY') {
  1         4  
510 1         3 my $v = ${$v->{$op}};
  1         2  
511 1         4 $ret = _quote($k)." $op ".$v->[0];
512 1         6 push @$bind, @{$v}[1..$#$v];
  1         5  
513             }
514             else {
515 2         4 $ret = _quote($k)." $op "._quote($v->{$_});
516             }
517 3 100       14 $no_paren ? $ret : "($ret)";
518             } sort keys %$v;
519             }
520             elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') {
521 1         3 my $v = $$v;
522 1         2 $ret = _quote($k).' = '._quote($v->[0]);
523 1         4 push @$bind, @{$v}[1..$#$v];
  1         3  
524             }
525             else {
526 7         14 $ret = _quote($k).' = '._quote($v);
527             }
528 11 100       54 $no_paren ? $ret : "($ret)";
529             } sort keys %$cond);
530             }
531             else {
532 1         4 $ret .= ' ON '.$param->{condition};
533             }
534 13         35 push @statements, $ret;
535             }
536              
537 12         54 return join ' ', @statements;
538             }
539              
540             sub _quote {
541 385     385   16969 my $stuff = shift;
542 385 100       661 return $$stuff if ref $stuff eq 'SCALAR';
543 383 100 100     1137 return $stuff unless $QUOTE_CHAR && $NAME_SEP;
544 381 100       637 return $stuff if $stuff eq '*';
545 374 100       698 return $stuff if substr($stuff, 0, 1) eq $QUOTE_CHAR; # skip if maybe quoted
546 372 100       722 return $stuff if $stuff =~ /\(/; # skip if maybe used function
547             return join $NAME_SEP, map {
548 369         1148 "$QUOTE_CHAR$_$QUOTE_CHAR"
  394         1587  
549             } split /\Q$NAME_SEP\E/, $stuff;
550             }
551              
552             sub _complex_table_expr {
553 14     14   21 my $stuff = shift;
554             my $ret = join $DELIMITER, map {
555 14         52 my ($k, $v) = ($_, $stuff->{$_});
  16         33  
556 16         30 my $ret = _quote($k);
557 16 100       37 if (ref $v eq 'HASH') {
558 4 100       10 $ret .= ' '._quote($v->{alias}) if $v->{alias};
559 4 50 33     14 if (exists $v->{index} && ref $v->{index}) {
560 4   100     15 my $type = uc($v->{index}{type} || 'USE');
561             croak "unkown index type: $type"
562 4 50       8 unless $SUPPORTED_INDEX_TYPE_MAP->{$type};
563             croak "keys field must be specified in index option"
564 4 50       9 unless defined $v->{index}{keys};
565 4         6 my $keys = $v->{index}{keys};
566 4 100       11 $keys = [ $keys ] unless ref $keys eq 'ARRAY';
567             $ret .= " $type INDEX (".join($DELIMITER,
568 4         10 map { _quote($_) } @$keys
  7         10  
569             ).")";
570             }
571             }
572             else {
573 12         23 $ret .= ' '._quote($v);
574             }
575 16         43 $ret;
576             } sort keys %$stuff;
577              
578 14         31 return $ret;
579             }
580              
581             sub _sort_expr {
582 17     17   26 my $stuff = shift;
583 17         27 my $ret = '';
584 17 100       69 if (!defined $stuff) {
    100          
    100          
585             # undef
586 2         4 $ret .= 'NULL';
587             }
588             elsif (ref $stuff eq 'HASH') {
589             # { colA => 'DESC' }
590             # { -asc => 'colB' }
591             $ret .= join $DELIMITER, map {
592 6 100       28 if (my $sort_op = $SORT_OP_ALIAS->{uc $_}) {
  8         28  
593 4         11 _quote($stuff->{$_}).' '.$sort_op,
594             }
595             else {
596 4         12 _quote($_).' '.$stuff->{$_}
597             }
598             } sort keys %$stuff;
599             }
600             elsif (ref $stuff eq 'ARRAY') {
601             # ['column1', { column2 => 'DESC', -asc => 'column3' }]
602 2         4 my @parts;
603 2         5 for my $part (@$stuff) {
604 4 100       10 if (ref $part eq 'HASH') {
605             push @parts, join $DELIMITER, map {
606 2 100       13 if (my $sort_op = $SORT_OP_ALIAS->{uc $_}) {
  4         14  
607 2         8 _quote($part->{$_}).' '.$sort_op,
608             }
609             else {
610 2         4 _quote($_).' '.$part->{$_}
611             }
612             } sort keys %$part;
613             }
614             else {
615 2         5 push @parts, _quote($part);
616             }
617             }
618 2         6 $ret .= join $DELIMITER, @parts;
619             }
620             else {
621             # 'column'
622 7         19 $ret .= _quote($stuff);
623             }
624 17         43 return $ret;
625             }
626              
627             sub _set {
628 20     20   41 my ($self, $val, $bind) = @_;
629              
630 20 100       85 my @set = ref $val eq 'HASH' ? map { $_ => $val->{$_} } sort keys %$val : @$val;
  11         81  
631 20         70 my @columns;
632 20         50 for (my $i = 0; $i < @set; $i += 2) {
633 26         58 my ($col, $val) = ($set[$i], $set[$i+1]);
634 26         42 my $quoted_col = _quote($col);
635 26 100 66     90 if (ref $val eq 'SCALAR') {
    100          
636             # foo => { bar => \'NOW()' }
637 4         17 push @columns, "$quoted_col = $$val";
638             }
639             elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') {
640             # foo => { bar => \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11'] }
641 3         5 my ($stmt, @sub_bind) = @{$$val};
  3         10  
642 3         8 push @columns, "$quoted_col = $stmt";
643 3         12 push @$bind, @sub_bind;
644             }
645             else {
646             # foo => { bar => 'baz' }
647 19         39 push @columns, "$quoted_col = ?";
648 19         67 push @$bind, $val;
649             }
650             }
651              
652 20         80 my $ret = join $self->{delimiter}, @columns;
653             }
654              
655             sub new {
656 74     74 1 97781 my ($class, %args) = @_;
657              
658 74 100 66     294 if (exists $args{driver} && defined $args{driver}) {
659 3         8 my $driver = lc $args{driver};
660 3 100       7 unless (defined $args{quote_char}) {
661 2 100       7 $args{quote_char} = $driver eq 'mysql' ? '`' : '"';
662             }
663 3 100       6 unless (defined $args{limit_dialect}) {
664             $args{limit_dialect} =
665 2 100       6 $driver eq 'mysql' ? 'LimitXY' : 'LimitOffset';
666             }
667             }
668              
669             bless {
670 74         555 delimiter => $DELIMITER,
671             name_sep => $NAME_SEP,
672             quote_char => $QUOTE_CHAR,
673             limit_dialect => $LIMIT_DIALECT,
674             %args,
675             }, $class;
676             }
677              
678             sub format {
679 2     2 1 1537 my $self = shift;
680 2         4 local $SELF = $self;
681 2         6 local $DELIMITER = $self->{delimiter};
682 2         5 local $NAME_SEP = $self->{name_sep};
683 2         3 local $QUOTE_CHAR = $self->{quote_char};
684 2         3 local $LIMIT_DIALECT = $self->{limit_dialect};
685 2         5 sqlf(@_);
686             }
687              
688             sub select {
689 15     15 1 11252 my ($self, $table, $cols, $where, $opts) = @_;
690 15 100       140 croak 'Usage: $sqlf->select($table [, \@cols, \%where, \%opts])' unless defined $table;
691              
692 14         20 local $SELF = $self;
693 14         38 local $DELIMITER = $self->{delimiter};
694 14         20 local $NAME_SEP = $self->{name_sep};
695 14         21 local $QUOTE_CHAR = $self->{quote_char};
696 14         21 local $LIMIT_DIALECT = $self->{limit_dialect};
697              
698 14 100       28 if (delete $opts->{for_update}) {
699 2 100       6 if (exists $opts->{suffix}) {
700 1         62 croak 'Conflict option `for_update` and `suffix`. `for_update` option is ignored.';
701             }
702             else {
703 1         2 $opts->{suffix} = 'FOR UPDATE';
704             }
705             }
706              
707 13   100     45 my $prefix = delete $opts->{prefix} || 'SELECT';
708 13         21 my $suffix = delete $opts->{suffix};
709 13         23 my $format = "$prefix %c FROM %t";
710 13         23 my @args = ($cols, $table);
711              
712 13 100       29 if (my $join = delete $opts->{join}) {
713 1         2 $format .= ' %j';
714 1         2 push @args, $join;
715             }
716 13 100 66     65 if ($where && (ref $where eq 'HASH' && keys %$where) || (ref $where eq 'ARRAY' && @$where)) {
      100        
      33        
      66        
717 6         30 $format .= ' WHERE %w';
718 6         8 push @args, $where;
719             }
720 13 100       30 if (keys %$opts) {
721 3         5 $format .= ' %o';
722 3         5 push @args, $opts;
723             }
724 13 100       20 if ($suffix) {
725 2         3 $format .= " $suffix";
726             }
727              
728 13         25 sqlf($format, @args);
729             }
730              
731             sub insert {
732 8     8 1 6736 my ($self, $table, $values, $opts) = @_;
733 8 100 100     203 croak 'Usage: $sqlf->insert($table \%values|\@values [, \%opts])' unless defined $table && ref $values;
734              
735 6         11 local $SELF = $self;
736 6         19 local $DELIMITER = $self->{delimiter};
737 6         9 local $NAME_SEP = $self->{name_sep};
738 6         10 local $QUOTE_CHAR = $self->{quote_char};
739 6         9 local $LIMIT_DIALECT = $self->{limit_dialect};
740              
741 6   100     22 my $prefix = $opts->{prefix} || 'INSERT INTO';
742 6         18 my $quoted_table = _quote($table);
743              
744 6 100       33 my @values = ref $values eq 'HASH' ? %$values : @$values;
745 6         67 my (@columns, @bind_cols, @bind_params);
746 6         16 for (my $i = 0; $i < @values; $i += 2) {
747 9         22 my ($col, $val) = ($values[$i], $values[$i+1]);
748 9         17 push @columns, _quote($col);
749 9 100 66     31 if (ref $val eq 'SCALAR') {
    100          
750             # foo => { bar => \'NOW()' }
751 1         11 push @bind_cols, $$val;
752             }
753             elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') {
754             # foo => { bar => \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11'] }
755 1         2 my ($stmt, @sub_bind) = @{$$val};
  1         2  
756 1         2 push @bind_cols, $stmt;
757 1         4 push @bind_params, @sub_bind;
758             }
759             else {
760             # foo => { bar => 'baz' }
761 7         10 push @bind_cols, '?';
762 7         33 push @bind_params, $val;
763             }
764             }
765              
766             my $stmt = "$prefix $quoted_table "
767             . '('.join(', ', @columns).') '
768 6         26 . 'VALUES ('.join($self->{delimiter}, @bind_cols).')';
769              
770 6         26 return $stmt, @bind_params;
771             }
772              
773             sub update {
774 11     11 1 9831 my ($self, $table, $set, $where, $opts) = @_;
775 11 100 100     279 croak 'Usage: $sqlf->update($table \%set|\@set [, \%where, \%opts])' unless defined $table && ref $set;
776              
777 9         15 local $SELF = $self;
778 9         18 local $DELIMITER = $self->{delimiter};
779 9         13 local $NAME_SEP = $self->{name_sep};
780 9         13 local $QUOTE_CHAR = $self->{quote_char};
781 9         12 local $LIMIT_DIALECT = $self->{limit_dialect};
782              
783 9   100     27 my $prefix = delete $opts->{prefix} || 'UPDATE';
784 9         19 my $quoted_table = _quote($table);
785              
786 9         21 my $set_clause = $self->_set($set, \my @bind_params);
787 9         22 my $format = "$prefix $quoted_table SET ".$set_clause;
788              
789 9         12 my @args;
790 9 100 100     43 if ($where && (ref $where eq 'HASH' && keys %$where) || (ref $where eq 'ARRAY' && @$where)) {
      100        
      66        
      66        
791 2         3 $format .= ' WHERE %w';
792 2         4 push @args, $where;
793             }
794 9 100       19 if (keys %$opts) {
795 1         1 $format .= ' %o';
796 1         2 push @args, $opts;
797             }
798              
799 9         14 my ($stmt, @bind) = sqlf($format, @args);
800              
801 9         40 return $stmt, (@bind_params, @bind);
802             }
803              
804             sub delete {
805 7     7 1 5062 my ($self, $table, $where, $opts) = @_;
806 7 100       123 croak 'Usage: $sqlf->delete($table [, \%where, \%opts])' unless defined $table;
807              
808 6         11 local $SELF = $self;
809 6         11 local $DELIMITER = $self->{delimiter};
810 6         10 local $NAME_SEP = $self->{name_sep};
811 6         8 local $QUOTE_CHAR = $self->{quote_char};
812 6         8 local $LIMIT_DIALECT = $self->{limit_dialect};
813              
814 6   100     19 my $prefix = delete $opts->{prefix} || 'DELETE';
815 6         13 my $quoted_table = _quote($table);
816 6         12 my $format = "$prefix FROM $quoted_table";
817              
818 6         9 my @args;
819 6 100 100     37 if ($where && (ref $where eq 'HASH' && keys %$where) || (ref $where eq 'ARRAY' && @$where)) {
      100        
      66        
      66        
820 3         37 $format .= ' WHERE %w';
821 3         5 push @args, $where;
822             }
823 6 100       13 if (keys %$opts) {
824 1         2 $format .= ' %o';
825 1         1 push @args, $opts;
826             }
827              
828 6         14 sqlf($format, @args);
829             }
830              
831             sub insert_multi {
832 13     13 1 9956 my ($self, $table, $cols, $values, $opts) = @_;
833 13 100 100     368 croak 'Usage: $sqlf->insert_multi($table, \@cols, [ \@values1, \@values2, ... ] [, \%opts])'
834             unless ref $cols eq 'ARRAY' && ref $values eq 'ARRAY';
835              
836 10         16 local $SELF = $self;
837 10         24 local $DELIMITER = $self->{delimiter};
838 10         12 local $NAME_SEP = $self->{name_sep};
839 10         17 local $QUOTE_CHAR = $self->{quote_char};
840 10         13 local $LIMIT_DIALECT = $self->{limit_dialect};
841              
842 10   100     33 my $prefix = $opts->{prefix} || 'INSERT INTO';
843 10         25 my $quoted_table = _quote($table);
844              
845 10         18 my $columns_num = @$cols;
846 10         13 my @bind_params;
847             my @values_stmt;
848 10         32 for my $value (@$values) {
849 22         24 my @bind_cols;
850 22         40 for (my $i = 0; $i < $columns_num; $i++) {
851 44         62 my $val = $value->[$i];
852 44 100 66     90 if (ref $val eq 'SCALAR') {
    100          
853             # \'NOW()'
854 2         8 push @bind_cols, $$val;
855             }
856             elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') {
857             # \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11']
858 2         4 my ($expr, @sub_bind) = @{$$val};
  2         7  
859 2         4 push @bind_cols, $expr;
860 2         6 push @bind_params, @sub_bind;
861             }
862             else {
863             # 'baz'
864 40         49 push @bind_cols, '?';
865 40         70 push @bind_params, $val;
866             }
867             }
868 22         62 push @values_stmt, '('.join($self->{delimiter}, @bind_cols).')';
869             }
870              
871             my $stmt = "$prefix $quoted_table "
872 20         32 . '('.join($self->{delimiter}, map { _quote($_) } @$cols).') '
873 10         42 . 'VALUES '.join($self->{delimiter}, @values_stmt);
874              
875 10 100       26 if ($opts->{update}) {
876 2         8 my $update_stmt = $self->_set($opts->{update}, \@bind_params);
877 2         7 $stmt .= " ON DUPLICATE KEY UPDATE $update_stmt";
878             }
879              
880 10         50 return $stmt, @bind_params;
881             }
882              
883             sub insert_multi_from_hash {
884 8     8 1 11299 my ($self, $table, $values, $opts) = @_;
885 8 100 100     241 croak 'Usage: $sqlf->insert_multi_from_hash($table, [ { colA => $valA, colB => $valB }, { ... } ] [, \%opts])'
886             unless ref $values eq 'ARRAY' && ref $values->[0] eq 'HASH';
887              
888 5         6 my $cols = [ keys %{$values->[0]} ];
  5         26  
889 5         91 my $new_values = [];
890 5         10 for my $value (@$values) {
891 11         93 push @$new_values, [ @$value{@$cols} ];
892             }
893              
894 5         44 $self->insert_multi($table, $cols, $new_values, $opts);
895             }
896              
897             sub insert_on_duplicate {
898 1     1 1 887 my ($self, $table, $values, $update_values, $opts) = @_;
899 1 50 33     7 croak 'Usage: $sqlf->insert_on_duplicate($table, \%values|\@values, \%update_values|\@update_values [, \%opts])'
900             unless ref $values && ref $update_values;
901              
902 1         5 my ($stmt, @bind) = $self->insert($table, $values, $opts);
903 1         5 my $set_clause = $self->_set($update_values, \@bind);
904              
905 1         3 $stmt .= " ON DUPLICATE KEY UPDATE $set_clause";
906              
907 1         8 return $stmt, @bind;
908             }
909              
910             1;
911             __END__