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