File Coverage

blib/lib/SQL/Format.pm
Criterion Covered Total %
statement 461 468 98.5
branch 250 268 93.2
condition 99 127 77.9
subroutine 25 25 100.0
pod 10 10 100.0
total 845 898 94.1


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