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