Looks like its finally solved
[scpubgit/Q-Branch.git] / lib / SQL / Abstract.pm
CommitLineData
96449e8e 1package SQL::Abstract; # see doc at end of file
2
3# LDNOTE : this code is heavy refactoring from original SQLA.
4# Several design decisions will need discussion during
5# the test / diffusion / acceptance phase; those are marked with flag
6# 'LDNOTE' (note by laurent.dami AT free.fr)
7
8use Carp;
9use strict;
10use warnings;
fffe6900 11use List::Util qw/first/;
12use Scalar::Util qw/blessed/;
96449e8e 13
14#======================================================================
15# GLOBALS
16#======================================================================
17
e6ea8200 18our $VERSION = '1.61';
7479e27e 19
22f1a437 20# This would confuse some packagers
21#$VERSION = eval $VERSION; # numify for warning-free dev releases
96449e8e 22
23our $AUTOLOAD;
24
25# special operators (-in, -between). May be extended/overridden by user.
26# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
27my @BUILTIN_SPECIAL_OPS = (
3a2e1a5e 28 {regex => qr/^(not )?between$/i, handler => '_where_field_BETWEEN'},
29 {regex => qr/^(not )?in$/i, handler => '_where_field_IN'},
96449e8e 30);
31
97a920ef 32# unaryish operators - key maps to handler
59f23b3d 33my @BUILTIN_UNARY_OPS = (
a47b433a 34 # the digits are backcompat stuff
35 { regex => qr/^and (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
36 { regex => qr/^or (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
37 { regex => qr/^nest (?: \s? \d+ )? $/xi, handler => '_where_op_NEST' },
38 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
59f23b3d 39);
97a920ef 40
96449e8e 41#======================================================================
42# DEBUGGING AND ERROR REPORTING
43#======================================================================
44
45sub _debug {
46 return unless $_[0]->{debug}; shift; # a little faster
47 my $func = (caller(1))[3];
48 warn "[$func] ", @_, "\n";
49}
50
51sub belch (@) {
52 my($func) = (caller(1))[3];
53 carp "[$func] Warning: ", @_;
54}
55
56sub puke (@) {
57 my($func) = (caller(1))[3];
58 croak "[$func] Fatal: ", @_;
59}
60
61
62#======================================================================
63# NEW
64#======================================================================
65
66sub new {
67 my $self = shift;
68 my $class = ref($self) || $self;
69 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
70
71 # choose our case by keeping an option around
72 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
73
74 # default logic for interpreting arrayrefs
ef559da3 75 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
96449e8e 76
77 # how to return bind vars
78 # LDNOTE: changed nwiger code : why this 'delete' ??
79 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
80 $opt{bindtype} ||= 'normal';
81
82 # default comparison is "=", but can be overridden
83 $opt{cmp} ||= '=';
84
2281c758 85 # generic SQL comparison operators
86 my $anchored_cmp_ops = join ('|', map { '^' . $_ . '$' } (
87 '(?:is \s+)? (?:not \s+)? like',
88 'is',
89 (map { quotemeta($_) } (qw/ < > != <> = <= >= /) ),
90 ));
91 $opt{cmp_ops} = qr/$anchored_cmp_ops/ix;
92
96449e8e 93 # try to recognize which are the 'equality' and 'unequality' ops
94 # (temporary quickfix, should go through a more seasoned API)
2281c758 95 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
96 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
96449e8e 97
98 # SQL booleans
99 $opt{sqltrue} ||= '1=1';
100 $opt{sqlfalse} ||= '0=1';
101
102 # special operators
103 $opt{special_ops} ||= [];
104 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
105
59f23b3d 106 # unary operators
107 $opt{unary_ops} ||= [];
108 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
109
96449e8e 110 return bless \%opt, $class;
111}
112
113
114
115#======================================================================
116# INSERT methods
117#======================================================================
118
119sub insert {
02288357 120 my $self = shift;
121 my $table = $self->_table(shift);
122 my $data = shift || return;
123 my $options = shift;
96449e8e 124
125 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
02288357 126 my ($sql, @bind) = $self->$method($data);
96449e8e 127 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
02288357 128
6b1fe79d 129 if (my $ret = $options->{returning}) {
130 $sql .= $self->_insert_returning ($ret);
02288357 131 }
132
96449e8e 133 return wantarray ? ($sql, @bind) : $sql;
134}
135
6b1fe79d 136sub _insert_returning {
137 my ($self, $fields) = @_;
138
139 my $f = $self->_SWITCH_refkind($fields, {
140 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$fields;},
141 SCALAR => sub {$self->_quote($fields)},
142 SCALARREF => sub {$$fields},
143 });
144 return join (' ', $self->_sqlcase(' returning'), $f);
145}
146
96449e8e 147sub _insert_HASHREF { # explicit list of fields and then values
148 my ($self, $data) = @_;
149
150 my @fields = sort keys %$data;
151
fe3ae272 152 my ($sql, @bind) = $self->_insert_values($data);
96449e8e 153
154 # assemble SQL
155 $_ = $self->_quote($_) foreach @fields;
156 $sql = "( ".join(", ", @fields).") ".$sql;
157
158 return ($sql, @bind);
159}
160
161sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
162 my ($self, $data) = @_;
163
164 # no names (arrayref) so can't generate bindtype
165 $self->{bindtype} ne 'columns'
166 or belch "can't do 'columns' bindtype when called with arrayref";
167
fe3ae272 168 # fold the list of values into a hash of column name - value pairs
169 # (where the column names are artificially generated, and their
170 # lexicographical ordering keep the ordering of the original list)
171 my $i = "a"; # incremented values will be in lexicographical order
172 my $data_in_hash = { map { ($i++ => $_) } @$data };
173
174 return $self->_insert_values($data_in_hash);
175}
176
177sub _insert_ARRAYREFREF { # literal SQL with bind
178 my ($self, $data) = @_;
179
180 my ($sql, @bind) = @${$data};
181 $self->_assert_bindval_matches_bindtype(@bind);
182
183 return ($sql, @bind);
184}
185
186
187sub _insert_SCALARREF { # literal SQL without bind
188 my ($self, $data) = @_;
189
190 return ($$data);
191}
192
193sub _insert_values {
194 my ($self, $data) = @_;
195
96449e8e 196 my (@values, @all_bind);
fe3ae272 197 foreach my $column (sort keys %$data) {
198 my $v = $data->{$column};
96449e8e 199
200 $self->_SWITCH_refkind($v, {
201
202 ARRAYREF => sub {
203 if ($self->{array_datatypes}) { # if array datatype are activated
204 push @values, '?';
fe3ae272 205 push @all_bind, $self->_bindtype($column, $v);
96449e8e 206 }
207 else { # else literal SQL with bind
208 my ($sql, @bind) = @$v;
fe3ae272 209 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 210 push @values, $sql;
211 push @all_bind, @bind;
212 }
213 },
214
215 ARRAYREFREF => sub { # literal SQL with bind
216 my ($sql, @bind) = @${$v};
fe3ae272 217 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 218 push @values, $sql;
219 push @all_bind, @bind;
220 },
221
222 # THINK : anything useful to do with a HASHREF ?
5db47f9f 223 HASHREF => sub { # (nothing, but old SQLA passed it through)
224 #TODO in SQLA >= 2.0 it will die instead
225 belch "HASH ref as bind value in insert is not supported";
226 push @values, '?';
fe3ae272 227 push @all_bind, $self->_bindtype($column, $v);
5db47f9f 228 },
96449e8e 229
230 SCALARREF => sub { # literal SQL without bind
231 push @values, $$v;
232 },
233
234 SCALAR_or_UNDEF => sub {
235 push @values, '?';
fe3ae272 236 push @all_bind, $self->_bindtype($column, $v);
96449e8e 237 },
238
239 });
240
241 }
242
243 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
244 return ($sql, @all_bind);
245}
246
247
96449e8e 248
249#======================================================================
250# UPDATE methods
251#======================================================================
252
253
254sub update {
255 my $self = shift;
256 my $table = $self->_table(shift);
257 my $data = shift || return;
258 my $where = shift;
259
260 # first build the 'SET' part of the sql statement
261 my (@set, @all_bind);
262 puke "Unsupported data type specified to \$sql->update"
263 unless ref $data eq 'HASH';
264
265 for my $k (sort keys %$data) {
266 my $v = $data->{$k};
267 my $r = ref $v;
268 my $label = $self->_quote($k);
269
270 $self->_SWITCH_refkind($v, {
271 ARRAYREF => sub {
272 if ($self->{array_datatypes}) { # array datatype
273 push @set, "$label = ?";
274 push @all_bind, $self->_bindtype($k, $v);
275 }
276 else { # literal SQL with bind
277 my ($sql, @bind) = @$v;
fe3ae272 278 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 279 push @set, "$label = $sql";
fe3ae272 280 push @all_bind, @bind;
96449e8e 281 }
282 },
283 ARRAYREFREF => sub { # literal SQL with bind
284 my ($sql, @bind) = @${$v};
fe3ae272 285 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 286 push @set, "$label = $sql";
fe3ae272 287 push @all_bind, @bind;
96449e8e 288 },
289 SCALARREF => sub { # literal SQL without bind
290 push @set, "$label = $$v";
291 },
292 SCALAR_or_UNDEF => sub {
293 push @set, "$label = ?";
294 push @all_bind, $self->_bindtype($k, $v);
295 },
296 });
297 }
298
299 # generate sql
300 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
301 . join ', ', @set;
302
303 if ($where) {
304 my($where_sql, @where_bind) = $self->where($where);
305 $sql .= $where_sql;
306 push @all_bind, @where_bind;
307 }
308
309 return wantarray ? ($sql, @all_bind) : $sql;
310}
311
312
313
314
315#======================================================================
316# SELECT
317#======================================================================
318
319
320sub select {
321 my $self = shift;
322 my $table = $self->_table(shift);
323 my $fields = shift || '*';
324 my $where = shift;
325 my $order = shift;
326
327 my($where_sql, @bind) = $self->where($where, $order);
328
329 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
330 : $fields;
331 my $sql = join(' ', $self->_sqlcase('select'), $f,
332 $self->_sqlcase('from'), $table)
333 . $where_sql;
334
335 return wantarray ? ($sql, @bind) : $sql;
336}
337
338#======================================================================
339# DELETE
340#======================================================================
341
342
343sub delete {
344 my $self = shift;
345 my $table = $self->_table(shift);
346 my $where = shift;
347
348
349 my($where_sql, @bind) = $self->where($where);
350 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
351
352 return wantarray ? ($sql, @bind) : $sql;
353}
354
355
356#======================================================================
357# WHERE: entry point
358#======================================================================
359
360
361
362# Finally, a separate routine just to handle WHERE clauses
363sub where {
364 my ($self, $where, $order) = @_;
365
366 # where ?
367 my ($sql, @bind) = $self->_recurse_where($where);
368 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
369
370 # order by?
371 if ($order) {
372 $sql .= $self->_order_by($order);
373 }
374
375 return wantarray ? ($sql, @bind) : $sql;
376}
377
378
379sub _recurse_where {
380 my ($self, $where, $logic) = @_;
381
382 # dispatch on appropriate method according to refkind of $where
383 my $method = $self->_METHOD_FOR_refkind("_where", $where);
311b2151 384
385
386 my ($sql, @bind) = $self->$method($where, $logic);
387
388 # DBIx::Class directly calls _recurse_where in scalar context, so
389 # we must implement it, even if not in the official API
390 return wantarray ? ($sql, @bind) : $sql;
96449e8e 391}
392
393
394
395#======================================================================
396# WHERE: top-level ARRAYREF
397#======================================================================
398
399
400sub _where_ARRAYREF {
5e1d09d5 401 my ($self, $where, $logic) = @_;
96449e8e 402
5e1d09d5 403 $logic = uc($logic || $self->{logic});
96449e8e 404 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
405
406 my @clauses = @$where;
407
96449e8e 408 my (@sql_clauses, @all_bind);
96449e8e 409 # need to use while() so can shift() for pairs
410 while (my $el = shift @clauses) {
411
412 # switch according to kind of $el and get corresponding ($sql, @bind)
413 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
414
415 # skip empty elements, otherwise get invalid trailing AND stuff
416 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
417
474e3335 418 ARRAYREFREF => sub { @{${$el}} if @{${$el}}},
419
96449e8e 420 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
421 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
422 # side-effect: the first hashref within an array would change
423 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
424 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
425 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
426
427 SCALARREF => sub { ($$el); },
428
429 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
430 $self->_recurse_where({$el => shift(@clauses)})},
431
432 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
433 });
434
4b7b6026 435 if ($sql) {
436 push @sql_clauses, $sql;
437 push @all_bind, @bind;
438 }
96449e8e 439 }
440
441 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
442}
443
474e3335 444#======================================================================
445# WHERE: top-level ARRAYREFREF
446#======================================================================
96449e8e 447
474e3335 448sub _where_ARRAYREFREF {
449 my ($self, $where) = @_;
450 my ($sql, @bind) = @{${$where}};
451
452 return ($sql, @bind);
453}
96449e8e 454
455#======================================================================
456# WHERE: top-level HASHREF
457#======================================================================
458
459sub _where_HASHREF {
460 my ($self, $where) = @_;
461 my (@sql_clauses, @all_bind);
462
2281c758 463 for my $k (sort keys %$where) {
96449e8e 464 my $v = $where->{$k};
465
2281c758 466 # ($k => $v) is either a special unary op or a regular hashpair
467 my ($sql, @bind) = do {
468 if ($k =~ /^-./) {
469 # put the operator in canonical form
470 my $op = $k;
471 $op =~ s/^-//; # remove initial dash
472 $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
473 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
474
475 $self->_debug("Unary OP(-$op) within hashref, recursing...");
476
477 my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
478 if (my $handler = $op_entry->{handler}) {
479 if (not ref $handler) {
480 if ($op =~ s/\s?\d+$//) {
481 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
482 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
483 }
484 $self->$handler ($op, $v);
485 }
486 elsif (ref $handler eq 'CODE') {
487 $handler->($self, $op, $v);
488 }
489 else {
490 puke "Illegal handler for operator $k - expecting a method name or a coderef";
491 }
492 }
493 else {
494 $self->debug("Generic unary OP: $k - recursing as function");
495 $self->_where_func_generic ($op, $v);
496 }
497 }
498 else {
499 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
500 $self->$method($k, $v);
501 }
502 };
96449e8e 503
504 push @sql_clauses, $sql;
505 push @all_bind, @bind;
506 }
507
508 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
509}
510
2281c758 511sub _where_func_generic {
512 my ($self, $op, $rhs) = @_;
96449e8e 513
2281c758 514 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
515 SCALAR => sub {
516 ($self->_convert('?'), $self->_bindtype('xxx', $rhs) );
517 },
518 FALLBACK => sub {
519 $self->_recurse_where ($rhs)
520 },
521 });
96449e8e 522
2281c758 523 $sql = sprintf ('%s%s',
524 $self->_sqlcase($op),
525 ($op =~ $self->{cmp_ops}) ? " $sql" : "( $sql )",
526 );
96449e8e 527
2281c758 528 return ($sql, @bind);
97a920ef 529}
530
531sub _where_op_ANDOR {
2281c758 532 my ($self, $op, $v) = @_;
97a920ef 533
534 $self->_SWITCH_refkind($v, {
535 ARRAYREF => sub {
536 return $self->_where_ARRAYREF($v, $op);
537 },
538
539 HASHREF => sub {
59f23b3d 540 return ( $op =~ /^or/i )
97a920ef 541 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
542 : $self->_where_HASHREF($v);
543 },
544
545 SCALARREF => sub {
546 puke "-$op => \\\$scalar not supported, use -nest => ...";
547 },
548
549 ARRAYREFREF => sub {
550 puke "-$op => \\[..] not supported, use -nest => ...";
551 },
552
553 SCALAR => sub { # permissively interpreted as SQL
554 puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
555 },
556
557 UNDEF => sub {
558 puke "-$op => undef not supported";
559 },
560 });
561}
562
563sub _where_op_NEST {
564 my ($self, $op, $v) = @_;
565
96449e8e 566 $self->_SWITCH_refkind($v, {
567
568 ARRAYREF => sub {
97a920ef 569 return $self->_where_ARRAYREF($v, '');
96449e8e 570 },
571
572 HASHREF => sub {
97a920ef 573 return $self->_where_HASHREF($v);
96449e8e 574 },
575
576 SCALARREF => sub { # literal SQL
96449e8e 577 return ($$v);
578 },
579
580 ARRAYREFREF => sub { # literal SQL
96449e8e 581 return @{${$v}};
582 },
583
584 SCALAR => sub { # permissively interpreted as SQL
01a01e57 585 belch "literal SQL should be -nest => \\'scalar' "
586 . "instead of -nest => 'scalar' ";
96449e8e 587 return ($v);
588 },
589
590 UNDEF => sub {
591 puke "-$op => undef not supported";
592 },
593 });
594}
595
596
97a920ef 597sub _where_op_BOOL {
598 my ($self, $op, $v) = @_;
599
ef03f1bc 600 my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
601 ? ( '(NOT ', ')' )
602 : ( '', '' );
ef03f1bc 603
2281c758 604 my ($sql, @bind) = do {
605 $self->_SWITCH_refkind($v, {
606 SCALAR => sub { # interpreted as SQL column
607 $self->_convert($self->_quote($v));
608 },
ef03f1bc 609
2281c758 610 UNDEF => sub {
611 puke "-$op => undef not supported";
612 },
97a920ef 613
2281c758 614 FALLBACK => sub {
615 $self->_recurse_where ($v);
616 },
617 });
618 };
ef03f1bc 619
2281c758 620 return (
621 join ('', $prefix, $sql, $suffix),
622 @bind,
623 );
97a920ef 624}
625
626
96449e8e 627sub _where_hashpair_ARRAYREF {
628 my ($self, $k, $v) = @_;
629
630 if( @$v ) {
631 my @v = @$v; # need copy because of shift below
632 $self->_debug("ARRAY($k) means distribute over elements");
633
634 # put apart first element if it is an operator (-and, -or)
e3cecb45 635 my $op = (
636 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
637 ? shift @v
638 : ''
04d940de 639 );
96449e8e 640 my @distributed = map { {$k => $_} } @v;
04d940de 641
642 if ($op) {
643 $self->_debug("OP($op) reinjected into the distributed array");
644 unshift @distributed, $op;
645 }
646
f67591bf 647 my $logic = $op ? substr($op, 1) : '';
96449e8e 648
f67591bf 649 return $self->_recurse_where(\@distributed, $logic);
96449e8e 650 }
651 else {
652 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
653 $self->_debug("empty ARRAY($k) means 0=1");
654 return ($self->{sqlfalse});
655 }
656}
657
658sub _where_hashpair_HASHREF {
eb49170d 659 my ($self, $k, $v, $logic) = @_;
660 $logic ||= 'and';
96449e8e 661
eb49170d 662 my ($all_sql, @all_bind);
96449e8e 663
a47b433a 664 for my $orig_op (sort keys %$v) {
665 my $val = $v->{$orig_op};
96449e8e 666
667 # put the operator in canonical form
a47b433a 668 my $op = $orig_op;
669 $op =~ s/^-//; # remove initial dash
670 $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
671 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
96449e8e 672
673 my ($sql, @bind);
674
2281c758 675 # CASE: col-value logic modifiers
676 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
677 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
678 }
96449e8e 679 # CASE: special operators like -in or -between
2281c758 680 elsif ( my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
3a2e1a5e 681 my $handler = $special_op->{handler};
682 if (! $handler) {
a47b433a 683 puke "No handler supplied for special operator $orig_op";
3a2e1a5e 684 }
685 elsif (not ref $handler) {
686 ($sql, @bind) = $self->$handler ($k, $op, $val);
687 }
688 elsif (ref $handler eq 'CODE') {
689 ($sql, @bind) = $handler->($self, $k, $op, $val);
690 }
691 else {
a47b433a 692 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
3a2e1a5e 693 }
96449e8e 694 }
96449e8e 695 else {
cf838930 696 $self->_SWITCH_refkind($val, {
697
698 ARRAYREF => sub { # CASE: col => {op => \@vals}
699 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
700 },
701
fe3ae272 702 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
b3be7bd0 703 my ($sub_sql, @sub_bind) = @$$val;
fe3ae272 704 $self->_assert_bindval_matches_bindtype(@sub_bind);
b3be7bd0 705 $sql = join ' ', $self->_convert($self->_quote($k)),
706 $self->_sqlcase($op),
707 $sub_sql;
fe3ae272 708 @bind = @sub_bind;
b3be7bd0 709 },
710
cf838930 711 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
712 my $is = ($op =~ $self->{equality_op}) ? 'is' :
713 ($op =~ $self->{inequality_op}) ? 'is not' :
a47b433a 714 puke "unexpected operator '$orig_op' with undef operand";
cf838930 715 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
716 },
a47b433a 717
2281c758 718 FALLBACK => sub { # CASE: col => {op/func => $stuff}
719 ($sql, @bind) = $self->_where_func_generic ($op, $val);
720 $sql = join ' ', $self->_convert($self->_quote($k)), $sql;
cf838930 721 },
722 });
96449e8e 723 }
724
eb49170d 725 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
96449e8e 726 push @all_bind, @bind;
727 }
eb49170d 728 return ($all_sql, @all_bind);
96449e8e 729}
730
731
732
733sub _where_field_op_ARRAYREF {
734 my ($self, $k, $op, $vals) = @_;
735
ce261791 736 my @vals = @$vals; #always work on a copy
737
738 if(@vals) {
bd6a65ca 739 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
740 $vals,
741 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
742 );
96449e8e 743
4030915f 744 # see if the first element is an -and/-or op
745 my $logic;
bd6a65ca 746 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
4030915f 747 $logic = uc $1;
ce261791 748 shift @vals;
4030915f 749 }
750
ce261791 751 # distribute $op over each remaining member of @vals, append logic if exists
752 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
4030915f 753
f2d5020d 754 # LDNOTE : had planned to change the distribution logic when
96449e8e 755 # $op =~ $self->{inequality_op}, because of Morgan laws :
756 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
757 # WHERE field != 22 OR field != 33 : the user probably means
758 # WHERE field != 22 AND field != 33.
4030915f 759 # To do this, replace the above to roughly :
f2d5020d 760 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
ce261791 761 # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
96449e8e 762
96449e8e 763 }
764 else {
765 # try to DWIM on equality operators
766 # LDNOTE : not 100% sure this is the correct thing to do ...
767 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
768 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
769
770 # otherwise
771 puke "operator '$op' applied on an empty array (field '$k')";
772 }
773}
774
775
776sub _where_hashpair_SCALARREF {
777 my ($self, $k, $v) = @_;
778 $self->_debug("SCALAR($k) means literal SQL: $$v");
779 my $sql = $self->_quote($k) . " " . $$v;
780 return ($sql);
781}
782
fe3ae272 783# literal SQL with bind
96449e8e 784sub _where_hashpair_ARRAYREFREF {
785 my ($self, $k, $v) = @_;
786 $self->_debug("REF($k) means literal SQL: @${$v}");
787 my ($sql, @bind) = @${$v};
fe3ae272 788 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 789 $sql = $self->_quote($k) . " " . $sql;
96449e8e 790 return ($sql, @bind );
791}
792
fe3ae272 793# literal SQL without bind
96449e8e 794sub _where_hashpair_SCALAR {
795 my ($self, $k, $v) = @_;
796 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
797 my $sql = join ' ', $self->_convert($self->_quote($k)),
798 $self->_sqlcase($self->{cmp}),
799 $self->_convert('?');
800 my @bind = $self->_bindtype($k, $v);
801 return ( $sql, @bind);
802}
803
804
805sub _where_hashpair_UNDEF {
806 my ($self, $k, $v) = @_;
807 $self->_debug("UNDEF($k) means IS NULL");
808 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
809 return ($sql);
810}
811
812#======================================================================
813# WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
814#======================================================================
815
816
817sub _where_SCALARREF {
818 my ($self, $where) = @_;
819
820 # literal sql
821 $self->_debug("SCALAR(*top) means literal SQL: $$where");
822 return ($$where);
823}
824
825
826sub _where_SCALAR {
827 my ($self, $where) = @_;
828
829 # literal sql
830 $self->_debug("NOREF(*top) means literal SQL: $where");
831 return ($where);
832}
833
834
835sub _where_UNDEF {
836 my ($self) = @_;
837 return ();
838}
839
840
841#======================================================================
842# WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
843#======================================================================
844
845
846sub _where_field_BETWEEN {
847 my ($self, $k, $op, $vals) = @_;
848
4d8b3dc4 849 my ($label, $and, $placeholder);
cf02fc47 850 $label = $self->_convert($self->_quote($k));
851 $and = ' ' . $self->_sqlcase('and') . ' ';
852 $placeholder = $self->_convert('?');
96449e8e 853 $op = $self->_sqlcase($op);
854
4d8b3dc4 855 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
856 ARRAYREFREF => sub {
857 return @$$vals;
858 },
859 SCALARREF => sub {
860 return $$vals;
861 },
862 ARRAYREF => sub {
863 puke "special op 'between' accepts an arrayref with exactly two values"
864 if @$vals != 2;
865
866 my (@all_sql, @all_bind);
867 foreach my $val (@$vals) {
868 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
869 SCALAR => sub {
870 return ($placeholder, ($val));
871 },
872 SCALARREF => sub {
873 return ($self->_convert($$val), ());
874 },
875 ARRAYREFREF => sub {
876 my ($sql, @bind) = @$$val;
877 return ($self->_convert($sql), @bind);
878 },
879 });
880 push @all_sql, $sql;
881 push @all_bind, @bind;
882 }
883
884 return (
885 (join $and, @all_sql),
886 $self->_bindtype($k, @all_bind),
887 );
888 },
889 FALLBACK => sub {
890 puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
891 },
892 });
cf02fc47 893
cf02fc47 894 my $sql = "( $label $op $clause )";
96449e8e 895 return ($sql, @bind)
896}
897
898
899sub _where_field_IN {
900 my ($self, $k, $op, $vals) = @_;
901
902 # backwards compatibility : if scalar, force into an arrayref
903 $vals = [$vals] if defined $vals && ! ref $vals;
904
96449e8e 905 my ($label) = $self->_convert($self->_quote($k));
906 my ($placeholder) = $self->_convert('?');
96449e8e 907 $op = $self->_sqlcase($op);
908
8a0d798a 909 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
910 ARRAYREF => sub { # list of choices
911 if (@$vals) { # nonempty list
912 my $placeholders = join ", ", (($placeholder) x @$vals);
913 my $sql = "$label $op ( $placeholders )";
914 my @bind = $self->_bindtype($k, @$vals);
96449e8e 915
8a0d798a 916 return ($sql, @bind);
917 }
918 else { # empty list : some databases won't understand "IN ()", so DWIM
919 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
920 return ($sql);
921 }
922 },
923
4a1f01a3 924 SCALARREF => sub { # literal SQL
925 my $sql = $self->_open_outer_paren ($$vals);
926 return ("$label $op ( $sql )");
927 },
8a0d798a 928 ARRAYREFREF => sub { # literal SQL with bind
929 my ($sql, @bind) = @$$vals;
fe3ae272 930 $self->_assert_bindval_matches_bindtype(@bind);
4a1f01a3 931 $sql = $self->_open_outer_paren ($sql);
8a0d798a 932 return ("$label $op ( $sql )", @bind);
933 },
934
935 FALLBACK => sub {
4a1f01a3 936 puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)";
8a0d798a 937 },
938 });
939
940 return ($sql, @bind);
96449e8e 941}
942
4a1f01a3 943# Some databases (SQLite) treat col IN (1, 2) different from
944# col IN ( (1, 2) ). Use this to strip all outer parens while
945# adding them back in the corresponding method
946sub _open_outer_paren {
947 my ($self, $sql) = @_;
171a709f 948 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
4a1f01a3 949 return $sql;
950}
951
96449e8e 952
96449e8e 953#======================================================================
954# ORDER BY
955#======================================================================
956
957sub _order_by {
958 my ($self, $arg) = @_;
959
f267b646 960 my (@sql, @bind);
961 for my $c ($self->_order_by_chunks ($arg) ) {
962 $self->_SWITCH_refkind ($c, {
963 SCALAR => sub { push @sql, $c },
964 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
965 });
966 }
967
968 my $sql = @sql
969 ? sprintf ('%s %s',
970 $self->_sqlcase(' order by'),
971 join (', ', @sql)
972 )
973 : ''
974 ;
975
976 return wantarray ? ($sql, @bind) : $sql;
977}
978
979sub _order_by_chunks {
980 my ($self, $arg) = @_;
981
982 return $self->_SWITCH_refkind($arg, {
96449e8e 983
984 ARRAYREF => sub {
f267b646 985 map { $self->_order_by_chunks ($_ ) } @$arg;
96449e8e 986 },
987
f267b646 988 ARRAYREFREF => sub { [ @$$arg ] },
989
96449e8e 990 SCALAR => sub {$self->_quote($arg)},
f267b646 991
992 UNDEF => sub {return () },
993
96449e8e 994 SCALARREF => sub {$$arg}, # literal SQL, no quoting
96449e8e 995
f267b646 996 HASHREF => sub {
997 # get first pair in hash
998 my ($key, $val) = each %$arg;
96449e8e 999
f267b646 1000 return () unless $key;
96449e8e 1001
f267b646 1002 if ( (keys %$arg) > 1 or not $key =~ /^-(desc|asc)/i ) {
1003 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1004 }
96449e8e 1005
f267b646 1006 my $direction = $1;
96449e8e 1007
e9bd3547 1008 my @ret;
f267b646 1009 for my $c ($self->_order_by_chunks ($val)) {
e9bd3547 1010 my ($sql, @bind);
96449e8e 1011
f267b646 1012 $self->_SWITCH_refkind ($c, {
1013 SCALAR => sub {
e9bd3547 1014 $sql = $c;
f267b646 1015 },
1016 ARRAYREF => sub {
e9bd3547 1017 ($sql, @bind) = @$c;
f267b646 1018 },
1019 });
96449e8e 1020
e9bd3547 1021 $sql = $sql . ' ' . $self->_sqlcase($direction);
96449e8e 1022
e9bd3547 1023 push @ret, [ $sql, @bind];
1024 }
96449e8e 1025
e9bd3547 1026 return @ret;
f267b646 1027 },
1028 });
96449e8e 1029}
1030
1031
96449e8e 1032#======================================================================
1033# DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1034#======================================================================
1035
1036sub _table {
1037 my $self = shift;
1038 my $from = shift;
1039 $self->_SWITCH_refkind($from, {
1040 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1041 SCALAR => sub {$self->_quote($from)},
1042 SCALARREF => sub {$$from},
1043 ARRAYREFREF => sub {join ', ', @$from;},
1044 });
1045}
1046
1047
1048#======================================================================
1049# UTILITY FUNCTIONS
1050#======================================================================
1051
1052sub _quote {
1053 my $self = shift;
1054 my $label = shift;
1055
1056 $label or puke "can't quote an empty label";
1057
1058 # left and right quote characters
1059 my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
1060 SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
1061 ARRAYREF => sub {@{$self->{quote_char}}},
1062 UNDEF => sub {()},
1063 });
1064 not @other
1065 or puke "quote_char must be an arrayref of 2 values";
1066
1067 # no quoting if no quoting chars
1068 $ql or return $label;
1069
1070 # no quoting for literal SQL
1071 return $$label if ref($label) eq 'SCALAR';
1072
1073 # separate table / column (if applicable)
1074 my $sep = $self->{name_sep} || '';
1075 my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
1076
1077 # do the quoting, except for "*" or for `table`.*
1078 my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
1079
1080 # reassemble and return.
1081 return join $sep, @quoted;
1082}
1083
1084
1085# Conversion, if applicable
1086sub _convert ($) {
1087 my ($self, $arg) = @_;
1088
1089# LDNOTE : modified the previous implementation below because
1090# it was not consistent : the first "return" is always an array,
1091# the second "return" is context-dependent. Anyway, _convert
1092# seems always used with just a single argument, so make it a
1093# scalar function.
1094# return @_ unless $self->{convert};
1095# my $conv = $self->_sqlcase($self->{convert});
1096# my @ret = map { $conv.'('.$_.')' } @_;
1097# return wantarray ? @ret : $ret[0];
1098 if ($self->{convert}) {
1099 my $conv = $self->_sqlcase($self->{convert});
1100 $arg = $conv.'('.$arg.')';
1101 }
1102 return $arg;
1103}
1104
1105# And bindtype
1106sub _bindtype (@) {
1107 my $self = shift;
1108 my($col, @vals) = @_;
1109
1110 #LDNOTE : changed original implementation below because it did not make
1111 # sense when bindtype eq 'columns' and @vals > 1.
1112# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1113
1114 return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
1115}
1116
fe3ae272 1117# Dies if any element of @bind is not in [colname => value] format
1118# if bindtype is 'columns'.
1119sub _assert_bindval_matches_bindtype {
1120 my ($self, @bind) = @_;
1121
1122 if ($self->{bindtype} eq 'columns') {
1123 foreach my $val (@bind) {
1124 if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
1125 die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1126 }
1127 }
1128 }
1129}
1130
96449e8e 1131sub _join_sql_clauses {
1132 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1133
1134 if (@$clauses_aref > 1) {
1135 my $join = " " . $self->_sqlcase($logic) . " ";
1136 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1137 return ($sql, @$bind_aref);
1138 }
1139 elsif (@$clauses_aref) {
1140 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1141 }
1142 else {
1143 return (); # if no SQL, ignore @$bind_aref
1144 }
1145}
1146
1147
1148# Fix SQL case, if so requested
1149sub _sqlcase {
1150 my $self = shift;
1151
1152 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1153 # don't touch the argument ... crooked logic, but let's not change it!
1154 return $self->{case} ? $_[0] : uc($_[0]);
1155}
1156
1157
1158#======================================================================
1159# DISPATCHING FROM REFKIND
1160#======================================================================
1161
1162sub _refkind {
1163 my ($self, $data) = @_;
1164 my $suffix = '';
1165 my $ref;
90aab162 1166 my $n_steps = 0;
96449e8e 1167
96449e8e 1168 while (1) {
90aab162 1169 # blessed objects are treated like scalars
1170 $ref = (blessed $data) ? '' : ref $data;
1171 $n_steps += 1 if $ref;
1172 last if $ref ne 'REF';
96449e8e 1173 $data = $$data;
1174 }
1175
90aab162 1176 my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
1177
1178 return $base . ('REF' x $n_steps);
96449e8e 1179}
1180
90aab162 1181
1182
96449e8e 1183sub _try_refkind {
1184 my ($self, $data) = @_;
1185 my @try = ($self->_refkind($data));
1186 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1187 push @try, 'FALLBACK';
1188 return @try;
1189}
1190
1191sub _METHOD_FOR_refkind {
1192 my ($self, $meth_prefix, $data) = @_;
1193 my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
1194 $self->_try_refkind($data)
1195 or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1196 return $method;
1197}
1198
1199
1200sub _SWITCH_refkind {
1201 my ($self, $data, $dispatch_table) = @_;
1202
1203 my $coderef = first {$_} map {$dispatch_table->{$_}}
1204 $self->_try_refkind($data)
1205 or puke "no dispatch entry for ".$self->_refkind($data);
1206 $coderef->();
1207}
1208
1209
1210
1211
1212#======================================================================
1213# VALUES, GENERATE, AUTOLOAD
1214#======================================================================
1215
1216# LDNOTE: original code from nwiger, didn't touch code in that section
1217# I feel the AUTOLOAD stuff should not be the default, it should
1218# only be activated on explicit demand by user.
1219
1220sub values {
1221 my $self = shift;
1222 my $data = shift || return;
1223 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1224 unless ref $data eq 'HASH';
bab725ce 1225
1226 my @all_bind;
1227 foreach my $k ( sort keys %$data ) {
1228 my $v = $data->{$k};
1229 $self->_SWITCH_refkind($v, {
1230 ARRAYREF => sub {
1231 if ($self->{array_datatypes}) { # array datatype
1232 push @all_bind, $self->_bindtype($k, $v);
1233 }
1234 else { # literal SQL with bind
1235 my ($sql, @bind) = @$v;
1236 $self->_assert_bindval_matches_bindtype(@bind);
1237 push @all_bind, @bind;
1238 }
1239 },
1240 ARRAYREFREF => sub { # literal SQL with bind
1241 my ($sql, @bind) = @${$v};
1242 $self->_assert_bindval_matches_bindtype(@bind);
1243 push @all_bind, @bind;
1244 },
1245 SCALARREF => sub { # literal SQL without bind
1246 },
1247 SCALAR_or_UNDEF => sub {
1248 push @all_bind, $self->_bindtype($k, $v);
1249 },
1250 });
1251 }
1252
1253 return @all_bind;
96449e8e 1254}
1255
1256sub generate {
1257 my $self = shift;
1258
1259 my(@sql, @sqlq, @sqlv);
1260
1261 for (@_) {
1262 my $ref = ref $_;
1263 if ($ref eq 'HASH') {
1264 for my $k (sort keys %$_) {
1265 my $v = $_->{$k};
1266 my $r = ref $v;
1267 my $label = $self->_quote($k);
1268 if ($r eq 'ARRAY') {
fe3ae272 1269 # literal SQL with bind
1270 my ($sql, @bind) = @$v;
1271 $self->_assert_bindval_matches_bindtype(@bind);
96449e8e 1272 push @sqlq, "$label = $sql";
fe3ae272 1273 push @sqlv, @bind;
96449e8e 1274 } elsif ($r eq 'SCALAR') {
fe3ae272 1275 # literal SQL without bind
96449e8e 1276 push @sqlq, "$label = $$v";
1277 } else {
1278 push @sqlq, "$label = ?";
1279 push @sqlv, $self->_bindtype($k, $v);
1280 }
1281 }
1282 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1283 } elsif ($ref eq 'ARRAY') {
1284 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1285 for my $v (@$_) {
1286 my $r = ref $v;
fe3ae272 1287 if ($r eq 'ARRAY') { # literal SQL with bind
1288 my ($sql, @bind) = @$v;
1289 $self->_assert_bindval_matches_bindtype(@bind);
1290 push @sqlq, $sql;
1291 push @sqlv, @bind;
1292 } elsif ($r eq 'SCALAR') { # literal SQL without bind
96449e8e 1293 # embedded literal SQL
1294 push @sqlq, $$v;
1295 } else {
1296 push @sqlq, '?';
1297 push @sqlv, $v;
1298 }
1299 }
1300 push @sql, '(' . join(', ', @sqlq) . ')';
1301 } elsif ($ref eq 'SCALAR') {
1302 # literal SQL
1303 push @sql, $$_;
1304 } else {
1305 # strings get case twiddled
1306 push @sql, $self->_sqlcase($_);
1307 }
1308 }
1309
1310 my $sql = join ' ', @sql;
1311
1312 # this is pretty tricky
1313 # if ask for an array, return ($stmt, @bind)
1314 # otherwise, s/?/shift @sqlv/ to put it inline
1315 if (wantarray) {
1316 return ($sql, @sqlv);
1317 } else {
1318 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1319 ref $d ? $d->[1] : $d/e;
1320 return $sql;
1321 }
1322}
1323
1324
1325sub DESTROY { 1 }
1326
1327sub AUTOLOAD {
1328 # This allows us to check for a local, then _form, attr
1329 my $self = shift;
1330 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1331 return $self->generate($name, @_);
1332}
1333
13341;
1335
1336
1337
1338__END__
32eab2da 1339
1340=head1 NAME
1341
1342SQL::Abstract - Generate SQL from Perl data structures
1343
1344=head1 SYNOPSIS
1345
1346 use SQL::Abstract;
1347
1348 my $sql = SQL::Abstract->new;
1349
1350 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1351
1352 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1353
1354 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1355
1356 my($stmt, @bind) = $sql->delete($table, \%where);
1357
1358 # Then, use these in your DBI statements
1359 my $sth = $dbh->prepare($stmt);
1360 $sth->execute(@bind);
1361
1362 # Just generate the WHERE clause
abe72f94 1363 my($stmt, @bind) = $sql->where(\%where, \@order);
32eab2da 1364
1365 # Return values in the same order, for hashed queries
1366 # See PERFORMANCE section for more details
1367 my @bind = $sql->values(\%fieldvals);
1368
1369=head1 DESCRIPTION
1370
1371This module was inspired by the excellent L<DBIx::Abstract>.
1372However, in using that module I found that what I really wanted
1373to do was generate SQL, but still retain complete control over my
1374statement handles and use the DBI interface. So, I set out to
1375create an abstract SQL generation module.
1376
1377While based on the concepts used by L<DBIx::Abstract>, there are
1378several important differences, especially when it comes to WHERE
1379clauses. I have modified the concepts used to make the SQL easier
1380to generate from Perl data structures and, IMO, more intuitive.
1381The underlying idea is for this module to do what you mean, based
1382on the data structures you provide it. The big advantage is that
1383you don't have to modify your code every time your data changes,
1384as this module figures it out.
1385
1386To begin with, an SQL INSERT is as easy as just specifying a hash
1387of C<key=value> pairs:
1388
1389 my %data = (
1390 name => 'Jimbo Bobson',
1391 phone => '123-456-7890',
1392 address => '42 Sister Lane',
1393 city => 'St. Louis',
1394 state => 'Louisiana',
1395 );
1396
1397The SQL can then be generated with this:
1398
1399 my($stmt, @bind) = $sql->insert('people', \%data);
1400
1401Which would give you something like this:
1402
1403 $stmt = "INSERT INTO people
1404 (address, city, name, phone, state)
1405 VALUES (?, ?, ?, ?, ?)";
1406 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1407 '123-456-7890', 'Louisiana');
1408
1409These are then used directly in your DBI code:
1410
1411 my $sth = $dbh->prepare($stmt);
1412 $sth->execute(@bind);
1413
96449e8e 1414=head2 Inserting and Updating Arrays
1415
1416If your database has array types (like for example Postgres),
1417activate the special option C<< array_datatypes => 1 >>
1418when creating the C<SQL::Abstract> object.
1419Then you may use an arrayref to insert and update database array types:
1420
1421 my $sql = SQL::Abstract->new(array_datatypes => 1);
1422 my %data = (
1423 planets => [qw/Mercury Venus Earth Mars/]
1424 );
1425
1426 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1427
1428This results in:
1429
1430 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1431
1432 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1433
1434
1435=head2 Inserting and Updating SQL
1436
1437In order to apply SQL functions to elements of your C<%data> you may
1438specify a reference to an arrayref for the given hash value. For example,
1439if you need to execute the Oracle C<to_date> function on a value, you can
1440say something like this:
32eab2da 1441
1442 my %data = (
1443 name => 'Bill',
96449e8e 1444 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
32eab2da 1445 );
1446
1447The first value in the array is the actual SQL. Any other values are
1448optional and would be included in the bind values array. This gives
1449you:
1450
1451 my($stmt, @bind) = $sql->insert('people', \%data);
1452
1453 $stmt = "INSERT INTO people (name, date_entered)
1454 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1455 @bind = ('Bill', '03/02/2003');
1456
1457An UPDATE is just as easy, all you change is the name of the function:
1458
1459 my($stmt, @bind) = $sql->update('people', \%data);
1460
1461Notice that your C<%data> isn't touched; the module will generate
1462the appropriately quirky SQL for you automatically. Usually you'll
1463want to specify a WHERE clause for your UPDATE, though, which is
1464where handling C<%where> hashes comes in handy...
1465
96449e8e 1466=head2 Complex where statements
1467
32eab2da 1468This module can generate pretty complicated WHERE statements
1469easily. For example, simple C<key=value> pairs are taken to mean
1470equality, and if you want to see if a field is within a set
1471of values, you can use an arrayref. Let's say we wanted to
1472SELECT some data based on this criteria:
1473
1474 my %where = (
1475 requestor => 'inna',
1476 worker => ['nwiger', 'rcwe', 'sfz'],
1477 status => { '!=', 'completed' }
1478 );
1479
1480 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1481
1482The above would give you something like this:
1483
1484 $stmt = "SELECT * FROM tickets WHERE
1485 ( requestor = ? ) AND ( status != ? )
1486 AND ( worker = ? OR worker = ? OR worker = ? )";
1487 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1488
1489Which you could then use in DBI code like so:
1490
1491 my $sth = $dbh->prepare($stmt);
1492 $sth->execute(@bind);
1493
1494Easy, eh?
1495
1496=head1 FUNCTIONS
1497
1498The functions are simple. There's one for each major SQL operation,
1499and a constructor you use first. The arguments are specified in a
1500similar order to each function (table, then fields, then a where
1501clause) to try and simplify things.
1502
83cab70b 1503
83cab70b 1504
32eab2da 1505
1506=head2 new(option => 'value')
1507
1508The C<new()> function takes a list of options and values, and returns
1509a new B<SQL::Abstract> object which can then be used to generate SQL
1510through the methods below. The options accepted are:
1511
1512=over
1513
1514=item case
1515
1516If set to 'lower', then SQL will be generated in all lowercase. By
1517default SQL is generated in "textbook" case meaning something like:
1518
1519 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1520
96449e8e 1521Any setting other than 'lower' is ignored.
1522
32eab2da 1523=item cmp
1524
1525This determines what the default comparison operator is. By default
1526it is C<=>, meaning that a hash like this:
1527
1528 %where = (name => 'nwiger', email => 'nate@wiger.org');
1529
1530Will generate SQL like this:
1531
1532 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1533
1534However, you may want loose comparisons by default, so if you set
1535C<cmp> to C<like> you would get SQL such as:
1536
1537 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1538
1539You can also override the comparsion on an individual basis - see
1540the huge section on L</"WHERE CLAUSES"> at the bottom.
1541
96449e8e 1542=item sqltrue, sqlfalse
1543
1544Expressions for inserting boolean values within SQL statements.
6e0c6552 1545By default these are C<1=1> and C<1=0>. They are used
1546by the special operators C<-in> and C<-not_in> for generating
1547correct SQL even when the argument is an empty array (see below).
96449e8e 1548
32eab2da 1549=item logic
1550
1551This determines the default logical operator for multiple WHERE
7cac25e6 1552statements in arrays or hashes. If absent, the default logic is "or"
1553for arrays, and "and" for hashes. This means that a WHERE
32eab2da 1554array of the form:
1555
1556 @where = (
1557 event_date => {'>=', '2/13/99'},
1558 event_date => {'<=', '4/24/03'},
1559 );
1560
7cac25e6 1561will generate SQL like this:
32eab2da 1562
1563 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1564
1565This is probably not what you want given this query, though (look
1566at the dates). To change the "OR" to an "AND", simply specify:
1567
1568 my $sql = SQL::Abstract->new(logic => 'and');
1569
1570Which will change the above C<WHERE> to:
1571
1572 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1573
96449e8e 1574The logic can also be changed locally by inserting
7cac25e6 1575a modifier in front of an arrayref :
96449e8e 1576
7cac25e6 1577 @where = (-and => [event_date => {'>=', '2/13/99'},
1578 event_date => {'<=', '4/24/03'} ]);
96449e8e 1579
1580See the L</"WHERE CLAUSES"> section for explanations.
1581
32eab2da 1582=item convert
1583
1584This will automatically convert comparisons using the specified SQL
1585function for both column and value. This is mostly used with an argument
1586of C<upper> or C<lower>, so that the SQL will have the effect of
1587case-insensitive "searches". For example, this:
1588
1589 $sql = SQL::Abstract->new(convert => 'upper');
1590 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1591
1592Will turn out the following SQL:
1593
1594 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1595
1596The conversion can be C<upper()>, C<lower()>, or any other SQL function
1597that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1598not validate this option; it will just pass through what you specify verbatim).
1599
1600=item bindtype
1601
1602This is a kludge because many databases suck. For example, you can't
1603just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1604Instead, you have to use C<bind_param()>:
1605
1606 $sth->bind_param(1, 'reg data');
1607 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1608
1609The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1610which loses track of which field each slot refers to. Fear not.
1611
1612If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1613Currently, you can specify either C<normal> (default) or C<columns>. If you
1614specify C<columns>, you will get an array that looks like this:
1615
1616 my $sql = SQL::Abstract->new(bindtype => 'columns');
1617 my($stmt, @bind) = $sql->insert(...);
1618
1619 @bind = (
1620 [ 'column1', 'value1' ],
1621 [ 'column2', 'value2' ],
1622 [ 'column3', 'value3' ],
1623 );
1624
1625You can then iterate through this manually, using DBI's C<bind_param()>.
e3f9dff4 1626
32eab2da 1627 $sth->prepare($stmt);
1628 my $i = 1;
1629 for (@bind) {
1630 my($col, $data) = @$_;
1631 if ($col eq 'details' || $col eq 'comments') {
1632 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1633 } elsif ($col eq 'image') {
1634 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1635 } else {
1636 $sth->bind_param($i, $data);
1637 }
1638 $i++;
1639 }
1640 $sth->execute; # execute without @bind now
1641
1642Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1643Basically, the advantage is still that you don't have to care which fields
1644are or are not included. You could wrap that above C<for> loop in a simple
1645sub called C<bind_fields()> or something and reuse it repeatedly. You still
1646get a layer of abstraction over manual SQL specification.
1647
deb148a2 1648Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1649construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1650will expect the bind values in this format.
1651
32eab2da 1652=item quote_char
1653
1654This is the character that a table or column name will be quoted
1655with. By default this is an empty string, but you could set it to
1656the character C<`>, to generate SQL like this:
1657
1658 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1659
96449e8e 1660Alternatively, you can supply an array ref of two items, the first being the left
1661hand quote character, and the second the right hand quote character. For
1662example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1663that generates SQL like this:
1664
1665 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1666
1667Quoting is useful if you have tables or columns names that are reserved
1668words in your database's SQL dialect.
32eab2da 1669
1670=item name_sep
1671
1672This is the character that separates a table and column name. It is
1673necessary to specify this when the C<quote_char> option is selected,
1674so that tables and column names can be individually quoted like this:
1675
1676 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1677
96449e8e 1678=item array_datatypes
32eab2da 1679
96449e8e 1680When this option is true, arrayrefs in INSERT or UPDATE are
1681interpreted as array datatypes and are passed directly
1682to the DBI layer.
1683When this option is false, arrayrefs are interpreted
1684as literal SQL, just like refs to arrayrefs
1685(but this behavior is for backwards compatibility; when writing
1686new queries, use the "reference to arrayref" syntax
1687for literal SQL).
32eab2da 1688
32eab2da 1689
96449e8e 1690=item special_ops
32eab2da 1691
96449e8e 1692Takes a reference to a list of "special operators"
1693to extend the syntax understood by L<SQL::Abstract>.
1694See section L</"SPECIAL OPERATORS"> for details.
32eab2da 1695
59f23b3d 1696=item unary_ops
1697
1698Takes a reference to a list of "unary operators"
1699to extend the syntax understood by L<SQL::Abstract>.
1700See section L</"UNARY OPERATORS"> for details.
1701
32eab2da 1702
32eab2da 1703
96449e8e 1704=back
32eab2da 1705
02288357 1706=head2 insert($table, \@values || \%fieldvals, \%options)
32eab2da 1707
1708This is the simplest function. You simply give it a table name
1709and either an arrayref of values or hashref of field/value pairs.
1710It returns an SQL INSERT statement and a list of bind values.
96449e8e 1711See the sections on L</"Inserting and Updating Arrays"> and
1712L</"Inserting and Updating SQL"> for information on how to insert
1713with those data types.
32eab2da 1714
02288357 1715The optional C<\%options> hash reference may contain additional
1716options to generate the insert SQL. Currently supported options
1717are:
1718
1719=over 4
1720
1721=item returning
1722
1723Takes either a scalar of raw SQL fields, or an array reference of
1724field names, and adds on an SQL C<RETURNING> statement at the end.
1725This allows you to return data generated by the insert statement
1726(such as row IDs) without performing another C<SELECT> statement.
1727Note, however, this is not part of the SQL standard and may not
1728be supported by all database engines.
1729
1730=back
1731
32eab2da 1732=head2 update($table, \%fieldvals, \%where)
1733
1734This takes a table, hashref of field/value pairs, and an optional
86298391 1735hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
32eab2da 1736of bind values.
96449e8e 1737See the sections on L</"Inserting and Updating Arrays"> and
1738L</"Inserting and Updating SQL"> for information on how to insert
1739with those data types.
32eab2da 1740
96449e8e 1741=head2 select($source, $fields, $where, $order)
32eab2da 1742
96449e8e 1743This returns a SQL SELECT statement and associated list of bind values, as
1744specified by the arguments :
32eab2da 1745
96449e8e 1746=over
32eab2da 1747
96449e8e 1748=item $source
32eab2da 1749
96449e8e 1750Specification of the 'FROM' part of the statement.
1751The argument can be either a plain scalar (interpreted as a table
1752name, will be quoted), or an arrayref (interpreted as a list
1753of table names, joined by commas, quoted), or a scalarref
1754(literal table name, not quoted), or a ref to an arrayref
1755(list of literal table names, joined by commas, not quoted).
32eab2da 1756
96449e8e 1757=item $fields
32eab2da 1758
96449e8e 1759Specification of the list of fields to retrieve from
1760the source.
1761The argument can be either an arrayref (interpreted as a list
1762of field names, will be joined by commas and quoted), or a
1763plain scalar (literal SQL, not quoted).
1764Please observe that this API is not as flexible as for
e3f9dff4 1765the first argument C<$table>, for backwards compatibility reasons.
32eab2da 1766
96449e8e 1767=item $where
32eab2da 1768
96449e8e 1769Optional argument to specify the WHERE part of the query.
1770The argument is most often a hashref, but can also be
1771an arrayref or plain scalar --
1772see section L<WHERE clause|/"WHERE CLAUSES"> for details.
32eab2da 1773
96449e8e 1774=item $order
32eab2da 1775
96449e8e 1776Optional argument to specify the ORDER BY part of the query.
1777The argument can be a scalar, a hashref or an arrayref
1778-- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1779for details.
32eab2da 1780
96449e8e 1781=back
32eab2da 1782
32eab2da 1783
1784=head2 delete($table, \%where)
1785
86298391 1786This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
32eab2da 1787It returns an SQL DELETE statement and list of bind values.
1788
32eab2da 1789=head2 where(\%where, \@order)
1790
1791This is used to generate just the WHERE clause. For example,
1792if you have an arbitrary data structure and know what the
1793rest of your SQL is going to look like, but want an easy way
1794to produce a WHERE clause, use this. It returns an SQL WHERE
1795clause and list of bind values.
1796
32eab2da 1797
1798=head2 values(\%data)
1799
1800This just returns the values from the hash C<%data>, in the same
1801order that would be returned from any of the other above queries.
1802Using this allows you to markedly speed up your queries if you
1803are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1804
32eab2da 1805=head2 generate($any, 'number', $of, \@data, $struct, \%types)
1806
1807Warning: This is an experimental method and subject to change.
1808
1809This returns arbitrarily generated SQL. It's a really basic shortcut.
1810It will return two different things, depending on return context:
1811
1812 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1813 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1814
1815These would return the following:
1816
1817 # First calling form
1818 $stmt = "CREATE TABLE test (?, ?)";
1819 @bind = (field1, field2);
1820
1821 # Second calling form
1822 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1823
1824Depending on what you're trying to do, it's up to you to choose the correct
1825format. In this example, the second form is what you would want.
1826
1827By the same token:
1828
1829 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1830
1831Might give you:
1832
1833 ALTER SESSION SET nls_date_format = 'MM/YY'
1834
1835You get the idea. Strings get their case twiddled, but everything
1836else remains verbatim.
1837
32eab2da 1838
32eab2da 1839
32eab2da 1840
1841=head1 WHERE CLAUSES
1842
96449e8e 1843=head2 Introduction
1844
32eab2da 1845This module uses a variation on the idea from L<DBIx::Abstract>. It
1846is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1847module is that things in arrays are OR'ed, and things in hashes
1848are AND'ed.>
1849
1850The easiest way to explain is to show lots of examples. After
1851each C<%where> hash shown, it is assumed you used:
1852
1853 my($stmt, @bind) = $sql->where(\%where);
1854
1855However, note that the C<%where> hash can be used directly in any
1856of the other functions as well, as described above.
1857
96449e8e 1858=head2 Key-value pairs
1859
32eab2da 1860So, let's get started. To begin, a simple hash:
1861
1862 my %where = (
1863 user => 'nwiger',
1864 status => 'completed'
1865 );
1866
1867Is converted to SQL C<key = val> statements:
1868
1869 $stmt = "WHERE user = ? AND status = ?";
1870 @bind = ('nwiger', 'completed');
1871
1872One common thing I end up doing is having a list of values that
1873a field can be in. To do this, simply specify a list inside of
1874an arrayref:
1875
1876 my %where = (
1877 user => 'nwiger',
1878 status => ['assigned', 'in-progress', 'pending'];
1879 );
1880
1881This simple code will create the following:
1882
1883 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1884 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1885
7cac25e6 1886A field associated to an empty arrayref will be considered a
1887logical false and will generate 0=1.
8a68b5be 1888
6e0c6552 1889=head2 Specific comparison operators
96449e8e 1890
32eab2da 1891If you want to specify a different type of operator for your comparison,
1892you can use a hashref for a given column:
1893
1894 my %where = (
1895 user => 'nwiger',
1896 status => { '!=', 'completed' }
1897 );
1898
1899Which would generate:
1900
1901 $stmt = "WHERE user = ? AND status != ?";
1902 @bind = ('nwiger', 'completed');
1903
1904To test against multiple values, just enclose the values in an arrayref:
1905
96449e8e 1906 status => { '=', ['assigned', 'in-progress', 'pending'] };
1907
f2d5020d 1908Which would give you:
96449e8e 1909
1910 "WHERE status = ? OR status = ? OR status = ?"
1911
1912
1913The hashref can also contain multiple pairs, in which case it is expanded
32eab2da 1914into an C<AND> of its elements:
1915
1916 my %where = (
1917 user => 'nwiger',
1918 status => { '!=', 'completed', -not_like => 'pending%' }
1919 );
1920
1921 # Or more dynamically, like from a form
1922 $where{user} = 'nwiger';
1923 $where{status}{'!='} = 'completed';
1924 $where{status}{'-not_like'} = 'pending%';
1925
1926 # Both generate this
1927 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1928 @bind = ('nwiger', 'completed', 'pending%');
1929
96449e8e 1930
32eab2da 1931To get an OR instead, you can combine it with the arrayref idea:
1932
1933 my %where => (
1934 user => 'nwiger',
1935 priority => [ {'=', 2}, {'!=', 1} ]
1936 );
1937
1938Which would generate:
1939
1940 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1941 @bind = ('nwiger', '2', '1');
1942
44b9e502 1943If you want to include literal SQL (with or without bind values), just use a
1944scalar reference or array reference as the value:
1945
1946 my %where = (
1947 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1948 date_expires => { '<' => \"now()" }
1949 );
1950
1951Which would generate:
1952
1953 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1954 @bind = ('11/26/2008');
1955
96449e8e 1956
1957=head2 Logic and nesting operators
1958
1959In the example above,
1960there is a subtle trap if you want to say something like
32eab2da 1961this (notice the C<AND>):
1962
1963 WHERE priority != ? AND priority != ?
1964
1965Because, in Perl you I<can't> do this:
1966
1967 priority => { '!=', 2, '!=', 1 }
1968
1969As the second C<!=> key will obliterate the first. The solution
1970is to use the special C<-modifier> form inside an arrayref:
1971
96449e8e 1972 priority => [ -and => {'!=', 2},
1973 {'!=', 1} ]
1974
32eab2da 1975
1976Normally, these would be joined by C<OR>, but the modifier tells it
1977to use C<AND> instead. (Hint: You can use this in conjunction with the
1978C<logic> option to C<new()> in order to change the way your queries
1979work by default.) B<Important:> Note that the C<-modifier> goes
1980B<INSIDE> the arrayref, as an extra first element. This will
1981B<NOT> do what you think it might:
1982
1983 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1984
1985Here is a quick list of equivalencies, since there is some overlap:
1986
1987 # Same
1988 status => {'!=', 'completed', 'not like', 'pending%' }
1989 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1990
1991 # Same
1992 status => {'=', ['assigned', 'in-progress']}
1993 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1994 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1995
e3f9dff4 1996
1997
96449e8e 1998=head2 Special operators : IN, BETWEEN, etc.
1999
32eab2da 2000You can also use the hashref format to compare a list of fields using the
2001C<IN> comparison operator, by specifying the list as an arrayref:
2002
2003 my %where = (
2004 status => 'completed',
2005 reportid => { -in => [567, 2335, 2] }
2006 );
2007
2008Which would generate:
2009
2010 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2011 @bind = ('completed', '567', '2335', '2');
2012
96449e8e 2013The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2014the same way.
2015
6e0c6552 2016If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2017(by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2018'sqltrue' (by default : C<1=1>).
2019
e41c3bdd 2020In addition to the array you can supply a chunk of literal sql or
2021literal sql with bind:
6e0c6552 2022
e41c3bdd 2023 my %where = {
2024 customer => { -in => \[
2025 'SELECT cust_id FROM cust WHERE balance > ?',
2026 2000,
2027 ],
2028 status => { -in => \'SELECT status_codes FROM states' },
2029 };
6e0c6552 2030
e41c3bdd 2031would generate:
2032
2033 $stmt = "WHERE (
2034 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2035 AND status IN ( SELECT status_codes FROM states )
2036 )";
2037 @bind = ('2000');
2038
2039
2040
2041Another pair of operators is C<-between> and C<-not_between>,
96449e8e 2042used with an arrayref of two values:
32eab2da 2043
2044 my %where = (
2045 user => 'nwiger',
2046 completion_date => {
2047 -not_between => ['2002-10-01', '2003-02-06']
2048 }
2049 );
2050
2051Would give you:
2052
2053 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2054
e41c3bdd 2055Just like with C<-in> all plausible combinations of literal SQL
2056are possible:
2057
2058 my %where = {
2059 start0 => { -between => [ 1, 2 ] },
2060 start1 => { -between => \["? AND ?", 1, 2] },
2061 start2 => { -between => \"lower(x) AND upper(y)" },
2062 start3 => { -between => [
2063 \"lower(x)",
2064 \["upper(?)", 'stuff' ],
2065 ] },
2066 };
2067
2068Would give you:
2069
2070 $stmt = "WHERE (
2071 ( start0 BETWEEN ? AND ? )
2072 AND ( start1 BETWEEN ? AND ? )
2073 AND ( start2 BETWEEN lower(x) AND upper(y) )
2074 AND ( start3 BETWEEN lower(x) AND upper(?) )
2075 )";
2076 @bind = (1, 2, 1, 2, 'stuff');
2077
2078
96449e8e 2079These are the two builtin "special operators"; but the
2080list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2081
59f23b3d 2082=head2 Unary operators: bool
97a920ef 2083
2084If you wish to test against boolean columns or functions within your
2085database you can use the C<-bool> and C<-not_bool> operators. For
2086example to test the column C<is_user> being true and the column
2087<is_enabled> being false you would use:-
2088
2089 my %where = (
2090 -bool => 'is_user',
2091 -not_bool => 'is_enabled',
2092 );
2093
2094Would give you:
2095
277b5d3f 2096 WHERE is_user AND NOT is_enabled
97a920ef 2097
0b604e9d 2098If a more complex combination is required, testing more conditions,
2099then you should use the and/or operators:-
2100
2101 my %where = (
2102 -and => [
2103 -bool => 'one',
2104 -bool => 'two',
2105 -bool => 'three',
2106 -not_bool => 'four',
2107 ],
2108 );
2109
2110Would give you:
2111
2112 WHERE one AND two AND three AND NOT four
97a920ef 2113
2114
107b72f1 2115=head2 Nested conditions, -and/-or prefixes
96449e8e 2116
32eab2da 2117So far, we've seen how multiple conditions are joined with a top-level
2118C<AND>. We can change this by putting the different conditions we want in
2119hashes and then putting those hashes in an array. For example:
2120
2121 my @where = (
2122 {
2123 user => 'nwiger',
2124 status => { -like => ['pending%', 'dispatched'] },
2125 },
2126 {
2127 user => 'robot',
2128 status => 'unassigned',
2129 }
2130 );
2131
2132This data structure would create the following:
2133
2134 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2135 OR ( user = ? AND status = ? ) )";
2136 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2137
107b72f1 2138
01a01e57 2139There is also a special C<-nest>
107b72f1 2140operator which adds an additional set of parens, to create a subquery.
2141For example, to get something like this:
2142
2143 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
2144 @bind = ('nwiger', '20', 'ASIA');
2145
2146You would do:
2147
2148 my %where = (
2149 user => 'nwiger',
01a01e57 2150 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
107b72f1 2151 );
2152
2153
2154Finally, clauses in hashrefs or arrayrefs can be
7cac25e6 2155prefixed with an C<-and> or C<-or> to change the logic
2156inside :
32eab2da 2157
2158 my @where = (
2159 -and => [
2160 user => 'nwiger',
01a01e57 2161 -nest => [
7cac25e6 2162 -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
2163 -and => [workhrs => {'<', 50}, geo => 'EURO' ]
32eab2da 2164 ],
2165 ],
2166 );
2167
2168That would yield:
2169
2170 WHERE ( user = ? AND
2171 ( ( workhrs > ? AND geo = ? )
2172 OR ( workhrs < ? AND geo = ? ) ) )
2173
107b72f1 2174
2175=head2 Algebraic inconsistency, for historical reasons
2176
7cac25e6 2177C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2178operator goes C<outside> of the nested structure; whereas when connecting
2179several constraints on one column, the C<-and> operator goes
2180C<inside> the arrayref. Here is an example combining both features :
2181
2182 my @where = (
2183 -and => [a => 1, b => 2],
2184 -or => [c => 3, d => 4],
2185 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2186 )
2187
2188yielding
2189
2190 WHERE ( ( ( a = ? AND b = ? )
2191 OR ( c = ? OR d = ? )
2192 OR ( e LIKE ? AND e LIKE ? ) ) )
2193
107b72f1 2194This difference in syntax is unfortunate but must be preserved for
2195historical reasons. So be careful : the two examples below would
2196seem algebraically equivalent, but they are not
2197
2198 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2199 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2200
2201 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2202 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2203
7cac25e6 2204
96449e8e 2205=head2 Literal SQL
2206
32eab2da 2207Finally, sometimes only literal SQL will do. If you want to include
2208literal SQL verbatim, you can specify it as a scalar reference, namely:
2209
2210 my $inn = 'is Not Null';
2211 my %where = (
2212 priority => { '<', 2 },
2213 requestor => \$inn
2214 );
2215
2216This would create:
2217
2218 $stmt = "WHERE priority < ? AND requestor is Not Null";
2219 @bind = ('2');
2220
2221Note that in this example, you only get one bind parameter back, since
2222the verbatim SQL is passed as part of the statement.
2223
2224Of course, just to prove a point, the above can also be accomplished
2225with this:
2226
2227 my %where = (
2228 priority => { '<', 2 },
2229 requestor => { '!=', undef },
2230 );
2231
96449e8e 2232
e41c3bdd 2233TMTOWTDI
32eab2da 2234
0b604e9d 2235Conditions on boolean columns can be expressed in the same way, passing
2236a reference to an empty string, however using liternal SQL in this way
2237is deprecated - the preferred method is to use the boolean operators -
2238see L</"Unary operators: bool"> :
96449e8e 2239
2240 my %where = (
2241 priority => { '<', 2 },
2242 is_ready => \"";
2243 );
2244
2245which yields
2246
2247 $stmt = "WHERE priority < ? AND is_ready";
2248 @bind = ('2');
2249
2250
2251=head2 Literal SQL with placeholders and bind values (subqueries)
2252
2253If the literal SQL to be inserted has placeholders and bind values,
2254use a reference to an arrayref (yes this is a double reference --
2255not so common, but perfectly legal Perl). For example, to find a date
2256in Postgres you can use something like this:
2257
2258 my %where = (
2259 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2260 )
2261
2262This would create:
2263
d2a8fe1a 2264 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
96449e8e 2265 @bind = ('10');
2266
deb148a2 2267Note that you must pass the bind values in the same format as they are returned
62552e7d 2268by L</where>. That means that if you set L</bindtype> to C<columns>, you must
26f2dca5 2269provide the bind values in the C<< [ column_meta => value ] >> format, where
2270C<column_meta> is an opaque scalar value; most commonly the column name, but
62552e7d 2271you can use any scalar value (including references and blessed references),
2272L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2273to C<columns> the above example will look like:
deb148a2 2274
2275 my %where = (
2276 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2277 )
96449e8e 2278
2279Literal SQL is especially useful for nesting parenthesized clauses in the
2280main SQL query. Here is a first example :
2281
2282 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2283 100, "foo%");
2284 my %where = (
2285 foo => 1234,
2286 bar => \["IN ($sub_stmt)" => @sub_bind],
2287 );
2288
2289This yields :
2290
2291 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2292 WHERE c2 < ? AND c3 LIKE ?))";
2293 @bind = (1234, 100, "foo%");
2294
2295Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2296are expressed in the same way. Of course the C<$sub_stmt> and
2297its associated bind values can be generated through a former call
2298to C<select()> :
2299
2300 my ($sub_stmt, @sub_bind)
2301 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2302 c3 => {-like => "foo%"}});
2303 my %where = (
2304 foo => 1234,
2305 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2306 );
2307
2308In the examples above, the subquery was used as an operator on a column;
2309but the same principle also applies for a clause within the main C<%where>
2310hash, like an EXISTS subquery :
2311
2312 my ($sub_stmt, @sub_bind)
2313 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2314 my %where = (
2315 foo => 1234,
01a01e57 2316 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
96449e8e 2317 );
2318
2319which yields
2320
2321 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2322 WHERE c1 = ? AND c2 > t0.c0))";
2323 @bind = (1234, 1);
2324
2325
2326Observe that the condition on C<c2> in the subquery refers to
2327column C<t0.c0> of the main query : this is I<not> a bind
2328value, so we have to express it through a scalar ref.
2329Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2330C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2331what we wanted here.
2332
2333Another use of the subquery technique is when some SQL clauses need
2334parentheses, as it often occurs with some proprietary SQL extensions
2335like for example fulltext expressions, geospatial expressions,
2336NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
2337
2338 my %where = (
01a01e57 2339 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
96449e8e 2340 );
2341
2342Finally, here is an example where a subquery is used
2343for expressing unary negation:
2344
2345 my ($sub_stmt, @sub_bind)
2346 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2347 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2348 my %where = (
2349 lname => {like => '%son%'},
01a01e57 2350 -nest => \["NOT ($sub_stmt)" => @sub_bind],
96449e8e 2351 );
2352
2353This yields
2354
2355 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2356 @bind = ('%son%', 10, 20)
2357
2358
2359
2360=head2 Conclusion
2361
32eab2da 2362These pages could go on for a while, since the nesting of the data
2363structures this module can handle are pretty much unlimited (the
2364module implements the C<WHERE> expansion as a recursive function
2365internally). Your best bet is to "play around" with the module a
2366little to see how the data structures behave, and choose the best
2367format for your data based on that.
2368
2369And of course, all the values above will probably be replaced with
2370variables gotten from forms or the command line. After all, if you
2371knew everything ahead of time, you wouldn't have to worry about
2372dynamically-generating SQL and could just hardwire it into your
2373script.
2374
96449e8e 2375
2376
2377
86298391 2378=head1 ORDER BY CLAUSES
2379
2380Some functions take an order by clause. This can either be a scalar (just a
2381column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1cfa1db3 2382or an array of either of the two previous forms. Examples:
2383
952f9e2d 2384 Given | Will Generate
1cfa1db3 2385 ----------------------------------------------------------
952f9e2d 2386 |
2387 \'colA DESC' | ORDER BY colA DESC
2388 |
2389 'colA' | ORDER BY colA
2390 |
2391 [qw/colA colB/] | ORDER BY colA, colB
2392 |
2393 {-asc => 'colA'} | ORDER BY colA ASC
2394 |
2395 {-desc => 'colB'} | ORDER BY colB DESC
2396 |
2397 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2398 |
2399 { -asc => [qw/colA colB] } | ORDER BY colA ASC, colB ASC
2400 |
2401 [ |
2402 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2403 { -desc => [qw/colB/], | colC ASC, colD ASC
2404 { -asc => [qw/colC colD/],|
2405 ] |
2406 ===========================================================
86298391 2407
96449e8e 2408
2409
2410=head1 SPECIAL OPERATORS
2411
e3f9dff4 2412 my $sqlmaker = SQL::Abstract->new(special_ops => [
3a2e1a5e 2413 {
2414 regex => qr/.../,
e3f9dff4 2415 handler => sub {
2416 my ($self, $field, $op, $arg) = @_;
2417 ...
3a2e1a5e 2418 },
2419 },
2420 {
2421 regex => qr/.../,
2422 handler => 'method_name',
e3f9dff4 2423 },
2424 ]);
2425
2426A "special operator" is a SQL syntactic clause that can be
2427applied to a field, instead of a usual binary operator.
2428For example :
2429
2430 WHERE field IN (?, ?, ?)
2431 WHERE field BETWEEN ? AND ?
2432 WHERE MATCH(field) AGAINST (?, ?)
96449e8e 2433
e3f9dff4 2434Special operators IN and BETWEEN are fairly standard and therefore
3a2e1a5e 2435are builtin within C<SQL::Abstract> (as the overridable methods
2436C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2437like the MATCH .. AGAINST example above which is specific to MySQL,
2438you can write your own operator handlers - supply a C<special_ops>
2439argument to the C<new> method. That argument takes an arrayref of
2440operator definitions; each operator definition is a hashref with two
2441entries:
96449e8e 2442
e3f9dff4 2443=over
2444
2445=item regex
2446
2447the regular expression to match the operator
96449e8e 2448
e3f9dff4 2449=item handler
2450
3a2e1a5e 2451Either a coderef or a plain scalar method name. In both cases
2452the expected return is C<< ($sql, @bind) >>.
2453
2454When supplied with a method name, it is simply called on the
2455L<SQL::Abstract/> object as:
2456
2457 $self->$method_name ($field, $op, $arg)
2458
2459 Where:
2460
2461 $op is the part that matched the handler regex
2462 $field is the LHS of the operator
2463 $arg is the RHS
2464
2465When supplied with a coderef, it is called as:
2466
2467 $coderef->($self, $field, $op, $arg)
2468
e3f9dff4 2469
2470=back
2471
2472For example, here is an implementation
2473of the MATCH .. AGAINST syntax for MySQL
2474
2475 my $sqlmaker = SQL::Abstract->new(special_ops => [
2476
2477 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2478 {regex => qr/^match$/i,
2479 handler => sub {
2480 my ($self, $field, $op, $arg) = @_;
2481 $arg = [$arg] if not ref $arg;
2482 my $label = $self->_quote($field);
2483 my ($placeholder) = $self->_convert('?');
2484 my $placeholders = join ", ", (($placeholder) x @$arg);
2485 my $sql = $self->_sqlcase('match') . " ($label) "
2486 . $self->_sqlcase('against') . " ($placeholders) ";
2487 my @bind = $self->_bindtype($field, @$arg);
2488 return ($sql, @bind);
2489 }
2490 },
2491
2492 ]);
96449e8e 2493
2494
59f23b3d 2495=head1 UNARY OPERATORS
2496
112b5232 2497 my $sqlmaker = SQL::Abstract->new(unary_ops => [
59f23b3d 2498 {
2499 regex => qr/.../,
2500 handler => sub {
2501 my ($self, $op, $arg) = @_;
2502 ...
2503 },
2504 },
2505 {
2506 regex => qr/.../,
2507 handler => 'method_name',
2508 },
2509 ]);
2510
2511A "unary operator" is a SQL syntactic clause that can be
2512applied to a field - the operator goes before the field
2513
2514You can write your own operator handlers - supply a C<unary_ops>
2515argument to the C<new> method. That argument takes an arrayref of
2516operator definitions; each operator definition is a hashref with two
2517entries:
2518
2519=over
2520
2521=item regex
2522
2523the regular expression to match the operator
2524
2525=item handler
2526
2527Either a coderef or a plain scalar method name. In both cases
2528the expected return is C<< $sql >>.
2529
2530When supplied with a method name, it is simply called on the
2531L<SQL::Abstract/> object as:
2532
2533 $self->$method_name ($op, $arg)
2534
2535 Where:
2536
2537 $op is the part that matched the handler regex
2538 $arg is the RHS or argument of the operator
2539
2540When supplied with a coderef, it is called as:
2541
2542 $coderef->($self, $op, $arg)
2543
2544
2545=back
2546
2547
32eab2da 2548=head1 PERFORMANCE
2549
2550Thanks to some benchmarking by Mark Stosberg, it turns out that
2551this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2552I must admit this wasn't an intentional design issue, but it's a
2553byproduct of the fact that you get to control your C<DBI> handles
2554yourself.
2555
2556To maximize performance, use a code snippet like the following:
2557
2558 # prepare a statement handle using the first row
2559 # and then reuse it for the rest of the rows
2560 my($sth, $stmt);
2561 for my $href (@array_of_hashrefs) {
2562 $stmt ||= $sql->insert('table', $href);
2563 $sth ||= $dbh->prepare($stmt);
2564 $sth->execute($sql->values($href));
2565 }
2566
2567The reason this works is because the keys in your C<$href> are sorted
2568internally by B<SQL::Abstract>. Thus, as long as your data retains
2569the same structure, you only have to generate the SQL the first time
2570around. On subsequent queries, simply use the C<values> function provided
2571by this module to return your values in the correct order.
2572
96449e8e 2573
32eab2da 2574=head1 FORMBUILDER
2575
2576If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2577really like this part (I do, at least). Building up a complex query
2578can be as simple as the following:
2579
2580 #!/usr/bin/perl
2581
2582 use CGI::FormBuilder;
2583 use SQL::Abstract;
2584
2585 my $form = CGI::FormBuilder->new(...);
2586 my $sql = SQL::Abstract->new;
2587
2588 if ($form->submitted) {
2589 my $field = $form->field;
2590 my $id = delete $field->{id};
2591 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2592 }
2593
2594Of course, you would still have to connect using C<DBI> to run the
2595query, but the point is that if you make your form look like your
2596table, the actual query script can be extremely simplistic.
2597
2598If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2599a fast interface to returning and formatting data. I frequently
2600use these three modules together to write complex database query
2601apps in under 50 lines.
2602
32eab2da 2603
96449e8e 2604=head1 CHANGES
2605
2606Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2607Great care has been taken to preserve the I<published> behavior
2608documented in previous versions in the 1.* family; however,
2609some features that were previously undocumented, or behaved
2610differently from the documentation, had to be changed in order
2611to clarify the semantics. Hence, client code that was relying
2612on some dark areas of C<SQL::Abstract> v1.*
2613B<might behave differently> in v1.50.
32eab2da 2614
d2a8fe1a 2615The main changes are :
2616
96449e8e 2617=over
32eab2da 2618
96449e8e 2619=item *
32eab2da 2620
96449e8e 2621support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2622
2623=item *
2624
145fbfc8 2625support for the { operator => \"..." } construct (to embed literal SQL)
2626
2627=item *
2628
9c37b9c0 2629support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2630
2631=item *
2632
96449e8e 2633optional support for L<array datatypes|/"Inserting and Updating Arrays">
2634
2635=item *
2636
2637defensive programming : check arguments
2638
2639=item *
2640
2641fixed bug with global logic, which was previously implemented
7cac25e6 2642through global variables yielding side-effects. Prior versions would
96449e8e 2643interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2644as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2645Now this is interpreted
2646as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2647
96449e8e 2648
2649=item *
2650
2651fixed semantics of _bindtype on array args
2652
2653=item *
2654
2655dropped the C<_anoncopy> of the %where tree. No longer necessary,
2656we just avoid shifting arrays within that tree.
2657
2658=item *
2659
2660dropped the C<_modlogic> function
2661
2662=back
32eab2da 2663
32eab2da 2664
32eab2da 2665
2666=head1 ACKNOWLEDGEMENTS
2667
2668There are a number of individuals that have really helped out with
2669this module. Unfortunately, most of them submitted bugs via CPAN
2670so I have no idea who they are! But the people I do know are:
2671
86298391 2672 Ash Berlin (order_by hash term support)
b643abe1 2673 Matt Trout (DBIx::Class support)
32eab2da 2674 Mark Stosberg (benchmarking)
2675 Chas Owens (initial "IN" operator support)
2676 Philip Collins (per-field SQL functions)
2677 Eric Kolve (hashref "AND" support)
2678 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2679 Dan Kubb (support for "quote_char" and "name_sep")
f5aab26e 2680 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
01a01e57 2681 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
dbdf7648 2682 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
e96c510a 2683 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
02288357 2684 Oliver Charles (support for "RETURNING" after "INSERT")
32eab2da 2685
2686Thanks!
2687
32eab2da 2688=head1 SEE ALSO
2689
86298391 2690L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
32eab2da 2691
32eab2da 2692=head1 AUTHOR
2693
b643abe1 2694Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2695
2696This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
32eab2da 2697
abe72f94 2698For support, your best bet is to try the C<DBIx::Class> users mailing list.
2699While not an official support venue, C<DBIx::Class> makes heavy use of
2700C<SQL::Abstract>, and as such list members there are very familiar with
2701how to create queries.
2702
0d067ded 2703=head1 LICENSE
2704
d988ab87 2705This module is free software; you may copy this under the same
2706terms as perl itself (either the GNU General Public License or
2707the Artistic License)
32eab2da 2708
2709=cut
2710