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