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