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