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