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