1 package SQL::Abstract; # see doc at end of file
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)
11 use List::Util qw/first/;
13 #======================================================================
15 #======================================================================
17 our $VERSION = '1.49_01';
21 # special operators (-in, -between). May be extended/overridden by user.
22 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
23 my @BUILTIN_SPECIAL_OPS = (
24 {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
25 {regex => qr/^(not )?in$/i, handler => \&_where_field_IN},
28 #======================================================================
29 # DEBUGGING AND ERROR REPORTING
30 #======================================================================
33 return unless $_[0]->{debug}; shift; # a little faster
34 my $func = (caller(1))[3];
35 warn "[$func] ", @_, "\n";
39 my($func) = (caller(1))[3];
40 carp "[$func] Warning: ", @_;
44 my($func) = (caller(1))[3];
45 croak "[$func] Fatal: ", @_;
49 #======================================================================
51 #======================================================================
55 my $class = ref($self) || $self;
56 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
58 # choose our case by keeping an option around
59 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
61 # default logic for interpreting arrayrefs
62 $opt{logic} = uc $opt{logic} || 'OR';
64 # how to return bind vars
65 # LDNOTE: changed nwiger code : why this 'delete' ??
66 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
67 $opt{bindtype} ||= 'normal';
69 # default comparison is "=", but can be overridden
72 # try to recognize which are the 'equality' and 'unequality' ops
73 # (temporary quickfix, should go through a more seasoned API)
74 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
75 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
78 $opt{sqltrue} ||= '1=1';
79 $opt{sqlfalse} ||= '0=1';
82 $opt{special_ops} ||= [];
83 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
85 return bless \%opt, $class;
90 #======================================================================
92 #======================================================================
96 my $table = $self->_table(shift);
97 my $data = shift || return;
99 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
100 my ($sql, @bind) = $self->$method($data);
101 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
102 return wantarray ? ($sql, @bind) : $sql;
105 sub _insert_HASHREF { # explicit list of fields and then values
106 my ($self, $data) = @_;
108 my @fields = sort keys %$data;
111 { # get values (need temporary override of bindtype to avoid an error)
112 local $self->{bindtype} = 'normal';
113 ($sql, @bind) = $self->_insert_ARRAYREF([@{$data}{@fields}]);
116 # if necessary, transform values according to 'bindtype'
117 if ($self->{bindtype} eq 'columns') {
118 for my $i (0 .. $#fields) {
119 ($bind[$i]) = $self->_bindtype($fields[$i], $bind[$i]);
124 $_ = $self->_quote($_) foreach @fields;
125 $sql = "( ".join(", ", @fields).") ".$sql;
127 return ($sql, @bind);
130 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
131 my ($self, $data) = @_;
133 # no names (arrayref) so can't generate bindtype
134 $self->{bindtype} ne 'columns'
135 or belch "can't do 'columns' bindtype when called with arrayref";
137 my (@values, @all_bind);
140 $self->_SWITCH_refkind($v, {
143 if ($self->{array_datatypes}) { # if array datatype are activated
146 else { # else literal SQL with bind
147 my ($sql, @bind) = @$v;
149 push @all_bind, @bind;
153 ARRAYREFREF => sub { # literal SQL with bind
154 my ($sql, @bind) = @${$v};
156 push @all_bind, @bind;
159 # THINK : anything useful to do with a HASHREF ?
161 SCALARREF => sub { # literal SQL without bind
165 SCALAR_or_UNDEF => sub {
174 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
175 return ($sql, @all_bind);
179 sub _insert_ARRAYREFREF { # literal SQL with bind
180 my ($self, $data) = @_;
185 sub _insert_SCALARREF { # literal SQL without bind
186 my ($self, $data) = @_;
193 #======================================================================
195 #======================================================================
200 my $table = $self->_table(shift);
201 my $data = shift || return;
204 # first build the 'SET' part of the sql statement
205 my (@set, @all_bind);
206 puke "Unsupported data type specified to \$sql->update"
207 unless ref $data eq 'HASH';
209 for my $k (sort keys %$data) {
212 my $label = $self->_quote($k);
214 $self->_SWITCH_refkind($v, {
216 if ($self->{array_datatypes}) { # array datatype
217 push @set, "$label = ?";
218 push @all_bind, $self->_bindtype($k, $v);
220 else { # literal SQL with bind
221 my ($sql, @bind) = @$v;
222 push @set, "$label = $sql";
223 push @all_bind, $self->_bindtype($k, @bind);
226 ARRAYREFREF => sub { # literal SQL with bind
227 my ($sql, @bind) = @${$v};
228 push @set, "$label = $sql";
229 push @all_bind, $self->_bindtype($k, @bind);
231 SCALARREF => sub { # literal SQL without bind
232 push @set, "$label = $$v";
234 SCALAR_or_UNDEF => sub {
235 push @set, "$label = ?";
236 push @all_bind, $self->_bindtype($k, $v);
242 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
246 my($where_sql, @where_bind) = $self->where($where);
248 push @all_bind, @where_bind;
251 return wantarray ? ($sql, @all_bind) : $sql;
257 #======================================================================
259 #======================================================================
264 my $table = $self->_table(shift);
265 my $fields = shift || '*';
269 my($where_sql, @bind) = $self->where($where, $order);
271 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
273 my $sql = join(' ', $self->_sqlcase('select'), $f,
274 $self->_sqlcase('from'), $table)
277 return wantarray ? ($sql, @bind) : $sql;
280 #======================================================================
282 #======================================================================
287 my $table = $self->_table(shift);
291 my($where_sql, @bind) = $self->where($where);
292 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
294 return wantarray ? ($sql, @bind) : $sql;
298 #======================================================================
300 #======================================================================
304 # Finally, a separate routine just to handle WHERE clauses
306 my ($self, $where, $order) = @_;
309 my ($sql, @bind) = $self->_recurse_where($where);
310 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
314 $sql .= $self->_order_by($order);
317 return wantarray ? ($sql, @bind) : $sql;
322 my ($self, $where, $logic) = @_;
324 # dispatch on appropriate method according to refkind of $where
325 my $method = $self->_METHOD_FOR_refkind("_where", $where);
326 $self->$method($where, $logic);
331 #======================================================================
332 # WHERE: top-level ARRAYREF
333 #======================================================================
336 sub _where_ARRAYREF {
337 my ($self, $where, $logic) = @_;
339 $logic = uc($logic || $self->{logic});
340 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
342 my @clauses = @$where;
344 # if the array starts with [-and|or => ...], recurse with that logic
345 my $first = $clauses[0] || '';
346 if ($first =~ /^-(and|or)/i) {
349 return $self->_where_ARRAYREF(\@clauses, $logic);
353 my (@sql_clauses, @all_bind);
355 # need to use while() so can shift() for pairs
356 while (my $el = shift @clauses) {
358 # switch according to kind of $el and get corresponding ($sql, @bind)
359 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
361 # skip empty elements, otherwise get invalid trailing AND stuff
362 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
364 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
365 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
366 # side-effect: the first hashref within an array would change
367 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
368 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
369 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
371 SCALARREF => sub { ($$el); },
373 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
374 $self->_recurse_where({$el => shift(@clauses)})},
376 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
379 push @sql_clauses, $sql;
380 push @all_bind, @bind;
383 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
388 #======================================================================
389 # WHERE: top-level HASHREF
390 #======================================================================
393 my ($self, $where) = @_;
394 my (@sql_clauses, @all_bind);
396 # LDNOTE : don't really know why we need to sort keys
397 for my $k (sort keys %$where) {
398 my $v = $where->{$k};
400 # ($k => $v) is either a special op or a regular hashpair
401 my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
403 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
404 $self->$method($k, $v);
407 push @sql_clauses, $sql;
408 push @all_bind, @bind;
411 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
415 sub _where_op_in_hash {
416 my ($self, $op, $v) = @_;
418 $op =~ /^(AND|OR|NEST)[_\d]*/i
419 or puke "unknown operator: -$op";
420 $op = uc($1); # uppercase, remove trailing digits
421 $self->_debug("OP(-$op) within hashref, recursing...");
423 $self->_SWITCH_refkind($v, {
426 # LDNOTE : should deprecate {-or => [...]} and {-and => [...]}
427 # because they are misleading; the only proper way would be
428 # -nest => [-or => ...], -nest => [-and ...]
429 return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
434 belch "-or => {...} should be -nest => [...]";
435 return $self->_where_ARRAYREF([%$v], 'OR');
438 return $self->_where_HASHREF($v);
442 SCALARREF => sub { # literal SQL
444 or puke "-$op => \\\$scalar not supported, use -nest => ...";
448 ARRAYREFREF => sub { # literal SQL
450 or puke "-$op => \\[..] not supported, use -nest => ...";
454 SCALAR => sub { # permissively interpreted as SQL
456 or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
457 belch "literal SQL should be -nest => \\'scalar' "
458 . "instead of -nest => 'scalar' ";
463 puke "-$op => undef not supported";
469 sub _where_hashpair_ARRAYREF {
470 my ($self, $k, $v) = @_;
473 my @v = @$v; # need copy because of shift below
474 $self->_debug("ARRAY($k) means distribute over elements");
476 # put apart first element if it is an operator (-and, -or)
477 my $op = $v[0] =~ /^-/ ? shift @v : undef;
478 $self->_debug("OP($op) reinjected into the distributed array") if $op;
480 my @distributed = map { {$k => $_} } @v;
481 unshift @distributed, $op if $op;
483 return $self->_recurse_where(\@distributed);
486 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
487 $self->_debug("empty ARRAY($k) means 0=1");
488 return ($self->{sqlfalse});
492 sub _where_hashpair_HASHREF {
493 my ($self, $k, $v) = @_;
495 my (@all_sql, @all_bind);
497 for my $op (sort keys %$v) {
500 # put the operator in canonical form
501 $op =~ s/^-//; # remove initial dash
502 $op =~ tr/_/ /; # underscores become spaces
503 $op =~ s/^\s+//; # no initial space
504 $op =~ s/\s+$//; # no final space
505 $op =~ s/\s+/ /; # multiple spaces become one
509 # CASE: special operators like -in or -between
510 my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
512 ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
515 # CASE: col => {op => \@vals}
516 elsif (ref $val eq 'ARRAY') {
517 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
520 # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
521 elsif (! defined($val)) {
522 my $is = ($op =~ $self->{equality_op}) ? 'is' :
523 ($op =~ $self->{inequality_op}) ? 'is not' :
524 puke "unexpected operator '$op' with undef operand";
525 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
528 # CASE: col => {op => $scalar}
530 $sql = join ' ', $self->_convert($self->_quote($k)),
531 $self->_sqlcase($op),
532 $self->_convert('?');
533 @bind = $self->_bindtype($k, $val);
537 push @all_bind, @bind;
540 return $self->_join_sql_clauses('and', \@all_sql, \@all_bind);
545 sub _where_field_op_ARRAYREF {
546 my ($self, $k, $op, $vals) = @_;
549 $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
553 # LDNOTE : change the distribution logic when
554 # $op =~ $self->{inequality_op}, because of Morgan laws :
555 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
556 # WHERE field != 22 OR field != 33 : the user probably means
557 # WHERE field != 22 AND field != 33.
558 my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
560 # distribute $op over each member of @$vals
561 return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
565 # try to DWIM on equality operators
566 # LDNOTE : not 100% sure this is the correct thing to do ...
567 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
568 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
571 puke "operator '$op' applied on an empty array (field '$k')";
576 sub _where_hashpair_SCALARREF {
577 my ($self, $k, $v) = @_;
578 $self->_debug("SCALAR($k) means literal SQL: $$v");
579 my $sql = $self->_quote($k) . " " . $$v;
583 sub _where_hashpair_ARRAYREFREF {
584 my ($self, $k, $v) = @_;
585 $self->_debug("REF($k) means literal SQL: @${$v}");
586 my ($sql, @bind) = @${$v};
587 $sql = $self->_quote($k) . " " . $sql;
588 @bind = $self->_bindtype($k, @bind);
589 return ($sql, @bind );
592 sub _where_hashpair_SCALAR {
593 my ($self, $k, $v) = @_;
594 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
595 my $sql = join ' ', $self->_convert($self->_quote($k)),
596 $self->_sqlcase($self->{cmp}),
597 $self->_convert('?');
598 my @bind = $self->_bindtype($k, $v);
599 return ( $sql, @bind);
603 sub _where_hashpair_UNDEF {
604 my ($self, $k, $v) = @_;
605 $self->_debug("UNDEF($k) means IS NULL");
606 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
610 #======================================================================
611 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
612 #======================================================================
615 sub _where_SCALARREF {
616 my ($self, $where) = @_;
619 $self->_debug("SCALAR(*top) means literal SQL: $$where");
625 my ($self, $where) = @_;
628 $self->_debug("NOREF(*top) means literal SQL: $where");
639 #======================================================================
640 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
641 #======================================================================
644 sub _where_field_BETWEEN {
645 my ($self, $k, $op, $vals) = @_;
647 ref $vals eq 'ARRAY' && @$vals == 2
648 or puke "special op 'between' requires an arrayref of two values";
650 my ($label) = $self->_convert($self->_quote($k));
651 my ($placeholder) = $self->_convert('?');
652 my $and = $self->_sqlcase('and');
653 $op = $self->_sqlcase($op);
655 my $sql = "( $label $op $placeholder $and $placeholder )";
656 my @bind = $self->_bindtype($k, @$vals);
661 sub _where_field_IN {
662 my ($self, $k, $op, $vals) = @_;
664 # backwards compatibility : if scalar, force into an arrayref
665 $vals = [$vals] if defined $vals && ! ref $vals;
668 or puke "special op 'in' requires an arrayref";
670 my ($label) = $self->_convert($self->_quote($k));
671 my ($placeholder) = $self->_convert('?');
672 my $and = $self->_sqlcase('and');
673 $op = $self->_sqlcase($op);
675 if (@$vals) { # nonempty list
676 my $placeholders = join ", ", (($placeholder) x @$vals);
677 my $sql = "$label $op ( $placeholders )";
678 my @bind = $self->_bindtype($k, @$vals);
680 return ($sql, @bind);
682 else { # empty list : some databases won't understand "IN ()", so DWIM
683 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
693 #======================================================================
695 #======================================================================
698 my ($self, $arg) = @_;
700 # construct list of ordering instructions
701 my @order = $self->_SWITCH_refkind($arg, {
704 map {$self->_SWITCH_refkind($_, {
705 SCALAR => sub {$self->_quote($_)},
706 SCALARREF => sub {$$_}, # literal SQL, no quoting
707 HASHREF => sub {$self->_order_by_hash($_)}
711 SCALAR => sub {$self->_quote($arg)},
712 SCALARREF => sub {$$arg}, # literal SQL, no quoting
713 HASHREF => sub {$self->_order_by_hash($arg)},
718 my $order = join ', ', @order;
719 return $order ? $self->_sqlcase(' order by')." $order" : '';
724 my ($self, $hash) = @_;
726 # get first pair in hash
727 my ($key, $val) = each %$hash;
729 # check if one pair was found and no other pair in hash
730 $key && !(each %$hash)
731 or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
733 my ($order) = ($key =~ /^-(desc|asc)/i)
734 or puke "invalid key in _order_by hash : $key";
736 return $self->_quote($val) ." ". $self->_sqlcase($order);
741 #======================================================================
742 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
743 #======================================================================
748 $self->_SWITCH_refkind($from, {
749 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
750 SCALAR => sub {$self->_quote($from)},
751 SCALARREF => sub {$$from},
752 ARRAYREFREF => sub {join ', ', @$from;},
757 #======================================================================
759 #======================================================================
765 $label or puke "can't quote an empty label";
767 # left and right quote characters
768 my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
769 SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
770 ARRAYREF => sub {@{$self->{quote_char}}},
774 or puke "quote_char must be an arrayref of 2 values";
776 # no quoting if no quoting chars
777 $ql or return $label;
779 # no quoting for literal SQL
780 return $$label if ref($label) eq 'SCALAR';
782 # separate table / column (if applicable)
783 my $sep = $self->{name_sep} || '';
784 my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
786 # do the quoting, except for "*" or for `table`.*
787 my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
789 # reassemble and return.
790 return join $sep, @quoted;
794 # Conversion, if applicable
796 my ($self, $arg) = @_;
798 # LDNOTE : modified the previous implementation below because
799 # it was not consistent : the first "return" is always an array,
800 # the second "return" is context-dependent. Anyway, _convert
801 # seems always used with just a single argument, so make it a
803 # return @_ unless $self->{convert};
804 # my $conv = $self->_sqlcase($self->{convert});
805 # my @ret = map { $conv.'('.$_.')' } @_;
806 # return wantarray ? @ret : $ret[0];
807 if ($self->{convert}) {
808 my $conv = $self->_sqlcase($self->{convert});
809 $arg = $conv.'('.$arg.')';
817 my($col, @vals) = @_;
819 #LDNOTE : changed original implementation below because it did not make
820 # sense when bindtype eq 'columns' and @vals > 1.
821 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
823 return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
826 sub _join_sql_clauses {
827 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
829 if (@$clauses_aref > 1) {
830 my $join = " " . $self->_sqlcase($logic) . " ";
831 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
832 return ($sql, @$bind_aref);
834 elsif (@$clauses_aref) {
835 return ($clauses_aref->[0], @$bind_aref); # no parentheses
838 return (); # if no SQL, ignore @$bind_aref
843 # Fix SQL case, if so requested
847 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
848 # don't touch the argument ... crooked logic, but let's not change it!
849 return $self->{case} ? $_[0] : uc($_[0]);
853 #======================================================================
854 # DISPATCHING FROM REFKIND
855 #======================================================================
858 my ($self, $data) = @_;
862 # $suffix = 'REF' x (length of ref chain, i. e. \\[] is REFREFREF)
866 last if $ref ne 'REF';
870 return $ref ? $ref.$suffix :
871 defined $data ? 'SCALAR' :
876 my ($self, $data) = @_;
877 my @try = ($self->_refkind($data));
878 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
879 push @try, 'FALLBACK';
883 sub _METHOD_FOR_refkind {
884 my ($self, $meth_prefix, $data) = @_;
885 my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
886 $self->_try_refkind($data)
887 or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
892 sub _SWITCH_refkind {
893 my ($self, $data, $dispatch_table) = @_;
895 my $coderef = first {$_} map {$dispatch_table->{$_}}
896 $self->_try_refkind($data)
897 or puke "no dispatch entry for ".$self->_refkind($data);
904 #======================================================================
905 # VALUES, GENERATE, AUTOLOAD
906 #======================================================================
908 # LDNOTE: original code from nwiger, didn't touch code in that section
909 # I feel the AUTOLOAD stuff should not be the default, it should
910 # only be activated on explicit demand by user.
914 my $data = shift || return;
915 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
916 unless ref $data eq 'HASH';
917 return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
923 my(@sql, @sqlq, @sqlv);
927 if ($ref eq 'HASH') {
928 for my $k (sort keys %$_) {
931 my $label = $self->_quote($k);
933 # SQL included for values
935 my $sql = shift @bind;
936 push @sqlq, "$label = $sql";
937 push @sqlv, $self->_bindtype($k, @bind);
938 } elsif ($r eq 'SCALAR') {
939 # embedded literal SQL
940 push @sqlq, "$label = $$v";
942 push @sqlq, "$label = ?";
943 push @sqlv, $self->_bindtype($k, $v);
946 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
947 } elsif ($ref eq 'ARRAY') {
948 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
953 push @sqlq, shift @val;
955 } elsif ($r eq 'SCALAR') {
956 # embedded literal SQL
963 push @sql, '(' . join(', ', @sqlq) . ')';
964 } elsif ($ref eq 'SCALAR') {
968 # strings get case twiddled
969 push @sql, $self->_sqlcase($_);
973 my $sql = join ' ', @sql;
975 # this is pretty tricky
976 # if ask for an array, return ($stmt, @bind)
977 # otherwise, s/?/shift @sqlv/ to put it inline
979 return ($sql, @sqlv);
981 1 while $sql =~ s/\?/my $d = shift(@sqlv);
982 ref $d ? $d->[1] : $d/e;
991 # This allows us to check for a local, then _form, attr
993 my($name) = $AUTOLOAD =~ /.*::(.+)/;
994 return $self->generate($name, @_);
1005 SQL::Abstract - Generate SQL from Perl data structures
1011 my $sql = SQL::Abstract->new;
1013 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1015 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1017 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1019 my($stmt, @bind) = $sql->delete($table, \%where);
1021 # Then, use these in your DBI statements
1022 my $sth = $dbh->prepare($stmt);
1023 $sth->execute(@bind);
1025 # Just generate the WHERE clause
1026 my($stmt, @bind) = $sql->where(\%where, \@order);
1028 # Return values in the same order, for hashed queries
1029 # See PERFORMANCE section for more details
1030 my @bind = $sql->values(\%fieldvals);
1034 This module was inspired by the excellent L<DBIx::Abstract>.
1035 However, in using that module I found that what I really wanted
1036 to do was generate SQL, but still retain complete control over my
1037 statement handles and use the DBI interface. So, I set out to
1038 create an abstract SQL generation module.
1040 While based on the concepts used by L<DBIx::Abstract>, there are
1041 several important differences, especially when it comes to WHERE
1042 clauses. I have modified the concepts used to make the SQL easier
1043 to generate from Perl data structures and, IMO, more intuitive.
1044 The underlying idea is for this module to do what you mean, based
1045 on the data structures you provide it. The big advantage is that
1046 you don't have to modify your code every time your data changes,
1047 as this module figures it out.
1049 To begin with, an SQL INSERT is as easy as just specifying a hash
1050 of C<key=value> pairs:
1053 name => 'Jimbo Bobson',
1054 phone => '123-456-7890',
1055 address => '42 Sister Lane',
1056 city => 'St. Louis',
1057 state => 'Louisiana',
1060 The SQL can then be generated with this:
1062 my($stmt, @bind) = $sql->insert('people', \%data);
1064 Which would give you something like this:
1066 $stmt = "INSERT INTO people
1067 (address, city, name, phone, state)
1068 VALUES (?, ?, ?, ?, ?)";
1069 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1070 '123-456-7890', 'Louisiana');
1072 These are then used directly in your DBI code:
1074 my $sth = $dbh->prepare($stmt);
1075 $sth->execute(@bind);
1077 =head2 Inserting and Updating Arrays
1079 If your database has array types (like for example Postgres),
1080 activate the special option C<< array_datatypes => 1 >>
1081 when creating the C<SQL::Abstract> object.
1082 Then you may use an arrayref to insert and update database array types:
1084 my $sql = SQL::Abstract->new(array_datatypes => 1);
1086 planets => [qw/Mercury Venus Earth Mars/]
1089 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1093 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1095 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1098 =head2 Inserting and Updating SQL
1100 In order to apply SQL functions to elements of your C<%data> you may
1101 specify a reference to an arrayref for the given hash value. For example,
1102 if you need to execute the Oracle C<to_date> function on a value, you can
1103 say something like this:
1107 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1110 The first value in the array is the actual SQL. Any other values are
1111 optional and would be included in the bind values array. This gives
1114 my($stmt, @bind) = $sql->insert('people', \%data);
1116 $stmt = "INSERT INTO people (name, date_entered)
1117 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1118 @bind = ('Bill', '03/02/2003');
1120 An UPDATE is just as easy, all you change is the name of the function:
1122 my($stmt, @bind) = $sql->update('people', \%data);
1124 Notice that your C<%data> isn't touched; the module will generate
1125 the appropriately quirky SQL for you automatically. Usually you'll
1126 want to specify a WHERE clause for your UPDATE, though, which is
1127 where handling C<%where> hashes comes in handy...
1129 =head2 Complex where statements
1131 This module can generate pretty complicated WHERE statements
1132 easily. For example, simple C<key=value> pairs are taken to mean
1133 equality, and if you want to see if a field is within a set
1134 of values, you can use an arrayref. Let's say we wanted to
1135 SELECT some data based on this criteria:
1138 requestor => 'inna',
1139 worker => ['nwiger', 'rcwe', 'sfz'],
1140 status => { '!=', 'completed' }
1143 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1145 The above would give you something like this:
1147 $stmt = "SELECT * FROM tickets WHERE
1148 ( requestor = ? ) AND ( status != ? )
1149 AND ( worker = ? OR worker = ? OR worker = ? )";
1150 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1152 Which you could then use in DBI code like so:
1154 my $sth = $dbh->prepare($stmt);
1155 $sth->execute(@bind);
1161 The functions are simple. There's one for each major SQL operation,
1162 and a constructor you use first. The arguments are specified in a
1163 similar order to each function (table, then fields, then a where
1164 clause) to try and simplify things.
1169 =head2 new(option => 'value')
1171 The C<new()> function takes a list of options and values, and returns
1172 a new B<SQL::Abstract> object which can then be used to generate SQL
1173 through the methods below. The options accepted are:
1179 If set to 'lower', then SQL will be generated in all lowercase. By
1180 default SQL is generated in "textbook" case meaning something like:
1182 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1184 Any setting other than 'lower' is ignored.
1188 This determines what the default comparison operator is. By default
1189 it is C<=>, meaning that a hash like this:
1191 %where = (name => 'nwiger', email => 'nate@wiger.org');
1193 Will generate SQL like this:
1195 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1197 However, you may want loose comparisons by default, so if you set
1198 C<cmp> to C<like> you would get SQL such as:
1200 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1202 You can also override the comparsion on an individual basis - see
1203 the huge section on L</"WHERE CLAUSES"> at the bottom.
1205 =item sqltrue, sqlfalse
1207 Expressions for inserting boolean values within SQL statements.
1208 By default these are C<1=1> and C<1=0>.
1212 This determines the default logical operator for multiple WHERE
1213 statements in arrays. By default it is "or", meaning that a WHERE
1217 event_date => {'>=', '2/13/99'},
1218 event_date => {'<=', '4/24/03'},
1221 Will generate SQL like this:
1223 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1225 This is probably not what you want given this query, though (look
1226 at the dates). To change the "OR" to an "AND", simply specify:
1228 my $sql = SQL::Abstract->new(logic => 'and');
1230 Which will change the above C<WHERE> to:
1232 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1234 The logic can also be changed locally by inserting
1235 an extra first element in the array :
1237 @where = (-and => event_date => {'>=', '2/13/99'},
1238 event_date => {'<=', '4/24/03'} );
1240 See the L</"WHERE CLAUSES"> section for explanations.
1244 This will automatically convert comparisons using the specified SQL
1245 function for both column and value. This is mostly used with an argument
1246 of C<upper> or C<lower>, so that the SQL will have the effect of
1247 case-insensitive "searches". For example, this:
1249 $sql = SQL::Abstract->new(convert => 'upper');
1250 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1252 Will turn out the following SQL:
1254 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1256 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1257 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1258 not validate this option; it will just pass through what you specify verbatim).
1262 This is a kludge because many databases suck. For example, you can't
1263 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1264 Instead, you have to use C<bind_param()>:
1266 $sth->bind_param(1, 'reg data');
1267 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1269 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1270 which loses track of which field each slot refers to. Fear not.
1272 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1273 Currently, you can specify either C<normal> (default) or C<columns>. If you
1274 specify C<columns>, you will get an array that looks like this:
1276 my $sql = SQL::Abstract->new(bindtype => 'columns');
1277 my($stmt, @bind) = $sql->insert(...);
1280 [ 'column1', 'value1' ],
1281 [ 'column2', 'value2' ],
1282 [ 'column3', 'value3' ],
1285 You can then iterate through this manually, using DBI's C<bind_param()>.
1287 $sth->prepare($stmt);
1290 my($col, $data) = @$_;
1291 if ($col eq 'details' || $col eq 'comments') {
1292 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1293 } elsif ($col eq 'image') {
1294 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1296 $sth->bind_param($i, $data);
1300 $sth->execute; # execute without @bind now
1302 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1303 Basically, the advantage is still that you don't have to care which fields
1304 are or are not included. You could wrap that above C<for> loop in a simple
1305 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1306 get a layer of abstraction over manual SQL specification.
1310 This is the character that a table or column name will be quoted
1311 with. By default this is an empty string, but you could set it to
1312 the character C<`>, to generate SQL like this:
1314 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1316 Alternatively, you can supply an array ref of two items, the first being the left
1317 hand quote character, and the second the right hand quote character. For
1318 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1319 that generates SQL like this:
1321 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1323 Quoting is useful if you have tables or columns names that are reserved
1324 words in your database's SQL dialect.
1328 This is the character that separates a table and column name. It is
1329 necessary to specify this when the C<quote_char> option is selected,
1330 so that tables and column names can be individually quoted like this:
1332 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1334 =item array_datatypes
1336 When this option is true, arrayrefs in INSERT or UPDATE are
1337 interpreted as array datatypes and are passed directly
1339 When this option is false, arrayrefs are interpreted
1340 as literal SQL, just like refs to arrayrefs
1341 (but this behavior is for backwards compatibility; when writing
1342 new queries, use the "reference to arrayref" syntax
1348 Takes a reference to a list of "special operators"
1349 to extend the syntax understood by L<SQL::Abstract>.
1350 See section L</"SPECIAL OPERATORS"> for details.
1356 =head2 insert($table, \@values || \%fieldvals)
1358 This is the simplest function. You simply give it a table name
1359 and either an arrayref of values or hashref of field/value pairs.
1360 It returns an SQL INSERT statement and a list of bind values.
1361 See the sections on L</"Inserting and Updating Arrays"> and
1362 L</"Inserting and Updating SQL"> for information on how to insert
1363 with those data types.
1365 =head2 update($table, \%fieldvals, \%where)
1367 This takes a table, hashref of field/value pairs, and an optional
1368 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1370 See the sections on L</"Inserting and Updating Arrays"> and
1371 L</"Inserting and Updating SQL"> for information on how to insert
1372 with those data types.
1374 =head2 select($source, $fields, $where, $order)
1376 This returns a SQL SELECT statement and associated list of bind values, as
1377 specified by the arguments :
1383 Specification of the 'FROM' part of the statement.
1384 The argument can be either a plain scalar (interpreted as a table
1385 name, will be quoted), or an arrayref (interpreted as a list
1386 of table names, joined by commas, quoted), or a scalarref
1387 (literal table name, not quoted), or a ref to an arrayref
1388 (list of literal table names, joined by commas, not quoted).
1392 Specification of the list of fields to retrieve from
1394 The argument can be either an arrayref (interpreted as a list
1395 of field names, will be joined by commas and quoted), or a
1396 plain scalar (literal SQL, not quoted).
1397 Please observe that this API is not as flexible as for
1398 the first argument <$table>, for backwards compatibility reasons.
1402 Optional argument to specify the WHERE part of the query.
1403 The argument is most often a hashref, but can also be
1404 an arrayref or plain scalar --
1405 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1409 Optional argument to specify the ORDER BY part of the query.
1410 The argument can be a scalar, a hashref or an arrayref
1411 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1417 =head2 delete($table, \%where)
1419 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1420 It returns an SQL DELETE statement and list of bind values.
1422 =head2 where(\%where, \@order)
1424 This is used to generate just the WHERE clause. For example,
1425 if you have an arbitrary data structure and know what the
1426 rest of your SQL is going to look like, but want an easy way
1427 to produce a WHERE clause, use this. It returns an SQL WHERE
1428 clause and list of bind values.
1431 =head2 values(\%data)
1433 This just returns the values from the hash C<%data>, in the same
1434 order that would be returned from any of the other above queries.
1435 Using this allows you to markedly speed up your queries if you
1436 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1438 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1440 Warning: This is an experimental method and subject to change.
1442 This returns arbitrarily generated SQL. It's a really basic shortcut.
1443 It will return two different things, depending on return context:
1445 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1446 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1448 These would return the following:
1450 # First calling form
1451 $stmt = "CREATE TABLE test (?, ?)";
1452 @bind = (field1, field2);
1454 # Second calling form
1455 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1457 Depending on what you're trying to do, it's up to you to choose the correct
1458 format. In this example, the second form is what you would want.
1462 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1466 ALTER SESSION SET nls_date_format = 'MM/YY'
1468 You get the idea. Strings get their case twiddled, but everything
1469 else remains verbatim.
1474 =head1 WHERE CLAUSES
1478 This module uses a variation on the idea from L<DBIx::Abstract>. It
1479 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1480 module is that things in arrays are OR'ed, and things in hashes
1483 The easiest way to explain is to show lots of examples. After
1484 each C<%where> hash shown, it is assumed you used:
1486 my($stmt, @bind) = $sql->where(\%where);
1488 However, note that the C<%where> hash can be used directly in any
1489 of the other functions as well, as described above.
1491 =head2 Key-value pairs
1493 So, let's get started. To begin, a simple hash:
1497 status => 'completed'
1500 Is converted to SQL C<key = val> statements:
1502 $stmt = "WHERE user = ? AND status = ?";
1503 @bind = ('nwiger', 'completed');
1505 One common thing I end up doing is having a list of values that
1506 a field can be in. To do this, simply specify a list inside of
1511 status => ['assigned', 'in-progress', 'pending'];
1514 This simple code will create the following:
1516 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1517 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1519 An empty arrayref will be considered a logical false and
1522 =head2 Key-value pairs
1524 If you want to specify a different type of operator for your comparison,
1525 you can use a hashref for a given column:
1529 status => { '!=', 'completed' }
1532 Which would generate:
1534 $stmt = "WHERE user = ? AND status != ?";
1535 @bind = ('nwiger', 'completed');
1537 To test against multiple values, just enclose the values in an arrayref:
1539 status => { '!=', ['assigned', 'in-progress', 'pending'] };
1541 Which would give you:
1543 "WHERE status != ? AND status != ? AND status != ?"
1545 Notice that since the operator was recognized as being a 'negative'
1546 operator, the arrayref was interpreted with 'AND' logic (because
1547 of Morgan's laws). By contrast, the reverse
1549 status => { '=', ['assigned', 'in-progress', 'pending'] };
1553 "WHERE status = ? OR status = ? OR status = ?"
1556 The hashref can also contain multiple pairs, in which case it is expanded
1557 into an C<AND> of its elements:
1561 status => { '!=', 'completed', -not_like => 'pending%' }
1564 # Or more dynamically, like from a form
1565 $where{user} = 'nwiger';
1566 $where{status}{'!='} = 'completed';
1567 $where{status}{'-not_like'} = 'pending%';
1569 # Both generate this
1570 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1571 @bind = ('nwiger', 'completed', 'pending%');
1574 To get an OR instead, you can combine it with the arrayref idea:
1578 priority => [ {'=', 2}, {'!=', 1} ]
1581 Which would generate:
1583 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1584 @bind = ('nwiger', '2', '1');
1587 =head2 Logic and nesting operators
1589 In the example above,
1590 there is a subtle trap if you want to say something like
1591 this (notice the C<AND>):
1593 WHERE priority != ? AND priority != ?
1595 Because, in Perl you I<can't> do this:
1597 priority => { '!=', 2, '!=', 1 }
1599 As the second C<!=> key will obliterate the first. The solution
1600 is to use the special C<-modifier> form inside an arrayref:
1602 priority => [ -and => {'!=', 2},
1606 Normally, these would be joined by C<OR>, but the modifier tells it
1607 to use C<AND> instead. (Hint: You can use this in conjunction with the
1608 C<logic> option to C<new()> in order to change the way your queries
1609 work by default.) B<Important:> Note that the C<-modifier> goes
1610 B<INSIDE> the arrayref, as an extra first element. This will
1611 B<NOT> do what you think it might:
1613 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1615 Here is a quick list of equivalencies, since there is some overlap:
1618 status => {'!=', 'completed', 'not like', 'pending%' }
1619 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1622 status => {'=', ['assigned', 'in-progress']}
1623 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1624 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1626 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1627 operator which adds an additional set of parens, to create a subquery.
1628 For example, to get something like this:
1630 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1631 @bind = ('nwiger', '20', 'ASIA');
1637 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1640 =head2 Special operators : IN, BETWEEN, etc.
1642 You can also use the hashref format to compare a list of fields using the
1643 C<IN> comparison operator, by specifying the list as an arrayref:
1646 status => 'completed',
1647 reportid => { -in => [567, 2335, 2] }
1650 Which would generate:
1652 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1653 @bind = ('completed', '567', '2335', '2');
1655 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1658 Another pair of operators is C<-between> and C<-not_between>,
1659 used with an arrayref of two values:
1663 completion_date => {
1664 -not_between => ['2002-10-01', '2003-02-06']
1670 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1672 These are the two builtin "special operators"; but the
1673 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1675 =head2 Nested conditions
1677 So far, we've seen how multiple conditions are joined with a top-level
1678 C<AND>. We can change this by putting the different conditions we want in
1679 hashes and then putting those hashes in an array. For example:
1684 status => { -like => ['pending%', 'dispatched'] },
1688 status => 'unassigned',
1692 This data structure would create the following:
1694 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1695 OR ( user = ? AND status = ? ) )";
1696 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1698 This can be combined with the C<-nest> operator to properly group
1705 -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
1706 -and => [workhrs => {'<', 50}, geo => 'EURO' ]
1713 WHERE ( user = ? AND
1714 ( ( workhrs > ? AND geo = ? )
1715 OR ( workhrs < ? AND geo = ? ) ) )
1719 Finally, sometimes only literal SQL will do. If you want to include
1720 literal SQL verbatim, you can specify it as a scalar reference, namely:
1722 my $inn = 'is Not Null';
1724 priority => { '<', 2 },
1730 $stmt = "WHERE priority < ? AND requestor is Not Null";
1733 Note that in this example, you only get one bind parameter back, since
1734 the verbatim SQL is passed as part of the statement.
1736 Of course, just to prove a point, the above can also be accomplished
1740 priority => { '<', 2 },
1741 requestor => { '!=', undef },
1747 Conditions on boolean columns can be expressed in the
1748 same way, passing a reference to an empty string :
1751 priority => { '<', 2 },
1757 $stmt = "WHERE priority < ? AND is_ready";
1761 =head2 Literal SQL with placeholders and bind values (subqueries)
1763 If the literal SQL to be inserted has placeholders and bind values,
1764 use a reference to an arrayref (yes this is a double reference --
1765 not so common, but perfectly legal Perl). For example, to find a date
1766 in Postgres you can use something like this:
1769 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1774 $stmt = "WHERE ( date_column = date \'2008-09-30\' - ?::integer )"
1778 Literal SQL is especially useful for nesting parenthesized clauses in the
1779 main SQL query. Here is a first example :
1781 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1785 bar => \["IN ($sub_stmt)" => @sub_bind],
1790 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1791 WHERE c2 < ? AND c3 LIKE ?))";
1792 @bind = (1234, 100, "foo%");
1794 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1795 are expressed in the same way. Of course the C<$sub_stmt> and
1796 its associated bind values can be generated through a former call
1799 my ($sub_stmt, @sub_bind)
1800 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1801 c3 => {-like => "foo%"}});
1804 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1807 In the examples above, the subquery was used as an operator on a column;
1808 but the same principle also applies for a clause within the main C<%where>
1809 hash, like an EXISTS subquery :
1811 my ($sub_stmt, @sub_bind)
1812 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1815 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1820 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1821 WHERE c1 = ? AND c2 > t0.c0))";
1825 Observe that the condition on C<c2> in the subquery refers to
1826 column C<t0.c0> of the main query : this is I<not> a bind
1827 value, so we have to express it through a scalar ref.
1828 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1829 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1830 what we wanted here.
1832 Another use of the subquery technique is when some SQL clauses need
1833 parentheses, as it often occurs with some proprietary SQL extensions
1834 like for example fulltext expressions, geospatial expressions,
1835 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1838 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1841 Finally, here is an example where a subquery is used
1842 for expressing unary negation:
1844 my ($sub_stmt, @sub_bind)
1845 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1846 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1848 lname => {like => '%son%'},
1849 -nest => \["NOT ($sub_stmt)" => @sub_bind],
1854 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1855 @bind = ('%son%', 10, 20)
1861 These pages could go on for a while, since the nesting of the data
1862 structures this module can handle are pretty much unlimited (the
1863 module implements the C<WHERE> expansion as a recursive function
1864 internally). Your best bet is to "play around" with the module a
1865 little to see how the data structures behave, and choose the best
1866 format for your data based on that.
1868 And of course, all the values above will probably be replaced with
1869 variables gotten from forms or the command line. After all, if you
1870 knew everything ahead of time, you wouldn't have to worry about
1871 dynamically-generating SQL and could just hardwire it into your
1877 =head1 ORDER BY CLAUSES
1879 Some functions take an order by clause. This can either be a scalar (just a
1880 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1881 or an array of either of the two previous forms. Examples:
1883 Given | Will Generate
1884 ----------------------------------------------------------
1885 \'colA DESC' | ORDER BY colA DESC
1886 'colA' | ORDER BY colA
1887 [qw/colA colB/] | ORDER BY colA, colB
1888 {-asc => 'colA'} | ORDER BY colA ASC
1889 {-desc => 'colB'} | ORDER BY colB DESC
1891 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
1894 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
1895 ==========================================================
1899 =head1 SPECIAL OPERATORS
1904 =head1 TABLES AND JOINS
1911 Thanks to some benchmarking by Mark Stosberg, it turns out that
1912 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
1913 I must admit this wasn't an intentional design issue, but it's a
1914 byproduct of the fact that you get to control your C<DBI> handles
1917 To maximize performance, use a code snippet like the following:
1919 # prepare a statement handle using the first row
1920 # and then reuse it for the rest of the rows
1922 for my $href (@array_of_hashrefs) {
1923 $stmt ||= $sql->insert('table', $href);
1924 $sth ||= $dbh->prepare($stmt);
1925 $sth->execute($sql->values($href));
1928 The reason this works is because the keys in your C<$href> are sorted
1929 internally by B<SQL::Abstract>. Thus, as long as your data retains
1930 the same structure, you only have to generate the SQL the first time
1931 around. On subsequent queries, simply use the C<values> function provided
1932 by this module to return your values in the correct order.
1937 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
1938 really like this part (I do, at least). Building up a complex query
1939 can be as simple as the following:
1943 use CGI::FormBuilder;
1946 my $form = CGI::FormBuilder->new(...);
1947 my $sql = SQL::Abstract->new;
1949 if ($form->submitted) {
1950 my $field = $form->field;
1951 my $id = delete $field->{id};
1952 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
1955 Of course, you would still have to connect using C<DBI> to run the
1956 query, but the point is that if you make your form look like your
1957 table, the actual query script can be extremely simplistic.
1959 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
1960 a fast interface to returning and formatting data. I frequently
1961 use these three modules together to write complex database query
1962 apps in under 50 lines.
1967 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
1968 Great care has been taken to preserve the I<published> behavior
1969 documented in previous versions in the 1.* family; however,
1970 some features that were previously undocumented, or behaved
1971 differently from the documentation, had to be changed in order
1972 to clarify the semantics. Hence, client code that was relying
1973 on some dark areas of C<SQL::Abstract> v1.*
1974 B<might behave differently> in v1.50.
1976 =head1 Public changes
1982 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
1986 added -nest1, -nest2 or -nest_1, -nest_2, ...
1990 optional support for L<array datatypes|/"Inserting and Updating Arrays">
1994 defensive programming : check arguments
1998 fixed bug with global logic, which was previously implemented
1999 through global variables yielding side-effects. Prior versons would
2000 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2001 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2002 Now this is interpreted
2003 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2007 C<-and> / C<-or> operators are no longer accepted
2008 in the middle of an arrayref : they are
2009 only admitted if in first position.
2013 changed logic for distributing an op over arrayrefs
2017 fixed semantics of _bindtype on array args
2021 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2022 we just avoid shifting arrays within that tree.
2026 dropped the C<_modlogic> function
2032 =head1 ACKNOWLEDGEMENTS
2034 There are a number of individuals that have really helped out with
2035 this module. Unfortunately, most of them submitted bugs via CPAN
2036 so I have no idea who they are! But the people I do know are:
2038 Ash Berlin (order_by hash term support)
2039 Matt Trout (DBIx::Class support)
2040 Mark Stosberg (benchmarking)
2041 Chas Owens (initial "IN" operator support)
2042 Philip Collins (per-field SQL functions)
2043 Eric Kolve (hashref "AND" support)
2044 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2045 Dan Kubb (support for "quote_char" and "name_sep")
2046 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2047 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2053 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2057 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2059 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2061 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2062 While not an official support venue, C<DBIx::Class> makes heavy use of
2063 C<SQL::Abstract>, and as such list members there are very familiar with
2064 how to create queries.
2066 This module is free software; you may copy this under the terms of
2067 the GNU General Public License, or the Artistic License, copies of
2068 which should have accompanied your Perl kit.