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