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 C<$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 If you need several nested subexpressions, you can number
1641 the C<-nest> branches :
1651 =head2 Special operators : IN, BETWEEN, etc.
1653 You can also use the hashref format to compare a list of fields using the
1654 C<IN> comparison operator, by specifying the list as an arrayref:
1657 status => 'completed',
1658 reportid => { -in => [567, 2335, 2] }
1661 Which would generate:
1663 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1664 @bind = ('completed', '567', '2335', '2');
1666 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1669 Another pair of operators is C<-between> and C<-not_between>,
1670 used with an arrayref of two values:
1674 completion_date => {
1675 -not_between => ['2002-10-01', '2003-02-06']
1681 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1683 These are the two builtin "special operators"; but the
1684 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1686 =head2 Nested conditions
1688 So far, we've seen how multiple conditions are joined with a top-level
1689 C<AND>. We can change this by putting the different conditions we want in
1690 hashes and then putting those hashes in an array. For example:
1695 status => { -like => ['pending%', 'dispatched'] },
1699 status => 'unassigned',
1703 This data structure would create the following:
1705 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1706 OR ( user = ? AND status = ? ) )";
1707 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1709 This can be combined with the C<-nest> operator to properly group
1716 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1717 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1724 WHERE ( user = ? AND
1725 ( ( workhrs > ? AND geo = ? )
1726 OR ( workhrs < ? AND geo = ? ) ) )
1730 Finally, sometimes only literal SQL will do. If you want to include
1731 literal SQL verbatim, you can specify it as a scalar reference, namely:
1733 my $inn = 'is Not Null';
1735 priority => { '<', 2 },
1741 $stmt = "WHERE priority < ? AND requestor is Not Null";
1744 Note that in this example, you only get one bind parameter back, since
1745 the verbatim SQL is passed as part of the statement.
1747 Of course, just to prove a point, the above can also be accomplished
1751 priority => { '<', 2 },
1752 requestor => { '!=', undef },
1758 Conditions on boolean columns can be expressed in the
1759 same way, passing a reference to an empty string :
1762 priority => { '<', 2 },
1768 $stmt = "WHERE priority < ? AND is_ready";
1772 =head2 Literal SQL with placeholders and bind values (subqueries)
1774 If the literal SQL to be inserted has placeholders and bind values,
1775 use a reference to an arrayref (yes this is a double reference --
1776 not so common, but perfectly legal Perl). For example, to find a date
1777 in Postgres you can use something like this:
1780 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1785 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1789 Literal SQL is especially useful for nesting parenthesized clauses in the
1790 main SQL query. Here is a first example :
1792 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1796 bar => \["IN ($sub_stmt)" => @sub_bind],
1801 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1802 WHERE c2 < ? AND c3 LIKE ?))";
1803 @bind = (1234, 100, "foo%");
1805 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1806 are expressed in the same way. Of course the C<$sub_stmt> and
1807 its associated bind values can be generated through a former call
1810 my ($sub_stmt, @sub_bind)
1811 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1812 c3 => {-like => "foo%"}});
1815 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1818 In the examples above, the subquery was used as an operator on a column;
1819 but the same principle also applies for a clause within the main C<%where>
1820 hash, like an EXISTS subquery :
1822 my ($sub_stmt, @sub_bind)
1823 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1826 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1831 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1832 WHERE c1 = ? AND c2 > t0.c0))";
1836 Observe that the condition on C<c2> in the subquery refers to
1837 column C<t0.c0> of the main query : this is I<not> a bind
1838 value, so we have to express it through a scalar ref.
1839 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1840 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1841 what we wanted here.
1843 Another use of the subquery technique is when some SQL clauses need
1844 parentheses, as it often occurs with some proprietary SQL extensions
1845 like for example fulltext expressions, geospatial expressions,
1846 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1849 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1852 Finally, here is an example where a subquery is used
1853 for expressing unary negation:
1855 my ($sub_stmt, @sub_bind)
1856 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1857 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1859 lname => {like => '%son%'},
1860 -nest => \["NOT ($sub_stmt)" => @sub_bind],
1865 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1866 @bind = ('%son%', 10, 20)
1872 These pages could go on for a while, since the nesting of the data
1873 structures this module can handle are pretty much unlimited (the
1874 module implements the C<WHERE> expansion as a recursive function
1875 internally). Your best bet is to "play around" with the module a
1876 little to see how the data structures behave, and choose the best
1877 format for your data based on that.
1879 And of course, all the values above will probably be replaced with
1880 variables gotten from forms or the command line. After all, if you
1881 knew everything ahead of time, you wouldn't have to worry about
1882 dynamically-generating SQL and could just hardwire it into your
1888 =head1 ORDER BY CLAUSES
1890 Some functions take an order by clause. This can either be a scalar (just a
1891 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1892 or an array of either of the two previous forms. Examples:
1894 Given | Will Generate
1895 ----------------------------------------------------------
1896 \'colA DESC' | ORDER BY colA DESC
1897 'colA' | ORDER BY colA
1898 [qw/colA colB/] | ORDER BY colA, colB
1899 {-asc => 'colA'} | ORDER BY colA ASC
1900 {-desc => 'colB'} | ORDER BY colB DESC
1902 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
1905 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
1906 ==========================================================
1910 =head1 SPECIAL OPERATORS
1912 my $sqlmaker = SQL::Abstract->new(special_ops => [
1915 my ($self, $field, $op, $arg) = @_;
1921 A "special operator" is a SQL syntactic clause that can be
1922 applied to a field, instead of a usual binary operator.
1925 WHERE field IN (?, ?, ?)
1926 WHERE field BETWEEN ? AND ?
1927 WHERE MATCH(field) AGAINST (?, ?)
1929 Special operators IN and BETWEEN are fairly standard and therefore
1930 are builtin within C<SQL::Abstract>. For other operators,
1931 like the MATCH .. AGAINST example above which is
1932 specific to MySQL, you can write your own operator handlers :
1933 supply a C<special_ops> argument to the C<new> method.
1934 That argument takes an arrayref of operator definitions;
1935 each operator definition is a hashref with two entries
1941 the regular expression to match the operator
1945 coderef that will be called when meeting that operator
1946 in the input tree. The coderef will be called with
1947 arguments C<< ($self, $field, $op, $arg) >>, and
1948 should return a C<< ($sql, @bind) >> structure.
1952 For example, here is an implementation
1953 of the MATCH .. AGAINST syntax for MySQL
1955 my $sqlmaker = SQL::Abstract->new(special_ops => [
1957 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
1958 {regex => qr/^match$/i,
1960 my ($self, $field, $op, $arg) = @_;
1961 $arg = [$arg] if not ref $arg;
1962 my $label = $self->_quote($field);
1963 my ($placeholder) = $self->_convert('?');
1964 my $placeholders = join ", ", (($placeholder) x @$arg);
1965 my $sql = $self->_sqlcase('match') . " ($label) "
1966 . $self->_sqlcase('against') . " ($placeholders) ";
1967 my @bind = $self->_bindtype($field, @$arg);
1968 return ($sql, @bind);
1977 Thanks to some benchmarking by Mark Stosberg, it turns out that
1978 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
1979 I must admit this wasn't an intentional design issue, but it's a
1980 byproduct of the fact that you get to control your C<DBI> handles
1983 To maximize performance, use a code snippet like the following:
1985 # prepare a statement handle using the first row
1986 # and then reuse it for the rest of the rows
1988 for my $href (@array_of_hashrefs) {
1989 $stmt ||= $sql->insert('table', $href);
1990 $sth ||= $dbh->prepare($stmt);
1991 $sth->execute($sql->values($href));
1994 The reason this works is because the keys in your C<$href> are sorted
1995 internally by B<SQL::Abstract>. Thus, as long as your data retains
1996 the same structure, you only have to generate the SQL the first time
1997 around. On subsequent queries, simply use the C<values> function provided
1998 by this module to return your values in the correct order.
2003 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2004 really like this part (I do, at least). Building up a complex query
2005 can be as simple as the following:
2009 use CGI::FormBuilder;
2012 my $form = CGI::FormBuilder->new(...);
2013 my $sql = SQL::Abstract->new;
2015 if ($form->submitted) {
2016 my $field = $form->field;
2017 my $id = delete $field->{id};
2018 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2021 Of course, you would still have to connect using C<DBI> to run the
2022 query, but the point is that if you make your form look like your
2023 table, the actual query script can be extremely simplistic.
2025 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2026 a fast interface to returning and formatting data. I frequently
2027 use these three modules together to write complex database query
2028 apps in under 50 lines.
2033 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2034 Great care has been taken to preserve the I<published> behavior
2035 documented in previous versions in the 1.* family; however,
2036 some features that were previously undocumented, or behaved
2037 differently from the documentation, had to be changed in order
2038 to clarify the semantics. Hence, client code that was relying
2039 on some dark areas of C<SQL::Abstract> v1.*
2040 B<might behave differently> in v1.50.
2042 The main changes are :
2048 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2052 added -nest1, -nest2 or -nest_1, -nest_2, ...
2056 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2060 defensive programming : check arguments
2064 fixed bug with global logic, which was previously implemented
2065 through global variables yielding side-effects. Prior versons would
2066 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2067 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2068 Now this is interpreted
2069 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2073 C<-and> / C<-or> operators are no longer accepted
2074 in the middle of an arrayref : they are
2075 only admitted if in first position.
2079 changed logic for distributing an op over arrayrefs
2083 fixed semantics of _bindtype on array args
2087 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2088 we just avoid shifting arrays within that tree.
2092 dropped the C<_modlogic> function
2098 =head1 ACKNOWLEDGEMENTS
2100 There are a number of individuals that have really helped out with
2101 this module. Unfortunately, most of them submitted bugs via CPAN
2102 so I have no idea who they are! But the people I do know are:
2104 Ash Berlin (order_by hash term support)
2105 Matt Trout (DBIx::Class support)
2106 Mark Stosberg (benchmarking)
2107 Chas Owens (initial "IN" operator support)
2108 Philip Collins (per-field SQL functions)
2109 Eric Kolve (hashref "AND" support)
2110 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2111 Dan Kubb (support for "quote_char" and "name_sep")
2112 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2113 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2119 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2123 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2125 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2127 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2128 While not an official support venue, C<DBIx::Class> makes heavy use of
2129 C<SQL::Abstract>, and as such list members there are very familiar with
2130 how to create queries.
2132 This module is free software; you may copy this under the terms of
2133 the GNU General Public License, or the Artistic License, copies of
2134 which should have accompanied your Perl kit.