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