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_04';
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';
995 foreach my $k ( sort keys %$data ) {
997 $self->_SWITCH_refkind($v, {
999 if ($self->{array_datatypes}) { # array datatype
1000 push @all_bind, $self->_bindtype($k, $v);
1002 else { # literal SQL with bind
1003 my ($sql, @bind) = @$v;
1004 $self->_assert_bindval_matches_bindtype(@bind);
1005 push @all_bind, @bind;
1008 ARRAYREFREF => sub { # literal SQL with bind
1009 my ($sql, @bind) = @${$v};
1010 $self->_assert_bindval_matches_bindtype(@bind);
1011 push @all_bind, @bind;
1013 SCALARREF => sub { # literal SQL without bind
1015 SCALAR_or_UNDEF => sub {
1016 push @all_bind, $self->_bindtype($k, $v);
1027 my(@sql, @sqlq, @sqlv);
1031 if ($ref eq 'HASH') {
1032 for my $k (sort keys %$_) {
1035 my $label = $self->_quote($k);
1036 if ($r eq 'ARRAY') {
1037 # literal SQL with bind
1038 my ($sql, @bind) = @$v;
1039 $self->_assert_bindval_matches_bindtype(@bind);
1040 push @sqlq, "$label = $sql";
1042 } elsif ($r eq 'SCALAR') {
1043 # literal SQL without bind
1044 push @sqlq, "$label = $$v";
1046 push @sqlq, "$label = ?";
1047 push @sqlv, $self->_bindtype($k, $v);
1050 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1051 } elsif ($ref eq 'ARRAY') {
1052 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1055 if ($r eq 'ARRAY') { # literal SQL with bind
1056 my ($sql, @bind) = @$v;
1057 $self->_assert_bindval_matches_bindtype(@bind);
1060 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1061 # embedded literal SQL
1068 push @sql, '(' . join(', ', @sqlq) . ')';
1069 } elsif ($ref eq 'SCALAR') {
1073 # strings get case twiddled
1074 push @sql, $self->_sqlcase($_);
1078 my $sql = join ' ', @sql;
1080 # this is pretty tricky
1081 # if ask for an array, return ($stmt, @bind)
1082 # otherwise, s/?/shift @sqlv/ to put it inline
1084 return ($sql, @sqlv);
1086 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1087 ref $d ? $d->[1] : $d/e;
1096 # This allows us to check for a local, then _form, attr
1098 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1099 return $self->generate($name, @_);
1110 SQL::Abstract - Generate SQL from Perl data structures
1116 my $sql = SQL::Abstract->new;
1118 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1120 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1122 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1124 my($stmt, @bind) = $sql->delete($table, \%where);
1126 # Then, use these in your DBI statements
1127 my $sth = $dbh->prepare($stmt);
1128 $sth->execute(@bind);
1130 # Just generate the WHERE clause
1131 my($stmt, @bind) = $sql->where(\%where, \@order);
1133 # Return values in the same order, for hashed queries
1134 # See PERFORMANCE section for more details
1135 my @bind = $sql->values(\%fieldvals);
1139 This module was inspired by the excellent L<DBIx::Abstract>.
1140 However, in using that module I found that what I really wanted
1141 to do was generate SQL, but still retain complete control over my
1142 statement handles and use the DBI interface. So, I set out to
1143 create an abstract SQL generation module.
1145 While based on the concepts used by L<DBIx::Abstract>, there are
1146 several important differences, especially when it comes to WHERE
1147 clauses. I have modified the concepts used to make the SQL easier
1148 to generate from Perl data structures and, IMO, more intuitive.
1149 The underlying idea is for this module to do what you mean, based
1150 on the data structures you provide it. The big advantage is that
1151 you don't have to modify your code every time your data changes,
1152 as this module figures it out.
1154 To begin with, an SQL INSERT is as easy as just specifying a hash
1155 of C<key=value> pairs:
1158 name => 'Jimbo Bobson',
1159 phone => '123-456-7890',
1160 address => '42 Sister Lane',
1161 city => 'St. Louis',
1162 state => 'Louisiana',
1165 The SQL can then be generated with this:
1167 my($stmt, @bind) = $sql->insert('people', \%data);
1169 Which would give you something like this:
1171 $stmt = "INSERT INTO people
1172 (address, city, name, phone, state)
1173 VALUES (?, ?, ?, ?, ?)";
1174 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1175 '123-456-7890', 'Louisiana');
1177 These are then used directly in your DBI code:
1179 my $sth = $dbh->prepare($stmt);
1180 $sth->execute(@bind);
1182 =head2 Inserting and Updating Arrays
1184 If your database has array types (like for example Postgres),
1185 activate the special option C<< array_datatypes => 1 >>
1186 when creating the C<SQL::Abstract> object.
1187 Then you may use an arrayref to insert and update database array types:
1189 my $sql = SQL::Abstract->new(array_datatypes => 1);
1191 planets => [qw/Mercury Venus Earth Mars/]
1194 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1198 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1200 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1203 =head2 Inserting and Updating SQL
1205 In order to apply SQL functions to elements of your C<%data> you may
1206 specify a reference to an arrayref for the given hash value. For example,
1207 if you need to execute the Oracle C<to_date> function on a value, you can
1208 say something like this:
1212 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1215 The first value in the array is the actual SQL. Any other values are
1216 optional and would be included in the bind values array. This gives
1219 my($stmt, @bind) = $sql->insert('people', \%data);
1221 $stmt = "INSERT INTO people (name, date_entered)
1222 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1223 @bind = ('Bill', '03/02/2003');
1225 An UPDATE is just as easy, all you change is the name of the function:
1227 my($stmt, @bind) = $sql->update('people', \%data);
1229 Notice that your C<%data> isn't touched; the module will generate
1230 the appropriately quirky SQL for you automatically. Usually you'll
1231 want to specify a WHERE clause for your UPDATE, though, which is
1232 where handling C<%where> hashes comes in handy...
1234 =head2 Complex where statements
1236 This module can generate pretty complicated WHERE statements
1237 easily. For example, simple C<key=value> pairs are taken to mean
1238 equality, and if you want to see if a field is within a set
1239 of values, you can use an arrayref. Let's say we wanted to
1240 SELECT some data based on this criteria:
1243 requestor => 'inna',
1244 worker => ['nwiger', 'rcwe', 'sfz'],
1245 status => { '!=', 'completed' }
1248 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1250 The above would give you something like this:
1252 $stmt = "SELECT * FROM tickets WHERE
1253 ( requestor = ? ) AND ( status != ? )
1254 AND ( worker = ? OR worker = ? OR worker = ? )";
1255 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1257 Which you could then use in DBI code like so:
1259 my $sth = $dbh->prepare($stmt);
1260 $sth->execute(@bind);
1266 The functions are simple. There's one for each major SQL operation,
1267 and a constructor you use first. The arguments are specified in a
1268 similar order to each function (table, then fields, then a where
1269 clause) to try and simplify things.
1274 =head2 new(option => 'value')
1276 The C<new()> function takes a list of options and values, and returns
1277 a new B<SQL::Abstract> object which can then be used to generate SQL
1278 through the methods below. The options accepted are:
1284 If set to 'lower', then SQL will be generated in all lowercase. By
1285 default SQL is generated in "textbook" case meaning something like:
1287 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1289 Any setting other than 'lower' is ignored.
1293 This determines what the default comparison operator is. By default
1294 it is C<=>, meaning that a hash like this:
1296 %where = (name => 'nwiger', email => 'nate@wiger.org');
1298 Will generate SQL like this:
1300 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1302 However, you may want loose comparisons by default, so if you set
1303 C<cmp> to C<like> you would get SQL such as:
1305 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1307 You can also override the comparsion on an individual basis - see
1308 the huge section on L</"WHERE CLAUSES"> at the bottom.
1310 =item sqltrue, sqlfalse
1312 Expressions for inserting boolean values within SQL statements.
1313 By default these are C<1=1> and C<1=0>.
1317 This determines the default logical operator for multiple WHERE
1318 statements in arrays. By default it is "or", meaning that a WHERE
1322 event_date => {'>=', '2/13/99'},
1323 event_date => {'<=', '4/24/03'},
1326 Will generate SQL like this:
1328 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1330 This is probably not what you want given this query, though (look
1331 at the dates). To change the "OR" to an "AND", simply specify:
1333 my $sql = SQL::Abstract->new(logic => 'and');
1335 Which will change the above C<WHERE> to:
1337 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1339 The logic can also be changed locally by inserting
1340 an extra first element in the array :
1342 @where = (-and => event_date => {'>=', '2/13/99'},
1343 event_date => {'<=', '4/24/03'} );
1345 See the L</"WHERE CLAUSES"> section for explanations.
1349 This will automatically convert comparisons using the specified SQL
1350 function for both column and value. This is mostly used with an argument
1351 of C<upper> or C<lower>, so that the SQL will have the effect of
1352 case-insensitive "searches". For example, this:
1354 $sql = SQL::Abstract->new(convert => 'upper');
1355 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1357 Will turn out the following SQL:
1359 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1361 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1362 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1363 not validate this option; it will just pass through what you specify verbatim).
1367 This is a kludge because many databases suck. For example, you can't
1368 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1369 Instead, you have to use C<bind_param()>:
1371 $sth->bind_param(1, 'reg data');
1372 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1374 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1375 which loses track of which field each slot refers to. Fear not.
1377 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1378 Currently, you can specify either C<normal> (default) or C<columns>. If you
1379 specify C<columns>, you will get an array that looks like this:
1381 my $sql = SQL::Abstract->new(bindtype => 'columns');
1382 my($stmt, @bind) = $sql->insert(...);
1385 [ 'column1', 'value1' ],
1386 [ 'column2', 'value2' ],
1387 [ 'column3', 'value3' ],
1390 You can then iterate through this manually, using DBI's C<bind_param()>.
1392 $sth->prepare($stmt);
1395 my($col, $data) = @$_;
1396 if ($col eq 'details' || $col eq 'comments') {
1397 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1398 } elsif ($col eq 'image') {
1399 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1401 $sth->bind_param($i, $data);
1405 $sth->execute; # execute without @bind now
1407 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1408 Basically, the advantage is still that you don't have to care which fields
1409 are or are not included. You could wrap that above C<for> loop in a simple
1410 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1411 get a layer of abstraction over manual SQL specification.
1413 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1414 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1415 will expect the bind values in this format.
1419 This is the character that a table or column name will be quoted
1420 with. By default this is an empty string, but you could set it to
1421 the character C<`>, to generate SQL like this:
1423 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1425 Alternatively, you can supply an array ref of two items, the first being the left
1426 hand quote character, and the second the right hand quote character. For
1427 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1428 that generates SQL like this:
1430 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1432 Quoting is useful if you have tables or columns names that are reserved
1433 words in your database's SQL dialect.
1437 This is the character that separates a table and column name. It is
1438 necessary to specify this when the C<quote_char> option is selected,
1439 so that tables and column names can be individually quoted like this:
1441 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1443 =item array_datatypes
1445 When this option is true, arrayrefs in INSERT or UPDATE are
1446 interpreted as array datatypes and are passed directly
1448 When this option is false, arrayrefs are interpreted
1449 as literal SQL, just like refs to arrayrefs
1450 (but this behavior is for backwards compatibility; when writing
1451 new queries, use the "reference to arrayref" syntax
1457 Takes a reference to a list of "special operators"
1458 to extend the syntax understood by L<SQL::Abstract>.
1459 See section L</"SPECIAL OPERATORS"> for details.
1465 =head2 insert($table, \@values || \%fieldvals)
1467 This is the simplest function. You simply give it a table name
1468 and either an arrayref of values or hashref of field/value pairs.
1469 It returns an SQL INSERT statement and a list of bind values.
1470 See the sections on L</"Inserting and Updating Arrays"> and
1471 L</"Inserting and Updating SQL"> for information on how to insert
1472 with those data types.
1474 =head2 update($table, \%fieldvals, \%where)
1476 This takes a table, hashref of field/value pairs, and an optional
1477 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1479 See the sections on L</"Inserting and Updating Arrays"> and
1480 L</"Inserting and Updating SQL"> for information on how to insert
1481 with those data types.
1483 =head2 select($source, $fields, $where, $order)
1485 This returns a SQL SELECT statement and associated list of bind values, as
1486 specified by the arguments :
1492 Specification of the 'FROM' part of the statement.
1493 The argument can be either a plain scalar (interpreted as a table
1494 name, will be quoted), or an arrayref (interpreted as a list
1495 of table names, joined by commas, quoted), or a scalarref
1496 (literal table name, not quoted), or a ref to an arrayref
1497 (list of literal table names, joined by commas, not quoted).
1501 Specification of the list of fields to retrieve from
1503 The argument can be either an arrayref (interpreted as a list
1504 of field names, will be joined by commas and quoted), or a
1505 plain scalar (literal SQL, not quoted).
1506 Please observe that this API is not as flexible as for
1507 the first argument C<$table>, for backwards compatibility reasons.
1511 Optional argument to specify the WHERE part of the query.
1512 The argument is most often a hashref, but can also be
1513 an arrayref or plain scalar --
1514 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1518 Optional argument to specify the ORDER BY part of the query.
1519 The argument can be a scalar, a hashref or an arrayref
1520 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1526 =head2 delete($table, \%where)
1528 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1529 It returns an SQL DELETE statement and list of bind values.
1531 =head2 where(\%where, \@order)
1533 This is used to generate just the WHERE clause. For example,
1534 if you have an arbitrary data structure and know what the
1535 rest of your SQL is going to look like, but want an easy way
1536 to produce a WHERE clause, use this. It returns an SQL WHERE
1537 clause and list of bind values.
1540 =head2 values(\%data)
1542 This just returns the values from the hash C<%data>, in the same
1543 order that would be returned from any of the other above queries.
1544 Using this allows you to markedly speed up your queries if you
1545 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1547 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1549 Warning: This is an experimental method and subject to change.
1551 This returns arbitrarily generated SQL. It's a really basic shortcut.
1552 It will return two different things, depending on return context:
1554 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1555 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1557 These would return the following:
1559 # First calling form
1560 $stmt = "CREATE TABLE test (?, ?)";
1561 @bind = (field1, field2);
1563 # Second calling form
1564 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1566 Depending on what you're trying to do, it's up to you to choose the correct
1567 format. In this example, the second form is what you would want.
1571 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1575 ALTER SESSION SET nls_date_format = 'MM/YY'
1577 You get the idea. Strings get their case twiddled, but everything
1578 else remains verbatim.
1583 =head1 WHERE CLAUSES
1587 This module uses a variation on the idea from L<DBIx::Abstract>. It
1588 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1589 module is that things in arrays are OR'ed, and things in hashes
1592 The easiest way to explain is to show lots of examples. After
1593 each C<%where> hash shown, it is assumed you used:
1595 my($stmt, @bind) = $sql->where(\%where);
1597 However, note that the C<%where> hash can be used directly in any
1598 of the other functions as well, as described above.
1600 =head2 Key-value pairs
1602 So, let's get started. To begin, a simple hash:
1606 status => 'completed'
1609 Is converted to SQL C<key = val> statements:
1611 $stmt = "WHERE user = ? AND status = ?";
1612 @bind = ('nwiger', 'completed');
1614 One common thing I end up doing is having a list of values that
1615 a field can be in. To do this, simply specify a list inside of
1620 status => ['assigned', 'in-progress', 'pending'];
1623 This simple code will create the following:
1625 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1626 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1628 An empty arrayref will be considered a logical false and
1631 =head2 Key-value pairs
1633 If you want to specify a different type of operator for your comparison,
1634 you can use a hashref for a given column:
1638 status => { '!=', 'completed' }
1641 Which would generate:
1643 $stmt = "WHERE user = ? AND status != ?";
1644 @bind = ('nwiger', 'completed');
1646 To test against multiple values, just enclose the values in an arrayref:
1648 status => { '!=', ['assigned', 'in-progress', 'pending'] };
1650 Which would give you:
1652 "WHERE status != ? AND status != ? AND status != ?"
1654 Notice that since the operator was recognized as being a 'negative'
1655 operator, the arrayref was interpreted with 'AND' logic (because
1656 of Morgan's laws). By contrast, the reverse
1658 status => { '=', ['assigned', 'in-progress', 'pending'] };
1662 "WHERE status = ? OR status = ? OR status = ?"
1665 The hashref can also contain multiple pairs, in which case it is expanded
1666 into an C<AND> of its elements:
1670 status => { '!=', 'completed', -not_like => 'pending%' }
1673 # Or more dynamically, like from a form
1674 $where{user} = 'nwiger';
1675 $where{status}{'!='} = 'completed';
1676 $where{status}{'-not_like'} = 'pending%';
1678 # Both generate this
1679 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1680 @bind = ('nwiger', 'completed', 'pending%');
1683 To get an OR instead, you can combine it with the arrayref idea:
1687 priority => [ {'=', 2}, {'!=', 1} ]
1690 Which would generate:
1692 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1693 @bind = ('nwiger', '2', '1');
1695 If you want to include literal SQL (with or without bind values), just use a
1696 scalar reference or array reference as the value:
1699 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1700 date_expires => { '<' => \"now()" }
1703 Which would generate:
1705 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1706 @bind = ('11/26/2008');
1709 =head2 Logic and nesting operators
1711 In the example above,
1712 there is a subtle trap if you want to say something like
1713 this (notice the C<AND>):
1715 WHERE priority != ? AND priority != ?
1717 Because, in Perl you I<can't> do this:
1719 priority => { '!=', 2, '!=', 1 }
1721 As the second C<!=> key will obliterate the first. The solution
1722 is to use the special C<-modifier> form inside an arrayref:
1724 priority => [ -and => {'!=', 2},
1728 Normally, these would be joined by C<OR>, but the modifier tells it
1729 to use C<AND> instead. (Hint: You can use this in conjunction with the
1730 C<logic> option to C<new()> in order to change the way your queries
1731 work by default.) B<Important:> Note that the C<-modifier> goes
1732 B<INSIDE> the arrayref, as an extra first element. This will
1733 B<NOT> do what you think it might:
1735 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1737 Here is a quick list of equivalencies, since there is some overlap:
1740 status => {'!=', 'completed', 'not like', 'pending%' }
1741 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1744 status => {'=', ['assigned', 'in-progress']}
1745 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1746 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1748 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1749 operator which adds an additional set of parens, to create a subquery.
1750 For example, to get something like this:
1752 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1753 @bind = ('nwiger', '20', 'ASIA');
1759 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1762 If you need several nested subexpressions, you can number
1763 the C<-nest> branches :
1773 =head2 Special operators : IN, BETWEEN, etc.
1775 You can also use the hashref format to compare a list of fields using the
1776 C<IN> comparison operator, by specifying the list as an arrayref:
1779 status => 'completed',
1780 reportid => { -in => [567, 2335, 2] }
1783 Which would generate:
1785 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1786 @bind = ('completed', '567', '2335', '2');
1788 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1791 Another pair of operators is C<-between> and C<-not_between>,
1792 used with an arrayref of two values:
1796 completion_date => {
1797 -not_between => ['2002-10-01', '2003-02-06']
1803 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1805 These are the two builtin "special operators"; but the
1806 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1808 =head2 Nested conditions
1810 So far, we've seen how multiple conditions are joined with a top-level
1811 C<AND>. We can change this by putting the different conditions we want in
1812 hashes and then putting those hashes in an array. For example:
1817 status => { -like => ['pending%', 'dispatched'] },
1821 status => 'unassigned',
1825 This data structure would create the following:
1827 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1828 OR ( user = ? AND status = ? ) )";
1829 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1831 This can be combined with the C<-nest> operator to properly group
1838 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1839 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1846 WHERE ( user = ? AND
1847 ( ( workhrs > ? AND geo = ? )
1848 OR ( workhrs < ? AND geo = ? ) ) )
1852 Finally, sometimes only literal SQL will do. If you want to include
1853 literal SQL verbatim, you can specify it as a scalar reference, namely:
1855 my $inn = 'is Not Null';
1857 priority => { '<', 2 },
1863 $stmt = "WHERE priority < ? AND requestor is Not Null";
1866 Note that in this example, you only get one bind parameter back, since
1867 the verbatim SQL is passed as part of the statement.
1869 Of course, just to prove a point, the above can also be accomplished
1873 priority => { '<', 2 },
1874 requestor => { '!=', undef },
1880 Conditions on boolean columns can be expressed in the
1881 same way, passing a reference to an empty string :
1884 priority => { '<', 2 },
1890 $stmt = "WHERE priority < ? AND is_ready";
1894 =head2 Literal SQL with placeholders and bind values (subqueries)
1896 If the literal SQL to be inserted has placeholders and bind values,
1897 use a reference to an arrayref (yes this is a double reference --
1898 not so common, but perfectly legal Perl). For example, to find a date
1899 in Postgres you can use something like this:
1902 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1907 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1910 Note that you must pass the bind values in the same format as they are returned
1911 by C</where>. That means that if you set L</bindtype> to C<columns>, you must
1912 provide the bind values in the C<< [ column_meta => value ] >> format, where
1913 C<column_meta> is an opaque scalar value; most commonly the column name, but
1914 you can use any scalar scalar value (including references and blessed
1915 references), L<SQL::Abstract> will simply pass it through intact. So eg. the
1916 above example will look like:
1919 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1922 Literal SQL is especially useful for nesting parenthesized clauses in the
1923 main SQL query. Here is a first example :
1925 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1929 bar => \["IN ($sub_stmt)" => @sub_bind],
1934 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1935 WHERE c2 < ? AND c3 LIKE ?))";
1936 @bind = (1234, 100, "foo%");
1938 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1939 are expressed in the same way. Of course the C<$sub_stmt> and
1940 its associated bind values can be generated through a former call
1943 my ($sub_stmt, @sub_bind)
1944 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1945 c3 => {-like => "foo%"}});
1948 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1951 In the examples above, the subquery was used as an operator on a column;
1952 but the same principle also applies for a clause within the main C<%where>
1953 hash, like an EXISTS subquery :
1955 my ($sub_stmt, @sub_bind)
1956 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1959 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1964 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1965 WHERE c1 = ? AND c2 > t0.c0))";
1969 Observe that the condition on C<c2> in the subquery refers to
1970 column C<t0.c0> of the main query : this is I<not> a bind
1971 value, so we have to express it through a scalar ref.
1972 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1973 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1974 what we wanted here.
1976 Another use of the subquery technique is when some SQL clauses need
1977 parentheses, as it often occurs with some proprietary SQL extensions
1978 like for example fulltext expressions, geospatial expressions,
1979 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1982 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1985 Finally, here is an example where a subquery is used
1986 for expressing unary negation:
1988 my ($sub_stmt, @sub_bind)
1989 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1990 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1992 lname => {like => '%son%'},
1993 -nest => \["NOT ($sub_stmt)" => @sub_bind],
1998 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1999 @bind = ('%son%', 10, 20)
2005 These pages could go on for a while, since the nesting of the data
2006 structures this module can handle are pretty much unlimited (the
2007 module implements the C<WHERE> expansion as a recursive function
2008 internally). Your best bet is to "play around" with the module a
2009 little to see how the data structures behave, and choose the best
2010 format for your data based on that.
2012 And of course, all the values above will probably be replaced with
2013 variables gotten from forms or the command line. After all, if you
2014 knew everything ahead of time, you wouldn't have to worry about
2015 dynamically-generating SQL and could just hardwire it into your
2021 =head1 ORDER BY CLAUSES
2023 Some functions take an order by clause. This can either be a scalar (just a
2024 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2025 or an array of either of the two previous forms. Examples:
2027 Given | Will Generate
2028 ----------------------------------------------------------
2029 \'colA DESC' | ORDER BY colA DESC
2030 'colA' | ORDER BY colA
2031 [qw/colA colB/] | ORDER BY colA, colB
2032 {-asc => 'colA'} | ORDER BY colA ASC
2033 {-desc => 'colB'} | ORDER BY colB DESC
2035 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
2038 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
2039 ==========================================================
2043 =head1 SPECIAL OPERATORS
2045 my $sqlmaker = SQL::Abstract->new(special_ops => [
2048 my ($self, $field, $op, $arg) = @_;
2054 A "special operator" is a SQL syntactic clause that can be
2055 applied to a field, instead of a usual binary operator.
2058 WHERE field IN (?, ?, ?)
2059 WHERE field BETWEEN ? AND ?
2060 WHERE MATCH(field) AGAINST (?, ?)
2062 Special operators IN and BETWEEN are fairly standard and therefore
2063 are builtin within C<SQL::Abstract>. For other operators,
2064 like the MATCH .. AGAINST example above which is
2065 specific to MySQL, you can write your own operator handlers :
2066 supply a C<special_ops> argument to the C<new> method.
2067 That argument takes an arrayref of operator definitions;
2068 each operator definition is a hashref with two entries
2074 the regular expression to match the operator
2078 coderef that will be called when meeting that operator
2079 in the input tree. The coderef will be called with
2080 arguments C<< ($self, $field, $op, $arg) >>, and
2081 should return a C<< ($sql, @bind) >> structure.
2085 For example, here is an implementation
2086 of the MATCH .. AGAINST syntax for MySQL
2088 my $sqlmaker = SQL::Abstract->new(special_ops => [
2090 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2091 {regex => qr/^match$/i,
2093 my ($self, $field, $op, $arg) = @_;
2094 $arg = [$arg] if not ref $arg;
2095 my $label = $self->_quote($field);
2096 my ($placeholder) = $self->_convert('?');
2097 my $placeholders = join ", ", (($placeholder) x @$arg);
2098 my $sql = $self->_sqlcase('match') . " ($label) "
2099 . $self->_sqlcase('against') . " ($placeholders) ";
2100 my @bind = $self->_bindtype($field, @$arg);
2101 return ($sql, @bind);
2110 Thanks to some benchmarking by Mark Stosberg, it turns out that
2111 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2112 I must admit this wasn't an intentional design issue, but it's a
2113 byproduct of the fact that you get to control your C<DBI> handles
2116 To maximize performance, use a code snippet like the following:
2118 # prepare a statement handle using the first row
2119 # and then reuse it for the rest of the rows
2121 for my $href (@array_of_hashrefs) {
2122 $stmt ||= $sql->insert('table', $href);
2123 $sth ||= $dbh->prepare($stmt);
2124 $sth->execute($sql->values($href));
2127 The reason this works is because the keys in your C<$href> are sorted
2128 internally by B<SQL::Abstract>. Thus, as long as your data retains
2129 the same structure, you only have to generate the SQL the first time
2130 around. On subsequent queries, simply use the C<values> function provided
2131 by this module to return your values in the correct order.
2136 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2137 really like this part (I do, at least). Building up a complex query
2138 can be as simple as the following:
2142 use CGI::FormBuilder;
2145 my $form = CGI::FormBuilder->new(...);
2146 my $sql = SQL::Abstract->new;
2148 if ($form->submitted) {
2149 my $field = $form->field;
2150 my $id = delete $field->{id};
2151 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2154 Of course, you would still have to connect using C<DBI> to run the
2155 query, but the point is that if you make your form look like your
2156 table, the actual query script can be extremely simplistic.
2158 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2159 a fast interface to returning and formatting data. I frequently
2160 use these three modules together to write complex database query
2161 apps in under 50 lines.
2166 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2167 Great care has been taken to preserve the I<published> behavior
2168 documented in previous versions in the 1.* family; however,
2169 some features that were previously undocumented, or behaved
2170 differently from the documentation, had to be changed in order
2171 to clarify the semantics. Hence, client code that was relying
2172 on some dark areas of C<SQL::Abstract> v1.*
2173 B<might behave differently> in v1.50.
2175 The main changes are :
2181 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2185 support for the { operator => \"..." } construct (to embed literal SQL)
2189 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2193 added -nest1, -nest2 or -nest_1, -nest_2, ...
2197 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2201 defensive programming : check arguments
2205 fixed bug with global logic, which was previously implemented
2206 through global variables yielding side-effects. Prior versons would
2207 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2208 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2209 Now this is interpreted
2210 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2214 C<-and> / C<-or> operators are no longer accepted
2215 in the middle of an arrayref : they are
2216 only admitted if in first position.
2220 changed logic for distributing an op over arrayrefs
2224 fixed semantics of _bindtype on array args
2228 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2229 we just avoid shifting arrays within that tree.
2233 dropped the C<_modlogic> function
2239 =head1 ACKNOWLEDGEMENTS
2241 There are a number of individuals that have really helped out with
2242 this module. Unfortunately, most of them submitted bugs via CPAN
2243 so I have no idea who they are! But the people I do know are:
2245 Ash Berlin (order_by hash term support)
2246 Matt Trout (DBIx::Class support)
2247 Mark Stosberg (benchmarking)
2248 Chas Owens (initial "IN" operator support)
2249 Philip Collins (per-field SQL functions)
2250 Eric Kolve (hashref "AND" support)
2251 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2252 Dan Kubb (support for "quote_char" and "name_sep")
2253 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2254 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2255 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2261 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2265 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2267 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2269 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2270 While not an official support venue, C<DBIx::Class> makes heavy use of
2271 C<SQL::Abstract>, and as such list members there are very familiar with
2272 how to create queries.
2274 This module is free software; you may copy this under the terms of
2275 the GNU General Public License, or the Artistic License, copies of
2276 which should have accompanied your Perl kit.