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/;
12 use Scalar::Util qw/blessed/;
14 #======================================================================
16 #======================================================================
18 our $VERSION = '1.49_02';
19 $VERSION = eval $VERSION; # numify for warning-free dev releases
24 # special operators (-in, -between). May be extended/overridden by user.
25 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
26 my @BUILTIN_SPECIAL_OPS = (
27 {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
28 {regex => qr/^(not )?in$/i, handler => \&_where_field_IN},
31 #======================================================================
32 # DEBUGGING AND ERROR REPORTING
33 #======================================================================
36 return unless $_[0]->{debug}; shift; # a little faster
37 my $func = (caller(1))[3];
38 warn "[$func] ", @_, "\n";
42 my($func) = (caller(1))[3];
43 carp "[$func] Warning: ", @_;
47 my($func) = (caller(1))[3];
48 croak "[$func] Fatal: ", @_;
52 #======================================================================
54 #======================================================================
58 my $class = ref($self) || $self;
59 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
61 # choose our case by keeping an option around
62 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
64 # default logic for interpreting arrayrefs
65 $opt{logic} = uc $opt{logic} || 'OR';
67 # how to return bind vars
68 # LDNOTE: changed nwiger code : why this 'delete' ??
69 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
70 $opt{bindtype} ||= 'normal';
72 # default comparison is "=", but can be overridden
75 # try to recognize which are the 'equality' and 'unequality' ops
76 # (temporary quickfix, should go through a more seasoned API)
77 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
78 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
81 $opt{sqltrue} ||= '1=1';
82 $opt{sqlfalse} ||= '0=1';
85 $opt{special_ops} ||= [];
86 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
88 return bless \%opt, $class;
93 #======================================================================
95 #======================================================================
99 my $table = $self->_table(shift);
100 my $data = shift || return;
102 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
103 my ($sql, @bind) = $self->$method($data);
104 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
105 return wantarray ? ($sql, @bind) : $sql;
108 sub _insert_HASHREF { # explicit list of fields and then values
109 my ($self, $data) = @_;
111 my @fields = sort keys %$data;
113 my ($sql, @bind) = $self->_insert_values($data);
116 $_ = $self->_quote($_) foreach @fields;
117 $sql = "( ".join(", ", @fields).") ".$sql;
119 return ($sql, @bind);
122 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
123 my ($self, $data) = @_;
125 # no names (arrayref) so can't generate bindtype
126 $self->{bindtype} ne 'columns'
127 or belch "can't do 'columns' bindtype when called with arrayref";
129 # fold the list of values into a hash of column name - value pairs
130 # (where the column names are artificially generated, and their
131 # lexicographical ordering keep the ordering of the original list)
132 my $i = "a"; # incremented values will be in lexicographical order
133 my $data_in_hash = { map { ($i++ => $_) } @$data };
135 return $self->_insert_values($data_in_hash);
138 sub _insert_ARRAYREFREF { # literal SQL with bind
139 my ($self, $data) = @_;
141 my ($sql, @bind) = @${$data};
142 $self->_assert_bindval_matches_bindtype(@bind);
144 return ($sql, @bind);
148 sub _insert_SCALARREF { # literal SQL without bind
149 my ($self, $data) = @_;
155 my ($self, $data) = @_;
157 my (@values, @all_bind);
158 foreach my $column (sort keys %$data) {
159 my $v = $data->{$column};
161 $self->_SWITCH_refkind($v, {
164 if ($self->{array_datatypes}) { # if array datatype are activated
166 push @all_bind, $self->_bindtype($column, $v);
168 else { # else literal SQL with bind
169 my ($sql, @bind) = @$v;
170 $self->_assert_bindval_matches_bindtype(@bind);
172 push @all_bind, @bind;
176 ARRAYREFREF => sub { # literal SQL with bind
177 my ($sql, @bind) = @${$v};
178 $self->_assert_bindval_matches_bindtype(@bind);
180 push @all_bind, @bind;
183 # THINK : anything useful to do with a HASHREF ?
184 HASHREF => sub { # (nothing, but old SQLA passed it through)
185 #TODO in SQLA >= 2.0 it will die instead
186 belch "HASH ref as bind value in insert is not supported";
188 push @all_bind, $self->_bindtype($column, $v);
191 SCALARREF => sub { # literal SQL without bind
195 SCALAR_or_UNDEF => sub {
197 push @all_bind, $self->_bindtype($column, $v);
204 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
205 return ($sql, @all_bind);
210 #======================================================================
212 #======================================================================
217 my $table = $self->_table(shift);
218 my $data = shift || return;
221 # first build the 'SET' part of the sql statement
222 my (@set, @all_bind);
223 puke "Unsupported data type specified to \$sql->update"
224 unless ref $data eq 'HASH';
226 for my $k (sort keys %$data) {
229 my $label = $self->_quote($k);
231 $self->_SWITCH_refkind($v, {
233 if ($self->{array_datatypes}) { # array datatype
234 push @set, "$label = ?";
235 push @all_bind, $self->_bindtype($k, $v);
237 else { # literal SQL with bind
238 my ($sql, @bind) = @$v;
239 $self->_assert_bindval_matches_bindtype(@bind);
240 push @set, "$label = $sql";
241 push @all_bind, @bind;
244 ARRAYREFREF => sub { # literal SQL with bind
245 my ($sql, @bind) = @${$v};
246 $self->_assert_bindval_matches_bindtype(@bind);
247 push @set, "$label = $sql";
248 push @all_bind, @bind;
250 SCALARREF => sub { # literal SQL without bind
251 push @set, "$label = $$v";
253 SCALAR_or_UNDEF => sub {
254 push @set, "$label = ?";
255 push @all_bind, $self->_bindtype($k, $v);
261 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
265 my($where_sql, @where_bind) = $self->where($where);
267 push @all_bind, @where_bind;
270 return wantarray ? ($sql, @all_bind) : $sql;
276 #======================================================================
278 #======================================================================
283 my $table = $self->_table(shift);
284 my $fields = shift || '*';
288 my($where_sql, @bind) = $self->where($where, $order);
290 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
292 my $sql = join(' ', $self->_sqlcase('select'), $f,
293 $self->_sqlcase('from'), $table)
296 return wantarray ? ($sql, @bind) : $sql;
299 #======================================================================
301 #======================================================================
306 my $table = $self->_table(shift);
310 my($where_sql, @bind) = $self->where($where);
311 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
313 return wantarray ? ($sql, @bind) : $sql;
317 #======================================================================
319 #======================================================================
323 # Finally, a separate routine just to handle WHERE clauses
325 my ($self, $where, $order) = @_;
328 my ($sql, @bind) = $self->_recurse_where($where);
329 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
333 $sql .= $self->_order_by($order);
336 return wantarray ? ($sql, @bind) : $sql;
341 my ($self, $where, $logic) = @_;
343 # dispatch on appropriate method according to refkind of $where
344 my $method = $self->_METHOD_FOR_refkind("_where", $where);
347 my ($sql, @bind) = $self->$method($where, $logic);
349 # DBIx::Class directly calls _recurse_where in scalar context, so
350 # we must implement it, even if not in the official API
351 return wantarray ? ($sql, @bind) : $sql;
356 #======================================================================
357 # WHERE: top-level ARRAYREF
358 #======================================================================
361 sub _where_ARRAYREF {
362 my ($self, $where, $logic) = @_;
364 $logic = uc($logic || $self->{logic});
365 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
367 my @clauses = @$where;
369 # if the array starts with [-and|or => ...], recurse with that logic
370 my $first = $clauses[0] || '';
371 if ($first =~ /^-(and|or)/i) {
374 return $self->_where_ARRAYREF(\@clauses, $logic);
378 my (@sql_clauses, @all_bind);
380 # need to use while() so can shift() for pairs
381 while (my $el = shift @clauses) {
383 # switch according to kind of $el and get corresponding ($sql, @bind)
384 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
386 # skip empty elements, otherwise get invalid trailing AND stuff
387 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
389 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
390 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
391 # side-effect: the first hashref within an array would change
392 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
393 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
394 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
396 SCALARREF => sub { ($$el); },
398 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
399 $self->_recurse_where({$el => shift(@clauses)})},
401 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
405 push @sql_clauses, $sql;
406 push @all_bind, @bind;
410 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
415 #======================================================================
416 # WHERE: top-level HASHREF
417 #======================================================================
420 my ($self, $where) = @_;
421 my (@sql_clauses, @all_bind);
423 # LDNOTE : don't really know why we need to sort keys
424 for my $k (sort keys %$where) {
425 my $v = $where->{$k};
427 # ($k => $v) is either a special op or a regular hashpair
428 my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
430 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
431 $self->$method($k, $v);
434 push @sql_clauses, $sql;
435 push @all_bind, @bind;
438 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
442 sub _where_op_in_hash {
443 my ($self, $op, $v) = @_;
445 $op =~ /^(AND|OR|NEST)[_\d]*/i
446 or puke "unknown operator: -$op";
447 $op = uc($1); # uppercase, remove trailing digits
448 $self->_debug("OP(-$op) within hashref, recursing...");
450 $self->_SWITCH_refkind($v, {
453 # LDNOTE : should deprecate {-or => [...]} and {-and => [...]}
454 # because they are misleading; the only proper way would be
455 # -nest => [-or => ...], -nest => [-and ...]
456 return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
461 belch "-or => {...} should be -nest => [...]";
462 return $self->_where_ARRAYREF([%$v], 'OR');
465 return $self->_where_HASHREF($v);
469 SCALARREF => sub { # literal SQL
471 or puke "-$op => \\\$scalar not supported, use -nest => ...";
475 ARRAYREFREF => sub { # literal SQL
477 or puke "-$op => \\[..] not supported, use -nest => ...";
481 SCALAR => sub { # permissively interpreted as SQL
483 or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
484 belch "literal SQL should be -nest => \\'scalar' "
485 . "instead of -nest => 'scalar' ";
490 puke "-$op => undef not supported";
496 sub _where_hashpair_ARRAYREF {
497 my ($self, $k, $v) = @_;
500 my @v = @$v; # need copy because of shift below
501 $self->_debug("ARRAY($k) means distribute over elements");
503 # put apart first element if it is an operator (-and, -or)
504 my $op = $v[0] =~ /^-/ ? shift @v : undef;
505 $self->_debug("OP($op) reinjected into the distributed array") if $op;
507 my @distributed = map { {$k => $_} } @v;
508 unshift @distributed, $op if $op;
510 return $self->_recurse_where(\@distributed);
513 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
514 $self->_debug("empty ARRAY($k) means 0=1");
515 return ($self->{sqlfalse});
519 sub _where_hashpair_HASHREF {
520 my ($self, $k, $v) = @_;
522 my (@all_sql, @all_bind);
524 for my $op (sort keys %$v) {
527 # put the operator in canonical form
528 $op =~ s/^-//; # remove initial dash
529 $op =~ tr/_/ /; # underscores become spaces
530 $op =~ s/^\s+//; # no initial space
531 $op =~ s/\s+$//; # no final space
532 $op =~ s/\s+/ /; # multiple spaces become one
536 # CASE: special operators like -in or -between
537 my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
539 ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
542 $self->_SWITCH_refkind($val, {
544 ARRAYREF => sub { # CASE: col => {op => \@vals}
545 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
548 SCALARREF => sub { # CASE: col => {op => \$scalar} (literal SQL without bind)
549 $sql = join ' ', $self->_convert($self->_quote($k)),
550 $self->_sqlcase($op),
554 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
555 my ($sub_sql, @sub_bind) = @$$val;
556 $self->_assert_bindval_matches_bindtype(@sub_bind);
557 $sql = join ' ', $self->_convert($self->_quote($k)),
558 $self->_sqlcase($op),
563 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
564 my $is = ($op =~ $self->{equality_op}) ? 'is' :
565 ($op =~ $self->{inequality_op}) ? 'is not' :
566 puke "unexpected operator '$op' with undef operand";
567 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
570 FALLBACK => sub { # CASE: col => {op => $scalar}
571 $sql = join ' ', $self->_convert($self->_quote($k)),
572 $self->_sqlcase($op),
573 $self->_convert('?');
574 @bind = $self->_bindtype($k, $val);
580 push @all_bind, @bind;
583 return $self->_join_sql_clauses('and', \@all_sql, \@all_bind);
588 sub _where_field_op_ARRAYREF {
589 my ($self, $k, $op, $vals) = @_;
592 $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
596 # LDNOTE : change the distribution logic when
597 # $op =~ $self->{inequality_op}, because of Morgan laws :
598 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
599 # WHERE field != 22 OR field != 33 : the user probably means
600 # WHERE field != 22 AND field != 33.
601 my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
603 # distribute $op over each member of @$vals
604 return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
608 # try to DWIM on equality operators
609 # LDNOTE : not 100% sure this is the correct thing to do ...
610 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
611 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
614 puke "operator '$op' applied on an empty array (field '$k')";
619 sub _where_hashpair_SCALARREF {
620 my ($self, $k, $v) = @_;
621 $self->_debug("SCALAR($k) means literal SQL: $$v");
622 my $sql = $self->_quote($k) . " " . $$v;
626 # literal SQL with bind
627 sub _where_hashpair_ARRAYREFREF {
628 my ($self, $k, $v) = @_;
629 $self->_debug("REF($k) means literal SQL: @${$v}");
630 my ($sql, @bind) = @${$v};
631 $self->_assert_bindval_matches_bindtype(@bind);
632 $sql = $self->_quote($k) . " " . $sql;
633 return ($sql, @bind );
636 # literal SQL without bind
637 sub _where_hashpair_SCALAR {
638 my ($self, $k, $v) = @_;
639 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
640 my $sql = join ' ', $self->_convert($self->_quote($k)),
641 $self->_sqlcase($self->{cmp}),
642 $self->_convert('?');
643 my @bind = $self->_bindtype($k, $v);
644 return ( $sql, @bind);
648 sub _where_hashpair_UNDEF {
649 my ($self, $k, $v) = @_;
650 $self->_debug("UNDEF($k) means IS NULL");
651 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
655 #======================================================================
656 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
657 #======================================================================
660 sub _where_SCALARREF {
661 my ($self, $where) = @_;
664 $self->_debug("SCALAR(*top) means literal SQL: $$where");
670 my ($self, $where) = @_;
673 $self->_debug("NOREF(*top) means literal SQL: $where");
684 #======================================================================
685 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
686 #======================================================================
689 sub _where_field_BETWEEN {
690 my ($self, $k, $op, $vals) = @_;
692 ref $vals eq 'ARRAY' && @$vals == 2
693 or puke "special op 'between' requires an arrayref of two values";
695 my ($label) = $self->_convert($self->_quote($k));
696 my ($placeholder) = $self->_convert('?');
697 my $and = $self->_sqlcase('and');
698 $op = $self->_sqlcase($op);
700 my $sql = "( $label $op $placeholder $and $placeholder )";
701 my @bind = $self->_bindtype($k, @$vals);
706 sub _where_field_IN {
707 my ($self, $k, $op, $vals) = @_;
709 # backwards compatibility : if scalar, force into an arrayref
710 $vals = [$vals] if defined $vals && ! ref $vals;
712 my ($label) = $self->_convert($self->_quote($k));
713 my ($placeholder) = $self->_convert('?');
714 $op = $self->_sqlcase($op);
716 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
717 ARRAYREF => sub { # list of choices
718 if (@$vals) { # nonempty list
719 my $placeholders = join ", ", (($placeholder) x @$vals);
720 my $sql = "$label $op ( $placeholders )";
721 my @bind = $self->_bindtype($k, @$vals);
723 return ($sql, @bind);
725 else { # empty list : some databases won't understand "IN ()", so DWIM
726 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
731 ARRAYREFREF => sub { # literal SQL with bind
732 my ($sql, @bind) = @$$vals;
733 $self->_assert_bindval_matches_bindtype(@bind);
734 return ("$label $op ( $sql )", @bind);
738 puke "special op 'in' requires an arrayref (or arrayref-ref)";
742 return ($sql, @bind);
750 #======================================================================
752 #======================================================================
755 my ($self, $arg) = @_;
757 # construct list of ordering instructions
758 my @order = $self->_SWITCH_refkind($arg, {
761 map {$self->_SWITCH_refkind($_, {
762 SCALAR => sub {$self->_quote($_)},
764 SCALARREF => sub {$$_}, # literal SQL, no quoting
765 HASHREF => sub {$self->_order_by_hash($_)}
769 SCALAR => sub {$self->_quote($arg)},
771 SCALARREF => sub {$$arg}, # literal SQL, no quoting
772 HASHREF => sub {$self->_order_by_hash($arg)},
777 my $order = join ', ', @order;
778 return $order ? $self->_sqlcase(' order by')." $order" : '';
783 my ($self, $hash) = @_;
785 # get first pair in hash
786 my ($key, $val) = each %$hash;
788 # check if one pair was found and no other pair in hash
789 $key && !(each %$hash)
790 or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
792 my ($order) = ($key =~ /^-(desc|asc)/i)
793 or puke "invalid key in _order_by hash : $key";
795 return $self->_quote($val) ." ". $self->_sqlcase($order);
800 #======================================================================
801 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
802 #======================================================================
807 $self->_SWITCH_refkind($from, {
808 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
809 SCALAR => sub {$self->_quote($from)},
810 SCALARREF => sub {$$from},
811 ARRAYREFREF => sub {join ', ', @$from;},
816 #======================================================================
818 #======================================================================
824 $label or puke "can't quote an empty label";
826 # left and right quote characters
827 my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
828 SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
829 ARRAYREF => sub {@{$self->{quote_char}}},
833 or puke "quote_char must be an arrayref of 2 values";
835 # no quoting if no quoting chars
836 $ql or return $label;
838 # no quoting for literal SQL
839 return $$label if ref($label) eq 'SCALAR';
841 # separate table / column (if applicable)
842 my $sep = $self->{name_sep} || '';
843 my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
845 # do the quoting, except for "*" or for `table`.*
846 my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
848 # reassemble and return.
849 return join $sep, @quoted;
853 # Conversion, if applicable
855 my ($self, $arg) = @_;
857 # LDNOTE : modified the previous implementation below because
858 # it was not consistent : the first "return" is always an array,
859 # the second "return" is context-dependent. Anyway, _convert
860 # seems always used with just a single argument, so make it a
862 # return @_ unless $self->{convert};
863 # my $conv = $self->_sqlcase($self->{convert});
864 # my @ret = map { $conv.'('.$_.')' } @_;
865 # return wantarray ? @ret : $ret[0];
866 if ($self->{convert}) {
867 my $conv = $self->_sqlcase($self->{convert});
868 $arg = $conv.'('.$arg.')';
876 my($col, @vals) = @_;
878 #LDNOTE : changed original implementation below because it did not make
879 # sense when bindtype eq 'columns' and @vals > 1.
880 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
882 return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
885 # Dies if any element of @bind is not in [colname => value] format
886 # if bindtype is 'columns'.
887 sub _assert_bindval_matches_bindtype {
888 my ($self, @bind) = @_;
890 if ($self->{bindtype} eq 'columns') {
891 foreach my $val (@bind) {
892 if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
893 die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
899 sub _join_sql_clauses {
900 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
902 if (@$clauses_aref > 1) {
903 my $join = " " . $self->_sqlcase($logic) . " ";
904 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
905 return ($sql, @$bind_aref);
907 elsif (@$clauses_aref) {
908 return ($clauses_aref->[0], @$bind_aref); # no parentheses
911 return (); # if no SQL, ignore @$bind_aref
916 # Fix SQL case, if so requested
920 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
921 # don't touch the argument ... crooked logic, but let's not change it!
922 return $self->{case} ? $_[0] : uc($_[0]);
926 #======================================================================
927 # DISPATCHING FROM REFKIND
928 #======================================================================
931 my ($self, $data) = @_;
937 # blessed objects are treated like scalars
938 $ref = (blessed $data) ? '' : ref $data;
939 $n_steps += 1 if $ref;
940 last if $ref ne 'REF';
944 my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
946 return $base . ('REF' x $n_steps);
952 my ($self, $data) = @_;
953 my @try = ($self->_refkind($data));
954 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
955 push @try, 'FALLBACK';
959 sub _METHOD_FOR_refkind {
960 my ($self, $meth_prefix, $data) = @_;
961 my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
962 $self->_try_refkind($data)
963 or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
968 sub _SWITCH_refkind {
969 my ($self, $data, $dispatch_table) = @_;
971 my $coderef = first {$_} map {$dispatch_table->{$_}}
972 $self->_try_refkind($data)
973 or puke "no dispatch entry for ".$self->_refkind($data);
980 #======================================================================
981 # VALUES, GENERATE, AUTOLOAD
982 #======================================================================
984 # LDNOTE: original code from nwiger, didn't touch code in that section
985 # I feel the AUTOLOAD stuff should not be the default, it should
986 # only be activated on explicit demand by user.
990 my $data = shift || return;
991 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
992 unless ref $data eq 'HASH';
993 return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
999 my(@sql, @sqlq, @sqlv);
1003 if ($ref eq 'HASH') {
1004 for my $k (sort keys %$_) {
1007 my $label = $self->_quote($k);
1008 if ($r eq 'ARRAY') {
1009 # literal SQL with bind
1010 my ($sql, @bind) = @$v;
1011 $self->_assert_bindval_matches_bindtype(@bind);
1012 push @sqlq, "$label = $sql";
1014 } elsif ($r eq 'SCALAR') {
1015 # literal SQL without bind
1016 push @sqlq, "$label = $$v";
1018 push @sqlq, "$label = ?";
1019 push @sqlv, $self->_bindtype($k, $v);
1022 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1023 } elsif ($ref eq 'ARRAY') {
1024 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1027 if ($r eq 'ARRAY') { # literal SQL with bind
1028 my ($sql, @bind) = @$v;
1029 $self->_assert_bindval_matches_bindtype(@bind);
1032 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1033 # embedded literal SQL
1040 push @sql, '(' . join(', ', @sqlq) . ')';
1041 } elsif ($ref eq 'SCALAR') {
1045 # strings get case twiddled
1046 push @sql, $self->_sqlcase($_);
1050 my $sql = join ' ', @sql;
1052 # this is pretty tricky
1053 # if ask for an array, return ($stmt, @bind)
1054 # otherwise, s/?/shift @sqlv/ to put it inline
1056 return ($sql, @sqlv);
1058 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1059 ref $d ? $d->[1] : $d/e;
1068 # This allows us to check for a local, then _form, attr
1070 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1071 return $self->generate($name, @_);
1082 SQL::Abstract - Generate SQL from Perl data structures
1088 my $sql = SQL::Abstract->new;
1090 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1092 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1094 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1096 my($stmt, @bind) = $sql->delete($table, \%where);
1098 # Then, use these in your DBI statements
1099 my $sth = $dbh->prepare($stmt);
1100 $sth->execute(@bind);
1102 # Just generate the WHERE clause
1103 my($stmt, @bind) = $sql->where(\%where, \@order);
1105 # Return values in the same order, for hashed queries
1106 # See PERFORMANCE section for more details
1107 my @bind = $sql->values(\%fieldvals);
1111 This module was inspired by the excellent L<DBIx::Abstract>.
1112 However, in using that module I found that what I really wanted
1113 to do was generate SQL, but still retain complete control over my
1114 statement handles and use the DBI interface. So, I set out to
1115 create an abstract SQL generation module.
1117 While based on the concepts used by L<DBIx::Abstract>, there are
1118 several important differences, especially when it comes to WHERE
1119 clauses. I have modified the concepts used to make the SQL easier
1120 to generate from Perl data structures and, IMO, more intuitive.
1121 The underlying idea is for this module to do what you mean, based
1122 on the data structures you provide it. The big advantage is that
1123 you don't have to modify your code every time your data changes,
1124 as this module figures it out.
1126 To begin with, an SQL INSERT is as easy as just specifying a hash
1127 of C<key=value> pairs:
1130 name => 'Jimbo Bobson',
1131 phone => '123-456-7890',
1132 address => '42 Sister Lane',
1133 city => 'St. Louis',
1134 state => 'Louisiana',
1137 The SQL can then be generated with this:
1139 my($stmt, @bind) = $sql->insert('people', \%data);
1141 Which would give you something like this:
1143 $stmt = "INSERT INTO people
1144 (address, city, name, phone, state)
1145 VALUES (?, ?, ?, ?, ?)";
1146 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1147 '123-456-7890', 'Louisiana');
1149 These are then used directly in your DBI code:
1151 my $sth = $dbh->prepare($stmt);
1152 $sth->execute(@bind);
1154 =head2 Inserting and Updating Arrays
1156 If your database has array types (like for example Postgres),
1157 activate the special option C<< array_datatypes => 1 >>
1158 when creating the C<SQL::Abstract> object.
1159 Then you may use an arrayref to insert and update database array types:
1161 my $sql = SQL::Abstract->new(array_datatypes => 1);
1163 planets => [qw/Mercury Venus Earth Mars/]
1166 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1170 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1172 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1175 =head2 Inserting and Updating SQL
1177 In order to apply SQL functions to elements of your C<%data> you may
1178 specify a reference to an arrayref for the given hash value. For example,
1179 if you need to execute the Oracle C<to_date> function on a value, you can
1180 say something like this:
1184 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1187 The first value in the array is the actual SQL. Any other values are
1188 optional and would be included in the bind values array. This gives
1191 my($stmt, @bind) = $sql->insert('people', \%data);
1193 $stmt = "INSERT INTO people (name, date_entered)
1194 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1195 @bind = ('Bill', '03/02/2003');
1197 An UPDATE is just as easy, all you change is the name of the function:
1199 my($stmt, @bind) = $sql->update('people', \%data);
1201 Notice that your C<%data> isn't touched; the module will generate
1202 the appropriately quirky SQL for you automatically. Usually you'll
1203 want to specify a WHERE clause for your UPDATE, though, which is
1204 where handling C<%where> hashes comes in handy...
1206 =head2 Complex where statements
1208 This module can generate pretty complicated WHERE statements
1209 easily. For example, simple C<key=value> pairs are taken to mean
1210 equality, and if you want to see if a field is within a set
1211 of values, you can use an arrayref. Let's say we wanted to
1212 SELECT some data based on this criteria:
1215 requestor => 'inna',
1216 worker => ['nwiger', 'rcwe', 'sfz'],
1217 status => { '!=', 'completed' }
1220 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1222 The above would give you something like this:
1224 $stmt = "SELECT * FROM tickets WHERE
1225 ( requestor = ? ) AND ( status != ? )
1226 AND ( worker = ? OR worker = ? OR worker = ? )";
1227 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1229 Which you could then use in DBI code like so:
1231 my $sth = $dbh->prepare($stmt);
1232 $sth->execute(@bind);
1238 The functions are simple. There's one for each major SQL operation,
1239 and a constructor you use first. The arguments are specified in a
1240 similar order to each function (table, then fields, then a where
1241 clause) to try and simplify things.
1246 =head2 new(option => 'value')
1248 The C<new()> function takes a list of options and values, and returns
1249 a new B<SQL::Abstract> object which can then be used to generate SQL
1250 through the methods below. The options accepted are:
1256 If set to 'lower', then SQL will be generated in all lowercase. By
1257 default SQL is generated in "textbook" case meaning something like:
1259 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1261 Any setting other than 'lower' is ignored.
1265 This determines what the default comparison operator is. By default
1266 it is C<=>, meaning that a hash like this:
1268 %where = (name => 'nwiger', email => 'nate@wiger.org');
1270 Will generate SQL like this:
1272 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1274 However, you may want loose comparisons by default, so if you set
1275 C<cmp> to C<like> you would get SQL such as:
1277 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1279 You can also override the comparsion on an individual basis - see
1280 the huge section on L</"WHERE CLAUSES"> at the bottom.
1282 =item sqltrue, sqlfalse
1284 Expressions for inserting boolean values within SQL statements.
1285 By default these are C<1=1> and C<1=0>.
1289 This determines the default logical operator for multiple WHERE
1290 statements in arrays. By default it is "or", meaning that a WHERE
1294 event_date => {'>=', '2/13/99'},
1295 event_date => {'<=', '4/24/03'},
1298 Will generate SQL like this:
1300 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1302 This is probably not what you want given this query, though (look
1303 at the dates). To change the "OR" to an "AND", simply specify:
1305 my $sql = SQL::Abstract->new(logic => 'and');
1307 Which will change the above C<WHERE> to:
1309 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1311 The logic can also be changed locally by inserting
1312 an extra first element in the array :
1314 @where = (-and => event_date => {'>=', '2/13/99'},
1315 event_date => {'<=', '4/24/03'} );
1317 See the L</"WHERE CLAUSES"> section for explanations.
1321 This will automatically convert comparisons using the specified SQL
1322 function for both column and value. This is mostly used with an argument
1323 of C<upper> or C<lower>, so that the SQL will have the effect of
1324 case-insensitive "searches". For example, this:
1326 $sql = SQL::Abstract->new(convert => 'upper');
1327 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1329 Will turn out the following SQL:
1331 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1333 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1334 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1335 not validate this option; it will just pass through what you specify verbatim).
1339 This is a kludge because many databases suck. For example, you can't
1340 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1341 Instead, you have to use C<bind_param()>:
1343 $sth->bind_param(1, 'reg data');
1344 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1346 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1347 which loses track of which field each slot refers to. Fear not.
1349 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1350 Currently, you can specify either C<normal> (default) or C<columns>. If you
1351 specify C<columns>, you will get an array that looks like this:
1353 my $sql = SQL::Abstract->new(bindtype => 'columns');
1354 my($stmt, @bind) = $sql->insert(...);
1357 [ 'column1', 'value1' ],
1358 [ 'column2', 'value2' ],
1359 [ 'column3', 'value3' ],
1362 You can then iterate through this manually, using DBI's C<bind_param()>.
1364 $sth->prepare($stmt);
1367 my($col, $data) = @$_;
1368 if ($col eq 'details' || $col eq 'comments') {
1369 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1370 } elsif ($col eq 'image') {
1371 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1373 $sth->bind_param($i, $data);
1377 $sth->execute; # execute without @bind now
1379 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1380 Basically, the advantage is still that you don't have to care which fields
1381 are or are not included. You could wrap that above C<for> loop in a simple
1382 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1383 get a layer of abstraction over manual SQL specification.
1387 This is the character that a table or column name will be quoted
1388 with. By default this is an empty string, but you could set it to
1389 the character C<`>, to generate SQL like this:
1391 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1393 Alternatively, you can supply an array ref of two items, the first being the left
1394 hand quote character, and the second the right hand quote character. For
1395 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1396 that generates SQL like this:
1398 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1400 Quoting is useful if you have tables or columns names that are reserved
1401 words in your database's SQL dialect.
1405 This is the character that separates a table and column name. It is
1406 necessary to specify this when the C<quote_char> option is selected,
1407 so that tables and column names can be individually quoted like this:
1409 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1411 =item array_datatypes
1413 When this option is true, arrayrefs in INSERT or UPDATE are
1414 interpreted as array datatypes and are passed directly
1416 When this option is false, arrayrefs are interpreted
1417 as literal SQL, just like refs to arrayrefs
1418 (but this behavior is for backwards compatibility; when writing
1419 new queries, use the "reference to arrayref" syntax
1425 Takes a reference to a list of "special operators"
1426 to extend the syntax understood by L<SQL::Abstract>.
1427 See section L</"SPECIAL OPERATORS"> for details.
1433 =head2 insert($table, \@values || \%fieldvals)
1435 This is the simplest function. You simply give it a table name
1436 and either an arrayref of values or hashref of field/value pairs.
1437 It returns an SQL INSERT statement and a list of bind values.
1438 See the sections on L</"Inserting and Updating Arrays"> and
1439 L</"Inserting and Updating SQL"> for information on how to insert
1440 with those data types.
1442 =head2 update($table, \%fieldvals, \%where)
1444 This takes a table, hashref of field/value pairs, and an optional
1445 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1447 See the sections on L</"Inserting and Updating Arrays"> and
1448 L</"Inserting and Updating SQL"> for information on how to insert
1449 with those data types.
1451 =head2 select($source, $fields, $where, $order)
1453 This returns a SQL SELECT statement and associated list of bind values, as
1454 specified by the arguments :
1460 Specification of the 'FROM' part of the statement.
1461 The argument can be either a plain scalar (interpreted as a table
1462 name, will be quoted), or an arrayref (interpreted as a list
1463 of table names, joined by commas, quoted), or a scalarref
1464 (literal table name, not quoted), or a ref to an arrayref
1465 (list of literal table names, joined by commas, not quoted).
1469 Specification of the list of fields to retrieve from
1471 The argument can be either an arrayref (interpreted as a list
1472 of field names, will be joined by commas and quoted), or a
1473 plain scalar (literal SQL, not quoted).
1474 Please observe that this API is not as flexible as for
1475 the first argument C<$table>, for backwards compatibility reasons.
1479 Optional argument to specify the WHERE part of the query.
1480 The argument is most often a hashref, but can also be
1481 an arrayref or plain scalar --
1482 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1486 Optional argument to specify the ORDER BY part of the query.
1487 The argument can be a scalar, a hashref or an arrayref
1488 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1494 =head2 delete($table, \%where)
1496 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1497 It returns an SQL DELETE statement and list of bind values.
1499 =head2 where(\%where, \@order)
1501 This is used to generate just the WHERE clause. For example,
1502 if you have an arbitrary data structure and know what the
1503 rest of your SQL is going to look like, but want an easy way
1504 to produce a WHERE clause, use this. It returns an SQL WHERE
1505 clause and list of bind values.
1508 =head2 values(\%data)
1510 This just returns the values from the hash C<%data>, in the same
1511 order that would be returned from any of the other above queries.
1512 Using this allows you to markedly speed up your queries if you
1513 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1515 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1517 Warning: This is an experimental method and subject to change.
1519 This returns arbitrarily generated SQL. It's a really basic shortcut.
1520 It will return two different things, depending on return context:
1522 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1523 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1525 These would return the following:
1527 # First calling form
1528 $stmt = "CREATE TABLE test (?, ?)";
1529 @bind = (field1, field2);
1531 # Second calling form
1532 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1534 Depending on what you're trying to do, it's up to you to choose the correct
1535 format. In this example, the second form is what you would want.
1539 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1543 ALTER SESSION SET nls_date_format = 'MM/YY'
1545 You get the idea. Strings get their case twiddled, but everything
1546 else remains verbatim.
1551 =head1 WHERE CLAUSES
1555 This module uses a variation on the idea from L<DBIx::Abstract>. It
1556 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1557 module is that things in arrays are OR'ed, and things in hashes
1560 The easiest way to explain is to show lots of examples. After
1561 each C<%where> hash shown, it is assumed you used:
1563 my($stmt, @bind) = $sql->where(\%where);
1565 However, note that the C<%where> hash can be used directly in any
1566 of the other functions as well, as described above.
1568 =head2 Key-value pairs
1570 So, let's get started. To begin, a simple hash:
1574 status => 'completed'
1577 Is converted to SQL C<key = val> statements:
1579 $stmt = "WHERE user = ? AND status = ?";
1580 @bind = ('nwiger', 'completed');
1582 One common thing I end up doing is having a list of values that
1583 a field can be in. To do this, simply specify a list inside of
1588 status => ['assigned', 'in-progress', 'pending'];
1591 This simple code will create the following:
1593 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1594 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1596 An empty arrayref will be considered a logical false and
1599 =head2 Key-value pairs
1601 If you want to specify a different type of operator for your comparison,
1602 you can use a hashref for a given column:
1606 status => { '!=', 'completed' }
1609 Which would generate:
1611 $stmt = "WHERE user = ? AND status != ?";
1612 @bind = ('nwiger', 'completed');
1614 To test against multiple values, just enclose the values in an arrayref:
1616 status => { '!=', ['assigned', 'in-progress', 'pending'] };
1618 Which would give you:
1620 "WHERE status != ? AND status != ? AND status != ?"
1622 Notice that since the operator was recognized as being a 'negative'
1623 operator, the arrayref was interpreted with 'AND' logic (because
1624 of Morgan's laws). By contrast, the reverse
1626 status => { '=', ['assigned', 'in-progress', 'pending'] };
1630 "WHERE status = ? OR status = ? OR status = ?"
1633 The hashref can also contain multiple pairs, in which case it is expanded
1634 into an C<AND> of its elements:
1638 status => { '!=', 'completed', -not_like => 'pending%' }
1641 # Or more dynamically, like from a form
1642 $where{user} = 'nwiger';
1643 $where{status}{'!='} = 'completed';
1644 $where{status}{'-not_like'} = 'pending%';
1646 # Both generate this
1647 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1648 @bind = ('nwiger', 'completed', 'pending%');
1651 To get an OR instead, you can combine it with the arrayref idea:
1655 priority => [ {'=', 2}, {'!=', 1} ]
1658 Which would generate:
1660 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1661 @bind = ('nwiger', '2', '1');
1663 If you want to include literal SQL (with or without bind values), just use a
1664 scalar reference or array reference as the value:
1667 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1668 date_expires => { '<' => \"now()" }
1671 Which would generate:
1673 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1674 @bind = ('11/26/2008');
1677 =head2 Logic and nesting operators
1679 In the example above,
1680 there is a subtle trap if you want to say something like
1681 this (notice the C<AND>):
1683 WHERE priority != ? AND priority != ?
1685 Because, in Perl you I<can't> do this:
1687 priority => { '!=', 2, '!=', 1 }
1689 As the second C<!=> key will obliterate the first. The solution
1690 is to use the special C<-modifier> form inside an arrayref:
1692 priority => [ -and => {'!=', 2},
1696 Normally, these would be joined by C<OR>, but the modifier tells it
1697 to use C<AND> instead. (Hint: You can use this in conjunction with the
1698 C<logic> option to C<new()> in order to change the way your queries
1699 work by default.) B<Important:> Note that the C<-modifier> goes
1700 B<INSIDE> the arrayref, as an extra first element. This will
1701 B<NOT> do what you think it might:
1703 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1705 Here is a quick list of equivalencies, since there is some overlap:
1708 status => {'!=', 'completed', 'not like', 'pending%' }
1709 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1712 status => {'=', ['assigned', 'in-progress']}
1713 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1714 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1716 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1717 operator which adds an additional set of parens, to create a subquery.
1718 For example, to get something like this:
1720 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1721 @bind = ('nwiger', '20', 'ASIA');
1727 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1730 If you need several nested subexpressions, you can number
1731 the C<-nest> branches :
1741 =head2 Special operators : IN, BETWEEN, etc.
1743 You can also use the hashref format to compare a list of fields using the
1744 C<IN> comparison operator, by specifying the list as an arrayref:
1747 status => 'completed',
1748 reportid => { -in => [567, 2335, 2] }
1751 Which would generate:
1753 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1754 @bind = ('completed', '567', '2335', '2');
1756 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1759 Another pair of operators is C<-between> and C<-not_between>,
1760 used with an arrayref of two values:
1764 completion_date => {
1765 -not_between => ['2002-10-01', '2003-02-06']
1771 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1773 These are the two builtin "special operators"; but the
1774 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1776 =head2 Nested conditions
1778 So far, we've seen how multiple conditions are joined with a top-level
1779 C<AND>. We can change this by putting the different conditions we want in
1780 hashes and then putting those hashes in an array. For example:
1785 status => { -like => ['pending%', 'dispatched'] },
1789 status => 'unassigned',
1793 This data structure would create the following:
1795 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1796 OR ( user = ? AND status = ? ) )";
1797 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1799 This can be combined with the C<-nest> operator to properly group
1806 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1807 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1814 WHERE ( user = ? AND
1815 ( ( workhrs > ? AND geo = ? )
1816 OR ( workhrs < ? AND geo = ? ) ) )
1820 Finally, sometimes only literal SQL will do. If you want to include
1821 literal SQL verbatim, you can specify it as a scalar reference, namely:
1823 my $inn = 'is Not Null';
1825 priority => { '<', 2 },
1831 $stmt = "WHERE priority < ? AND requestor is Not Null";
1834 Note that in this example, you only get one bind parameter back, since
1835 the verbatim SQL is passed as part of the statement.
1837 Of course, just to prove a point, the above can also be accomplished
1841 priority => { '<', 2 },
1842 requestor => { '!=', undef },
1848 Conditions on boolean columns can be expressed in the
1849 same way, passing a reference to an empty string :
1852 priority => { '<', 2 },
1858 $stmt = "WHERE priority < ? AND is_ready";
1862 =head2 Literal SQL with placeholders and bind values (subqueries)
1864 If the literal SQL to be inserted has placeholders and bind values,
1865 use a reference to an arrayref (yes this is a double reference --
1866 not so common, but perfectly legal Perl). For example, to find a date
1867 in Postgres you can use something like this:
1870 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1875 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1879 Literal SQL is especially useful for nesting parenthesized clauses in the
1880 main SQL query. Here is a first example :
1882 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1886 bar => \["IN ($sub_stmt)" => @sub_bind],
1891 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1892 WHERE c2 < ? AND c3 LIKE ?))";
1893 @bind = (1234, 100, "foo%");
1895 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1896 are expressed in the same way. Of course the C<$sub_stmt> and
1897 its associated bind values can be generated through a former call
1900 my ($sub_stmt, @sub_bind)
1901 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1902 c3 => {-like => "foo%"}});
1905 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1908 In the examples above, the subquery was used as an operator on a column;
1909 but the same principle also applies for a clause within the main C<%where>
1910 hash, like an EXISTS subquery :
1912 my ($sub_stmt, @sub_bind)
1913 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1916 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1921 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1922 WHERE c1 = ? AND c2 > t0.c0))";
1926 Observe that the condition on C<c2> in the subquery refers to
1927 column C<t0.c0> of the main query : this is I<not> a bind
1928 value, so we have to express it through a scalar ref.
1929 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1930 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1931 what we wanted here.
1933 Another use of the subquery technique is when some SQL clauses need
1934 parentheses, as it often occurs with some proprietary SQL extensions
1935 like for example fulltext expressions, geospatial expressions,
1936 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1939 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1942 Finally, here is an example where a subquery is used
1943 for expressing unary negation:
1945 my ($sub_stmt, @sub_bind)
1946 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1947 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1949 lname => {like => '%son%'},
1950 -nest => \["NOT ($sub_stmt)" => @sub_bind],
1955 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1956 @bind = ('%son%', 10, 20)
1962 These pages could go on for a while, since the nesting of the data
1963 structures this module can handle are pretty much unlimited (the
1964 module implements the C<WHERE> expansion as a recursive function
1965 internally). Your best bet is to "play around" with the module a
1966 little to see how the data structures behave, and choose the best
1967 format for your data based on that.
1969 And of course, all the values above will probably be replaced with
1970 variables gotten from forms or the command line. After all, if you
1971 knew everything ahead of time, you wouldn't have to worry about
1972 dynamically-generating SQL and could just hardwire it into your
1978 =head1 ORDER BY CLAUSES
1980 Some functions take an order by clause. This can either be a scalar (just a
1981 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1982 or an array of either of the two previous forms. Examples:
1984 Given | Will Generate
1985 ----------------------------------------------------------
1986 \'colA DESC' | ORDER BY colA DESC
1987 'colA' | ORDER BY colA
1988 [qw/colA colB/] | ORDER BY colA, colB
1989 {-asc => 'colA'} | ORDER BY colA ASC
1990 {-desc => 'colB'} | ORDER BY colB DESC
1992 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
1995 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
1996 ==========================================================
2000 =head1 SPECIAL OPERATORS
2002 my $sqlmaker = SQL::Abstract->new(special_ops => [
2005 my ($self, $field, $op, $arg) = @_;
2011 A "special operator" is a SQL syntactic clause that can be
2012 applied to a field, instead of a usual binary operator.
2015 WHERE field IN (?, ?, ?)
2016 WHERE field BETWEEN ? AND ?
2017 WHERE MATCH(field) AGAINST (?, ?)
2019 Special operators IN and BETWEEN are fairly standard and therefore
2020 are builtin within C<SQL::Abstract>. For other operators,
2021 like the MATCH .. AGAINST example above which is
2022 specific to MySQL, you can write your own operator handlers :
2023 supply a C<special_ops> argument to the C<new> method.
2024 That argument takes an arrayref of operator definitions;
2025 each operator definition is a hashref with two entries
2031 the regular expression to match the operator
2035 coderef that will be called when meeting that operator
2036 in the input tree. The coderef will be called with
2037 arguments C<< ($self, $field, $op, $arg) >>, and
2038 should return a C<< ($sql, @bind) >> structure.
2042 For example, here is an implementation
2043 of the MATCH .. AGAINST syntax for MySQL
2045 my $sqlmaker = SQL::Abstract->new(special_ops => [
2047 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2048 {regex => qr/^match$/i,
2050 my ($self, $field, $op, $arg) = @_;
2051 $arg = [$arg] if not ref $arg;
2052 my $label = $self->_quote($field);
2053 my ($placeholder) = $self->_convert('?');
2054 my $placeholders = join ", ", (($placeholder) x @$arg);
2055 my $sql = $self->_sqlcase('match') . " ($label) "
2056 . $self->_sqlcase('against') . " ($placeholders) ";
2057 my @bind = $self->_bindtype($field, @$arg);
2058 return ($sql, @bind);
2067 Thanks to some benchmarking by Mark Stosberg, it turns out that
2068 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2069 I must admit this wasn't an intentional design issue, but it's a
2070 byproduct of the fact that you get to control your C<DBI> handles
2073 To maximize performance, use a code snippet like the following:
2075 # prepare a statement handle using the first row
2076 # and then reuse it for the rest of the rows
2078 for my $href (@array_of_hashrefs) {
2079 $stmt ||= $sql->insert('table', $href);
2080 $sth ||= $dbh->prepare($stmt);
2081 $sth->execute($sql->values($href));
2084 The reason this works is because the keys in your C<$href> are sorted
2085 internally by B<SQL::Abstract>. Thus, as long as your data retains
2086 the same structure, you only have to generate the SQL the first time
2087 around. On subsequent queries, simply use the C<values> function provided
2088 by this module to return your values in the correct order.
2093 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2094 really like this part (I do, at least). Building up a complex query
2095 can be as simple as the following:
2099 use CGI::FormBuilder;
2102 my $form = CGI::FormBuilder->new(...);
2103 my $sql = SQL::Abstract->new;
2105 if ($form->submitted) {
2106 my $field = $form->field;
2107 my $id = delete $field->{id};
2108 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2111 Of course, you would still have to connect using C<DBI> to run the
2112 query, but the point is that if you make your form look like your
2113 table, the actual query script can be extremely simplistic.
2115 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2116 a fast interface to returning and formatting data. I frequently
2117 use these three modules together to write complex database query
2118 apps in under 50 lines.
2123 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2124 Great care has been taken to preserve the I<published> behavior
2125 documented in previous versions in the 1.* family; however,
2126 some features that were previously undocumented, or behaved
2127 differently from the documentation, had to be changed in order
2128 to clarify the semantics. Hence, client code that was relying
2129 on some dark areas of C<SQL::Abstract> v1.*
2130 B<might behave differently> in v1.50.
2132 The main changes are :
2138 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2142 support for the { operator => \"..." } construct (to embed literal SQL)
2146 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2150 added -nest1, -nest2 or -nest_1, -nest_2, ...
2154 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2158 defensive programming : check arguments
2162 fixed bug with global logic, which was previously implemented
2163 through global variables yielding side-effects. Prior versons would
2164 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2165 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2166 Now this is interpreted
2167 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2171 C<-and> / C<-or> operators are no longer accepted
2172 in the middle of an arrayref : they are
2173 only admitted if in first position.
2177 changed logic for distributing an op over arrayrefs
2181 fixed semantics of _bindtype on array args
2185 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2186 we just avoid shifting arrays within that tree.
2190 dropped the C<_modlogic> function
2196 =head1 ACKNOWLEDGEMENTS
2198 There are a number of individuals that have really helped out with
2199 this module. Unfortunately, most of them submitted bugs via CPAN
2200 so I have no idea who they are! But the people I do know are:
2202 Ash Berlin (order_by hash term support)
2203 Matt Trout (DBIx::Class support)
2204 Mark Stosberg (benchmarking)
2205 Chas Owens (initial "IN" operator support)
2206 Philip Collins (per-field SQL functions)
2207 Eric Kolve (hashref "AND" support)
2208 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2209 Dan Kubb (support for "quote_char" and "name_sep")
2210 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2211 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2212 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2218 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2222 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2224 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2226 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2227 While not an official support venue, C<DBIx::Class> makes heavy use of
2228 C<SQL::Abstract>, and as such list members there are very familiar with
2229 how to create queries.
2231 This module is free software; you may copy this under the terms of
2232 the GNU General Public License, or the Artistic License, copies of
2233 which should have accompanied your Perl kit.