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