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