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.
1385 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1386 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1387 will expect the bind values in this format.
1391 This is the character that a table or column name will be quoted
1392 with. By default this is an empty string, but you could set it to
1393 the character C<`>, to generate SQL like this:
1395 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1397 Alternatively, you can supply an array ref of two items, the first being the left
1398 hand quote character, and the second the right hand quote character. For
1399 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1400 that generates SQL like this:
1402 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1404 Quoting is useful if you have tables or columns names that are reserved
1405 words in your database's SQL dialect.
1409 This is the character that separates a table and column name. It is
1410 necessary to specify this when the C<quote_char> option is selected,
1411 so that tables and column names can be individually quoted like this:
1413 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1415 =item array_datatypes
1417 When this option is true, arrayrefs in INSERT or UPDATE are
1418 interpreted as array datatypes and are passed directly
1420 When this option is false, arrayrefs are interpreted
1421 as literal SQL, just like refs to arrayrefs
1422 (but this behavior is for backwards compatibility; when writing
1423 new queries, use the "reference to arrayref" syntax
1429 Takes a reference to a list of "special operators"
1430 to extend the syntax understood by L<SQL::Abstract>.
1431 See section L</"SPECIAL OPERATORS"> for details.
1437 =head2 insert($table, \@values || \%fieldvals)
1439 This is the simplest function. You simply give it a table name
1440 and either an arrayref of values or hashref of field/value pairs.
1441 It returns an SQL INSERT statement and a list of bind values.
1442 See the sections on L</"Inserting and Updating Arrays"> and
1443 L</"Inserting and Updating SQL"> for information on how to insert
1444 with those data types.
1446 =head2 update($table, \%fieldvals, \%where)
1448 This takes a table, hashref of field/value pairs, and an optional
1449 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1451 See the sections on L</"Inserting and Updating Arrays"> and
1452 L</"Inserting and Updating SQL"> for information on how to insert
1453 with those data types.
1455 =head2 select($source, $fields, $where, $order)
1457 This returns a SQL SELECT statement and associated list of bind values, as
1458 specified by the arguments :
1464 Specification of the 'FROM' part of the statement.
1465 The argument can be either a plain scalar (interpreted as a table
1466 name, will be quoted), or an arrayref (interpreted as a list
1467 of table names, joined by commas, quoted), or a scalarref
1468 (literal table name, not quoted), or a ref to an arrayref
1469 (list of literal table names, joined by commas, not quoted).
1473 Specification of the list of fields to retrieve from
1475 The argument can be either an arrayref (interpreted as a list
1476 of field names, will be joined by commas and quoted), or a
1477 plain scalar (literal SQL, not quoted).
1478 Please observe that this API is not as flexible as for
1479 the first argument C<$table>, for backwards compatibility reasons.
1483 Optional argument to specify the WHERE part of the query.
1484 The argument is most often a hashref, but can also be
1485 an arrayref or plain scalar --
1486 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1490 Optional argument to specify the ORDER BY part of the query.
1491 The argument can be a scalar, a hashref or an arrayref
1492 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1498 =head2 delete($table, \%where)
1500 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1501 It returns an SQL DELETE statement and list of bind values.
1503 =head2 where(\%where, \@order)
1505 This is used to generate just the WHERE clause. For example,
1506 if you have an arbitrary data structure and know what the
1507 rest of your SQL is going to look like, but want an easy way
1508 to produce a WHERE clause, use this. It returns an SQL WHERE
1509 clause and list of bind values.
1512 =head2 values(\%data)
1514 This just returns the values from the hash C<%data>, in the same
1515 order that would be returned from any of the other above queries.
1516 Using this allows you to markedly speed up your queries if you
1517 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1519 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1521 Warning: This is an experimental method and subject to change.
1523 This returns arbitrarily generated SQL. It's a really basic shortcut.
1524 It will return two different things, depending on return context:
1526 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1527 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1529 These would return the following:
1531 # First calling form
1532 $stmt = "CREATE TABLE test (?, ?)";
1533 @bind = (field1, field2);
1535 # Second calling form
1536 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1538 Depending on what you're trying to do, it's up to you to choose the correct
1539 format. In this example, the second form is what you would want.
1543 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1547 ALTER SESSION SET nls_date_format = 'MM/YY'
1549 You get the idea. Strings get their case twiddled, but everything
1550 else remains verbatim.
1555 =head1 WHERE CLAUSES
1559 This module uses a variation on the idea from L<DBIx::Abstract>. It
1560 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1561 module is that things in arrays are OR'ed, and things in hashes
1564 The easiest way to explain is to show lots of examples. After
1565 each C<%where> hash shown, it is assumed you used:
1567 my($stmt, @bind) = $sql->where(\%where);
1569 However, note that the C<%where> hash can be used directly in any
1570 of the other functions as well, as described above.
1572 =head2 Key-value pairs
1574 So, let's get started. To begin, a simple hash:
1578 status => 'completed'
1581 Is converted to SQL C<key = val> statements:
1583 $stmt = "WHERE user = ? AND status = ?";
1584 @bind = ('nwiger', 'completed');
1586 One common thing I end up doing is having a list of values that
1587 a field can be in. To do this, simply specify a list inside of
1592 status => ['assigned', 'in-progress', 'pending'];
1595 This simple code will create the following:
1597 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1598 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1600 An empty arrayref will be considered a logical false and
1603 =head2 Key-value pairs
1605 If you want to specify a different type of operator for your comparison,
1606 you can use a hashref for a given column:
1610 status => { '!=', 'completed' }
1613 Which would generate:
1615 $stmt = "WHERE user = ? AND status != ?";
1616 @bind = ('nwiger', 'completed');
1618 To test against multiple values, just enclose the values in an arrayref:
1620 status => { '!=', ['assigned', 'in-progress', 'pending'] };
1622 Which would give you:
1624 "WHERE status != ? AND status != ? AND status != ?"
1626 Notice that since the operator was recognized as being a 'negative'
1627 operator, the arrayref was interpreted with 'AND' logic (because
1628 of Morgan's laws). By contrast, the reverse
1630 status => { '=', ['assigned', 'in-progress', 'pending'] };
1634 "WHERE status = ? OR status = ? OR status = ?"
1637 The hashref can also contain multiple pairs, in which case it is expanded
1638 into an C<AND> of its elements:
1642 status => { '!=', 'completed', -not_like => 'pending%' }
1645 # Or more dynamically, like from a form
1646 $where{user} = 'nwiger';
1647 $where{status}{'!='} = 'completed';
1648 $where{status}{'-not_like'} = 'pending%';
1650 # Both generate this
1651 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1652 @bind = ('nwiger', 'completed', 'pending%');
1655 To get an OR instead, you can combine it with the arrayref idea:
1659 priority => [ {'=', 2}, {'!=', 1} ]
1662 Which would generate:
1664 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1665 @bind = ('nwiger', '2', '1');
1667 If you want to include literal SQL (with or without bind values), just use a
1668 scalar reference or array reference as the value:
1671 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1672 date_expires => { '<' => \"now()" }
1675 Which would generate:
1677 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1678 @bind = ('11/26/2008');
1681 =head2 Logic and nesting operators
1683 In the example above,
1684 there is a subtle trap if you want to say something like
1685 this (notice the C<AND>):
1687 WHERE priority != ? AND priority != ?
1689 Because, in Perl you I<can't> do this:
1691 priority => { '!=', 2, '!=', 1 }
1693 As the second C<!=> key will obliterate the first. The solution
1694 is to use the special C<-modifier> form inside an arrayref:
1696 priority => [ -and => {'!=', 2},
1700 Normally, these would be joined by C<OR>, but the modifier tells it
1701 to use C<AND> instead. (Hint: You can use this in conjunction with the
1702 C<logic> option to C<new()> in order to change the way your queries
1703 work by default.) B<Important:> Note that the C<-modifier> goes
1704 B<INSIDE> the arrayref, as an extra first element. This will
1705 B<NOT> do what you think it might:
1707 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1709 Here is a quick list of equivalencies, since there is some overlap:
1712 status => {'!=', 'completed', 'not like', 'pending%' }
1713 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1716 status => {'=', ['assigned', 'in-progress']}
1717 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1718 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1720 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1721 operator which adds an additional set of parens, to create a subquery.
1722 For example, to get something like this:
1724 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1725 @bind = ('nwiger', '20', 'ASIA');
1731 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1734 If you need several nested subexpressions, you can number
1735 the C<-nest> branches :
1745 =head2 Special operators : IN, BETWEEN, etc.
1747 You can also use the hashref format to compare a list of fields using the
1748 C<IN> comparison operator, by specifying the list as an arrayref:
1751 status => 'completed',
1752 reportid => { -in => [567, 2335, 2] }
1755 Which would generate:
1757 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1758 @bind = ('completed', '567', '2335', '2');
1760 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1763 Another pair of operators is C<-between> and C<-not_between>,
1764 used with an arrayref of two values:
1768 completion_date => {
1769 -not_between => ['2002-10-01', '2003-02-06']
1775 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1777 These are the two builtin "special operators"; but the
1778 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1780 =head2 Nested conditions
1782 So far, we've seen how multiple conditions are joined with a top-level
1783 C<AND>. We can change this by putting the different conditions we want in
1784 hashes and then putting those hashes in an array. For example:
1789 status => { -like => ['pending%', 'dispatched'] },
1793 status => 'unassigned',
1797 This data structure would create the following:
1799 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1800 OR ( user = ? AND status = ? ) )";
1801 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1803 This can be combined with the C<-nest> operator to properly group
1810 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1811 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1818 WHERE ( user = ? AND
1819 ( ( workhrs > ? AND geo = ? )
1820 OR ( workhrs < ? AND geo = ? ) ) )
1824 Finally, sometimes only literal SQL will do. If you want to include
1825 literal SQL verbatim, you can specify it as a scalar reference, namely:
1827 my $inn = 'is Not Null';
1829 priority => { '<', 2 },
1835 $stmt = "WHERE priority < ? AND requestor is Not Null";
1838 Note that in this example, you only get one bind parameter back, since
1839 the verbatim SQL is passed as part of the statement.
1841 Of course, just to prove a point, the above can also be accomplished
1845 priority => { '<', 2 },
1846 requestor => { '!=', undef },
1852 Conditions on boolean columns can be expressed in the
1853 same way, passing a reference to an empty string :
1856 priority => { '<', 2 },
1862 $stmt = "WHERE priority < ? AND is_ready";
1866 =head2 Literal SQL with placeholders and bind values (subqueries)
1868 If the literal SQL to be inserted has placeholders and bind values,
1869 use a reference to an arrayref (yes this is a double reference --
1870 not so common, but perfectly legal Perl). For example, to find a date
1871 in Postgres you can use something like this:
1874 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1879 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1882 Note that you must pass the bind values in the same format as they are returned
1883 by C</where>. That means that if you set L</bindtype> to C<columns>, you must
1884 provide the bind values in the C<< [ column_name => value ] >> format, so eg.
1885 the above example will look like:
1888 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1891 Literal SQL is especially useful for nesting parenthesized clauses in the
1892 main SQL query. Here is a first example :
1894 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1898 bar => \["IN ($sub_stmt)" => @sub_bind],
1903 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1904 WHERE c2 < ? AND c3 LIKE ?))";
1905 @bind = (1234, 100, "foo%");
1907 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1908 are expressed in the same way. Of course the C<$sub_stmt> and
1909 its associated bind values can be generated through a former call
1912 my ($sub_stmt, @sub_bind)
1913 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1914 c3 => {-like => "foo%"}});
1917 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1920 In the examples above, the subquery was used as an operator on a column;
1921 but the same principle also applies for a clause within the main C<%where>
1922 hash, like an EXISTS subquery :
1924 my ($sub_stmt, @sub_bind)
1925 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1928 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1933 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1934 WHERE c1 = ? AND c2 > t0.c0))";
1938 Observe that the condition on C<c2> in the subquery refers to
1939 column C<t0.c0> of the main query : this is I<not> a bind
1940 value, so we have to express it through a scalar ref.
1941 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1942 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1943 what we wanted here.
1945 Another use of the subquery technique is when some SQL clauses need
1946 parentheses, as it often occurs with some proprietary SQL extensions
1947 like for example fulltext expressions, geospatial expressions,
1948 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1951 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1954 Finally, here is an example where a subquery is used
1955 for expressing unary negation:
1957 my ($sub_stmt, @sub_bind)
1958 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1959 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1961 lname => {like => '%son%'},
1962 -nest => \["NOT ($sub_stmt)" => @sub_bind],
1967 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1968 @bind = ('%son%', 10, 20)
1974 These pages could go on for a while, since the nesting of the data
1975 structures this module can handle are pretty much unlimited (the
1976 module implements the C<WHERE> expansion as a recursive function
1977 internally). Your best bet is to "play around" with the module a
1978 little to see how the data structures behave, and choose the best
1979 format for your data based on that.
1981 And of course, all the values above will probably be replaced with
1982 variables gotten from forms or the command line. After all, if you
1983 knew everything ahead of time, you wouldn't have to worry about
1984 dynamically-generating SQL and could just hardwire it into your
1990 =head1 ORDER BY CLAUSES
1992 Some functions take an order by clause. This can either be a scalar (just a
1993 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1994 or an array of either of the two previous forms. Examples:
1996 Given | Will Generate
1997 ----------------------------------------------------------
1998 \'colA DESC' | ORDER BY colA DESC
1999 'colA' | ORDER BY colA
2000 [qw/colA colB/] | ORDER BY colA, colB
2001 {-asc => 'colA'} | ORDER BY colA ASC
2002 {-desc => 'colB'} | ORDER BY colB DESC
2004 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
2007 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
2008 ==========================================================
2012 =head1 SPECIAL OPERATORS
2014 my $sqlmaker = SQL::Abstract->new(special_ops => [
2017 my ($self, $field, $op, $arg) = @_;
2023 A "special operator" is a SQL syntactic clause that can be
2024 applied to a field, instead of a usual binary operator.
2027 WHERE field IN (?, ?, ?)
2028 WHERE field BETWEEN ? AND ?
2029 WHERE MATCH(field) AGAINST (?, ?)
2031 Special operators IN and BETWEEN are fairly standard and therefore
2032 are builtin within C<SQL::Abstract>. For other operators,
2033 like the MATCH .. AGAINST example above which is
2034 specific to MySQL, you can write your own operator handlers :
2035 supply a C<special_ops> argument to the C<new> method.
2036 That argument takes an arrayref of operator definitions;
2037 each operator definition is a hashref with two entries
2043 the regular expression to match the operator
2047 coderef that will be called when meeting that operator
2048 in the input tree. The coderef will be called with
2049 arguments C<< ($self, $field, $op, $arg) >>, and
2050 should return a C<< ($sql, @bind) >> structure.
2054 For example, here is an implementation
2055 of the MATCH .. AGAINST syntax for MySQL
2057 my $sqlmaker = SQL::Abstract->new(special_ops => [
2059 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2060 {regex => qr/^match$/i,
2062 my ($self, $field, $op, $arg) = @_;
2063 $arg = [$arg] if not ref $arg;
2064 my $label = $self->_quote($field);
2065 my ($placeholder) = $self->_convert('?');
2066 my $placeholders = join ", ", (($placeholder) x @$arg);
2067 my $sql = $self->_sqlcase('match') . " ($label) "
2068 . $self->_sqlcase('against') . " ($placeholders) ";
2069 my @bind = $self->_bindtype($field, @$arg);
2070 return ($sql, @bind);
2079 Thanks to some benchmarking by Mark Stosberg, it turns out that
2080 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2081 I must admit this wasn't an intentional design issue, but it's a
2082 byproduct of the fact that you get to control your C<DBI> handles
2085 To maximize performance, use a code snippet like the following:
2087 # prepare a statement handle using the first row
2088 # and then reuse it for the rest of the rows
2090 for my $href (@array_of_hashrefs) {
2091 $stmt ||= $sql->insert('table', $href);
2092 $sth ||= $dbh->prepare($stmt);
2093 $sth->execute($sql->values($href));
2096 The reason this works is because the keys in your C<$href> are sorted
2097 internally by B<SQL::Abstract>. Thus, as long as your data retains
2098 the same structure, you only have to generate the SQL the first time
2099 around. On subsequent queries, simply use the C<values> function provided
2100 by this module to return your values in the correct order.
2105 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2106 really like this part (I do, at least). Building up a complex query
2107 can be as simple as the following:
2111 use CGI::FormBuilder;
2114 my $form = CGI::FormBuilder->new(...);
2115 my $sql = SQL::Abstract->new;
2117 if ($form->submitted) {
2118 my $field = $form->field;
2119 my $id = delete $field->{id};
2120 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2123 Of course, you would still have to connect using C<DBI> to run the
2124 query, but the point is that if you make your form look like your
2125 table, the actual query script can be extremely simplistic.
2127 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2128 a fast interface to returning and formatting data. I frequently
2129 use these three modules together to write complex database query
2130 apps in under 50 lines.
2135 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2136 Great care has been taken to preserve the I<published> behavior
2137 documented in previous versions in the 1.* family; however,
2138 some features that were previously undocumented, or behaved
2139 differently from the documentation, had to be changed in order
2140 to clarify the semantics. Hence, client code that was relying
2141 on some dark areas of C<SQL::Abstract> v1.*
2142 B<might behave differently> in v1.50.
2144 The main changes are :
2150 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2154 support for the { operator => \"..." } construct (to embed literal SQL)
2158 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2162 added -nest1, -nest2 or -nest_1, -nest_2, ...
2166 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2170 defensive programming : check arguments
2174 fixed bug with global logic, which was previously implemented
2175 through global variables yielding side-effects. Prior versons would
2176 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2177 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2178 Now this is interpreted
2179 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2183 C<-and> / C<-or> operators are no longer accepted
2184 in the middle of an arrayref : they are
2185 only admitted if in first position.
2189 changed logic for distributing an op over arrayrefs
2193 fixed semantics of _bindtype on array args
2197 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2198 we just avoid shifting arrays within that tree.
2202 dropped the C<_modlogic> function
2208 =head1 ACKNOWLEDGEMENTS
2210 There are a number of individuals that have really helped out with
2211 this module. Unfortunately, most of them submitted bugs via CPAN
2212 so I have no idea who they are! But the people I do know are:
2214 Ash Berlin (order_by hash term support)
2215 Matt Trout (DBIx::Class support)
2216 Mark Stosberg (benchmarking)
2217 Chas Owens (initial "IN" operator support)
2218 Philip Collins (per-field SQL functions)
2219 Eric Kolve (hashref "AND" support)
2220 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2221 Dan Kubb (support for "quote_char" and "name_sep")
2222 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2223 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2224 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2230 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2234 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2236 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2238 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2239 While not an official support venue, C<DBIx::Class> makes heavy use of
2240 C<SQL::Abstract>, and as such list members there are very familiar with
2241 how to create queries.
2243 This module is free software; you may copy this under the terms of
2244 the GNU General Public License, or the Artistic License, copies of
2245 which should have accompanied your Perl kit.