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.51';
20 # This would confuse some packagers
21 #$VERSION = eval $VERSION; # numify for warning-free dev releases
25 # special operators (-in, -between). May be extended/overridden by user.
26 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
27 my @BUILTIN_SPECIAL_OPS = (
28 {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
29 {regex => qr/^(not )?in$/i, handler => \&_where_field_IN},
32 #======================================================================
33 # DEBUGGING AND ERROR REPORTING
34 #======================================================================
37 return unless $_[0]->{debug}; shift; # a little faster
38 my $func = (caller(1))[3];
39 warn "[$func] ", @_, "\n";
43 my($func) = (caller(1))[3];
44 carp "[$func] Warning: ", @_;
48 my($func) = (caller(1))[3];
49 croak "[$func] Fatal: ", @_;
53 #======================================================================
55 #======================================================================
59 my $class = ref($self) || $self;
60 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
62 # choose our case by keeping an option around
63 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
65 # default logic for interpreting arrayrefs
66 $opt{logic} = uc $opt{logic} || 'OR';
68 # how to return bind vars
69 # LDNOTE: changed nwiger code : why this 'delete' ??
70 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
71 $opt{bindtype} ||= 'normal';
73 # default comparison is "=", but can be overridden
76 # try to recognize which are the 'equality' and 'unequality' ops
77 # (temporary quickfix, should go through a more seasoned API)
78 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
79 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
82 $opt{sqltrue} ||= '1=1';
83 $opt{sqlfalse} ||= '0=1';
86 $opt{special_ops} ||= [];
87 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
89 return bless \%opt, $class;
94 #======================================================================
96 #======================================================================
100 my $table = $self->_table(shift);
101 my $data = shift || return;
103 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
104 my ($sql, @bind) = $self->$method($data);
105 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
106 return wantarray ? ($sql, @bind) : $sql;
109 sub _insert_HASHREF { # explicit list of fields and then values
110 my ($self, $data) = @_;
112 my @fields = sort keys %$data;
114 my ($sql, @bind) = $self->_insert_values($data);
117 $_ = $self->_quote($_) foreach @fields;
118 $sql = "( ".join(", ", @fields).") ".$sql;
120 return ($sql, @bind);
123 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
124 my ($self, $data) = @_;
126 # no names (arrayref) so can't generate bindtype
127 $self->{bindtype} ne 'columns'
128 or belch "can't do 'columns' bindtype when called with arrayref";
130 # fold the list of values into a hash of column name - value pairs
131 # (where the column names are artificially generated, and their
132 # lexicographical ordering keep the ordering of the original list)
133 my $i = "a"; # incremented values will be in lexicographical order
134 my $data_in_hash = { map { ($i++ => $_) } @$data };
136 return $self->_insert_values($data_in_hash);
139 sub _insert_ARRAYREFREF { # literal SQL with bind
140 my ($self, $data) = @_;
142 my ($sql, @bind) = @${$data};
143 $self->_assert_bindval_matches_bindtype(@bind);
145 return ($sql, @bind);
149 sub _insert_SCALARREF { # literal SQL without bind
150 my ($self, $data) = @_;
156 my ($self, $data) = @_;
158 my (@values, @all_bind);
159 foreach my $column (sort keys %$data) {
160 my $v = $data->{$column};
162 $self->_SWITCH_refkind($v, {
165 if ($self->{array_datatypes}) { # if array datatype are activated
167 push @all_bind, $self->_bindtype($column, $v);
169 else { # else literal SQL with bind
170 my ($sql, @bind) = @$v;
171 $self->_assert_bindval_matches_bindtype(@bind);
173 push @all_bind, @bind;
177 ARRAYREFREF => sub { # literal SQL with bind
178 my ($sql, @bind) = @${$v};
179 $self->_assert_bindval_matches_bindtype(@bind);
181 push @all_bind, @bind;
184 # THINK : anything useful to do with a HASHREF ?
185 HASHREF => sub { # (nothing, but old SQLA passed it through)
186 #TODO in SQLA >= 2.0 it will die instead
187 belch "HASH ref as bind value in insert is not supported";
189 push @all_bind, $self->_bindtype($column, $v);
192 SCALARREF => sub { # literal SQL without bind
196 SCALAR_or_UNDEF => sub {
198 push @all_bind, $self->_bindtype($column, $v);
205 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
206 return ($sql, @all_bind);
211 #======================================================================
213 #======================================================================
218 my $table = $self->_table(shift);
219 my $data = shift || return;
222 # first build the 'SET' part of the sql statement
223 my (@set, @all_bind);
224 puke "Unsupported data type specified to \$sql->update"
225 unless ref $data eq 'HASH';
227 for my $k (sort keys %$data) {
230 my $label = $self->_quote($k);
232 $self->_SWITCH_refkind($v, {
234 if ($self->{array_datatypes}) { # array datatype
235 push @set, "$label = ?";
236 push @all_bind, $self->_bindtype($k, $v);
238 else { # literal SQL with bind
239 my ($sql, @bind) = @$v;
240 $self->_assert_bindval_matches_bindtype(@bind);
241 push @set, "$label = $sql";
242 push @all_bind, @bind;
245 ARRAYREFREF => sub { # literal SQL with bind
246 my ($sql, @bind) = @${$v};
247 $self->_assert_bindval_matches_bindtype(@bind);
248 push @set, "$label = $sql";
249 push @all_bind, @bind;
251 SCALARREF => sub { # literal SQL without bind
252 push @set, "$label = $$v";
254 SCALAR_or_UNDEF => sub {
255 push @set, "$label = ?";
256 push @all_bind, $self->_bindtype($k, $v);
262 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
266 my($where_sql, @where_bind) = $self->where($where);
268 push @all_bind, @where_bind;
271 return wantarray ? ($sql, @all_bind) : $sql;
277 #======================================================================
279 #======================================================================
284 my $table = $self->_table(shift);
285 my $fields = shift || '*';
289 my($where_sql, @bind) = $self->where($where, $order);
291 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
293 my $sql = join(' ', $self->_sqlcase('select'), $f,
294 $self->_sqlcase('from'), $table)
297 return wantarray ? ($sql, @bind) : $sql;
300 #======================================================================
302 #======================================================================
307 my $table = $self->_table(shift);
311 my($where_sql, @bind) = $self->where($where);
312 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
314 return wantarray ? ($sql, @bind) : $sql;
318 #======================================================================
320 #======================================================================
324 # Finally, a separate routine just to handle WHERE clauses
326 my ($self, $where, $order) = @_;
329 my ($sql, @bind) = $self->_recurse_where($where);
330 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
334 $sql .= $self->_order_by($order);
337 return wantarray ? ($sql, @bind) : $sql;
342 my ($self, $where, $logic) = @_;
344 # dispatch on appropriate method according to refkind of $where
345 my $method = $self->_METHOD_FOR_refkind("_where", $where);
348 my ($sql, @bind) = $self->$method($where, $logic);
350 # DBIx::Class directly calls _recurse_where in scalar context, so
351 # we must implement it, even if not in the official API
352 return wantarray ? ($sql, @bind) : $sql;
357 #======================================================================
358 # WHERE: top-level ARRAYREF
359 #======================================================================
362 sub _where_ARRAYREF {
363 my ($self, $where, $logic) = @_;
365 $logic = uc($logic || $self->{logic});
366 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
368 my @clauses = @$where;
370 my (@sql_clauses, @all_bind);
371 # need to use while() so can shift() for pairs
372 while (my $el = shift @clauses) {
374 # switch according to kind of $el and get corresponding ($sql, @bind)
375 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
377 # skip empty elements, otherwise get invalid trailing AND stuff
378 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
380 ARRAYREFREF => sub { @{${$el}} if @{${$el}}},
382 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
383 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
384 # side-effect: the first hashref within an array would change
385 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
386 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
387 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
389 SCALARREF => sub { ($$el); },
391 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
392 $self->_recurse_where({$el => shift(@clauses)})},
394 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
398 push @sql_clauses, $sql;
399 push @all_bind, @bind;
403 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
406 #======================================================================
407 # WHERE: top-level ARRAYREFREF
408 #======================================================================
410 sub _where_ARRAYREFREF {
411 my ($self, $where) = @_;
412 my ($sql, @bind) = @{${$where}};
414 return ($sql, @bind);
417 #======================================================================
418 # WHERE: top-level HASHREF
419 #======================================================================
422 my ($self, $where) = @_;
423 my (@sql_clauses, @all_bind);
425 # LDNOTE : don't really know why we need to sort keys
426 for my $k (sort keys %$where) {
427 my $v = $where->{$k};
429 # ($k => $v) is either a special op or a regular hashpair
430 my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
432 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
433 $self->$method($k, $v);
436 push @sql_clauses, $sql;
437 push @all_bind, @bind;
440 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
444 sub _where_op_in_hash {
445 my ($self, $op_str, $v) = @_;
447 $op_str =~ /^ (AND|OR|NEST) ( \_? \d* ) $/xi
448 or puke "unknown operator: -$op_str";
450 my $op = uc($1); # uppercase, remove trailing digits
452 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
453 . "You probably wanted ...-and => [ $op_str => COND1, $op_str => COND2 ... ]";
456 $self->_debug("OP(-$op) within hashref, recursing...");
458 $self->_SWITCH_refkind($v, {
461 return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
466 return $self->_where_ARRAYREF([%$v], 'OR');
469 return $self->_where_HASHREF($v);
473 SCALARREF => sub { # literal SQL
475 or puke "-$op => \\\$scalar not supported, use -nest => ...";
479 ARRAYREFREF => sub { # literal SQL
481 or puke "-$op => \\[..] not supported, use -nest => ...";
485 SCALAR => sub { # permissively interpreted as SQL
487 or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
488 belch "literal SQL should be -nest => \\'scalar' "
489 . "instead of -nest => 'scalar' ";
494 puke "-$op => undef not supported";
500 sub _where_hashpair_ARRAYREF {
501 my ($self, $k, $v) = @_;
504 my @v = @$v; # need copy because of shift below
505 $self->_debug("ARRAY($k) means distribute over elements");
507 # put apart first element if it is an operator (-and, -or)
508 my $op = ($v[0] =~ /^ - (?: AND|OR ) $/ix
512 my @distributed = map { {$k => $_} } @v;
515 $self->_debug("OP($op) reinjected into the distributed array");
516 unshift @distributed, $op;
519 my $logic = $op ? substr($op, 1) : '';
521 return $self->_recurse_where(\@distributed, $logic);
524 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
525 $self->_debug("empty ARRAY($k) means 0=1");
526 return ($self->{sqlfalse});
530 sub _where_hashpair_HASHREF {
531 my ($self, $k, $v, $logic) = @_;
534 my ($all_sql, @all_bind);
536 for my $op (sort keys %$v) {
539 # put the operator in canonical form
540 $op =~ s/^-//; # remove initial dash
541 $op =~ tr/_/ /; # underscores become spaces
542 $op =~ s/^\s+//; # no initial space
543 $op =~ s/\s+$//; # no final space
544 $op =~ s/\s+/ /; # multiple spaces become one
548 # CASE: special operators like -in or -between
549 my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
551 ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
554 $self->_SWITCH_refkind($val, {
556 ARRAYREF => sub { # CASE: col => {op => \@vals}
557 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
560 SCALARREF => sub { # CASE: col => {op => \$scalar} (literal SQL without bind)
561 $sql = join ' ', $self->_convert($self->_quote($k)),
562 $self->_sqlcase($op),
566 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
567 my ($sub_sql, @sub_bind) = @$$val;
568 $self->_assert_bindval_matches_bindtype(@sub_bind);
569 $sql = join ' ', $self->_convert($self->_quote($k)),
570 $self->_sqlcase($op),
576 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $op);
579 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
580 my $is = ($op =~ $self->{equality_op}) ? 'is' :
581 ($op =~ $self->{inequality_op}) ? 'is not' :
582 puke "unexpected operator '$op' with undef operand";
583 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
586 FALLBACK => sub { # CASE: col => {op => $scalar}
587 $sql = join ' ', $self->_convert($self->_quote($k)),
588 $self->_sqlcase($op),
589 $self->_convert('?');
590 @bind = $self->_bindtype($k, $val);
595 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
596 push @all_bind, @bind;
598 return ($all_sql, @all_bind);
603 sub _where_field_op_ARRAYREF {
604 my ($self, $k, $op, $vals) = @_;
607 $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
609 # see if the first element is an -and/-or op
611 if ($vals->[0] =~ /^ - ( AND|OR ) $/ix) {
616 # distribute $op over each remaining member of @$vals, append logic if exists
617 return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
619 # LDNOTE : had planned to change the distribution logic when
620 # $op =~ $self->{inequality_op}, because of Morgan laws :
621 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
622 # WHERE field != 22 OR field != 33 : the user probably means
623 # WHERE field != 22 AND field != 33.
624 # To do this, replace the above to roughly :
625 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
626 # return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
630 # try to DWIM on equality operators
631 # LDNOTE : not 100% sure this is the correct thing to do ...
632 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
633 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
636 puke "operator '$op' applied on an empty array (field '$k')";
641 sub _where_hashpair_SCALARREF {
642 my ($self, $k, $v) = @_;
643 $self->_debug("SCALAR($k) means literal SQL: $$v");
644 my $sql = $self->_quote($k) . " " . $$v;
648 # literal SQL with bind
649 sub _where_hashpair_ARRAYREFREF {
650 my ($self, $k, $v) = @_;
651 $self->_debug("REF($k) means literal SQL: @${$v}");
652 my ($sql, @bind) = @${$v};
653 $self->_assert_bindval_matches_bindtype(@bind);
654 $sql = $self->_quote($k) . " " . $sql;
655 return ($sql, @bind );
658 # literal SQL without bind
659 sub _where_hashpair_SCALAR {
660 my ($self, $k, $v) = @_;
661 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
662 my $sql = join ' ', $self->_convert($self->_quote($k)),
663 $self->_sqlcase($self->{cmp}),
664 $self->_convert('?');
665 my @bind = $self->_bindtype($k, $v);
666 return ( $sql, @bind);
670 sub _where_hashpair_UNDEF {
671 my ($self, $k, $v) = @_;
672 $self->_debug("UNDEF($k) means IS NULL");
673 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
677 #======================================================================
678 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
679 #======================================================================
682 sub _where_SCALARREF {
683 my ($self, $where) = @_;
686 $self->_debug("SCALAR(*top) means literal SQL: $$where");
692 my ($self, $where) = @_;
695 $self->_debug("NOREF(*top) means literal SQL: $where");
706 #======================================================================
707 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
708 #======================================================================
711 sub _where_field_BETWEEN {
712 my ($self, $k, $op, $vals) = @_;
714 ref $vals eq 'ARRAY' && @$vals == 2
715 or puke "special op 'between' requires an arrayref of two values";
717 my ($label) = $self->_convert($self->_quote($k));
718 my ($placeholder) = $self->_convert('?');
719 my $and = $self->_sqlcase('and');
720 $op = $self->_sqlcase($op);
722 my $sql = "( $label $op $placeholder $and $placeholder )";
723 my @bind = $self->_bindtype($k, @$vals);
728 sub _where_field_IN {
729 my ($self, $k, $op, $vals) = @_;
731 # backwards compatibility : if scalar, force into an arrayref
732 $vals = [$vals] if defined $vals && ! ref $vals;
734 my ($label) = $self->_convert($self->_quote($k));
735 my ($placeholder) = $self->_convert('?');
736 $op = $self->_sqlcase($op);
738 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
739 ARRAYREF => sub { # list of choices
740 if (@$vals) { # nonempty list
741 my $placeholders = join ", ", (($placeholder) x @$vals);
742 my $sql = "$label $op ( $placeholders )";
743 my @bind = $self->_bindtype($k, @$vals);
745 return ($sql, @bind);
747 else { # empty list : some databases won't understand "IN ()", so DWIM
748 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
753 ARRAYREFREF => sub { # literal SQL with bind
754 my ($sql, @bind) = @$$vals;
755 $self->_assert_bindval_matches_bindtype(@bind);
756 return ("$label $op ( $sql )", @bind);
760 puke "special op 'in' requires an arrayref (or arrayref-ref)";
764 return ($sql, @bind);
772 #======================================================================
774 #======================================================================
777 my ($self, $arg) = @_;
779 # construct list of ordering instructions
780 my @order = $self->_SWITCH_refkind($arg, {
783 map {$self->_SWITCH_refkind($_, {
784 SCALAR => sub {$self->_quote($_)},
786 SCALARREF => sub {$$_}, # literal SQL, no quoting
787 HASHREF => sub {$self->_order_by_hash($_)}
791 SCALAR => sub {$self->_quote($arg)},
793 SCALARREF => sub {$$arg}, # literal SQL, no quoting
794 HASHREF => sub {$self->_order_by_hash($arg)},
799 my $order = join ', ', @order;
800 return $order ? $self->_sqlcase(' order by')." $order" : '';
805 my ($self, $hash) = @_;
807 # get first pair in hash
808 my ($key, $val) = each %$hash;
810 # check if one pair was found and no other pair in hash
811 $key && !(each %$hash)
812 or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
814 my ($order) = ($key =~ /^-(desc|asc)/i)
815 or puke "invalid key in _order_by hash : $key";
817 return $self->_quote($val) ." ". $self->_sqlcase($order);
822 #======================================================================
823 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
824 #======================================================================
829 $self->_SWITCH_refkind($from, {
830 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
831 SCALAR => sub {$self->_quote($from)},
832 SCALARREF => sub {$$from},
833 ARRAYREFREF => sub {join ', ', @$from;},
838 #======================================================================
840 #======================================================================
846 $label or puke "can't quote an empty label";
848 # left and right quote characters
849 my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
850 SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
851 ARRAYREF => sub {@{$self->{quote_char}}},
855 or puke "quote_char must be an arrayref of 2 values";
857 # no quoting if no quoting chars
858 $ql or return $label;
860 # no quoting for literal SQL
861 return $$label if ref($label) eq 'SCALAR';
863 # separate table / column (if applicable)
864 my $sep = $self->{name_sep} || '';
865 my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
867 # do the quoting, except for "*" or for `table`.*
868 my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
870 # reassemble and return.
871 return join $sep, @quoted;
875 # Conversion, if applicable
877 my ($self, $arg) = @_;
879 # LDNOTE : modified the previous implementation below because
880 # it was not consistent : the first "return" is always an array,
881 # the second "return" is context-dependent. Anyway, _convert
882 # seems always used with just a single argument, so make it a
884 # return @_ unless $self->{convert};
885 # my $conv = $self->_sqlcase($self->{convert});
886 # my @ret = map { $conv.'('.$_.')' } @_;
887 # return wantarray ? @ret : $ret[0];
888 if ($self->{convert}) {
889 my $conv = $self->_sqlcase($self->{convert});
890 $arg = $conv.'('.$arg.')';
898 my($col, @vals) = @_;
900 #LDNOTE : changed original implementation below because it did not make
901 # sense when bindtype eq 'columns' and @vals > 1.
902 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
904 return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
907 # Dies if any element of @bind is not in [colname => value] format
908 # if bindtype is 'columns'.
909 sub _assert_bindval_matches_bindtype {
910 my ($self, @bind) = @_;
912 if ($self->{bindtype} eq 'columns') {
913 foreach my $val (@bind) {
914 if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
915 die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
921 sub _join_sql_clauses {
922 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
924 if (@$clauses_aref > 1) {
925 my $join = " " . $self->_sqlcase($logic) . " ";
926 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
927 return ($sql, @$bind_aref);
929 elsif (@$clauses_aref) {
930 return ($clauses_aref->[0], @$bind_aref); # no parentheses
933 return (); # if no SQL, ignore @$bind_aref
938 # Fix SQL case, if so requested
942 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
943 # don't touch the argument ... crooked logic, but let's not change it!
944 return $self->{case} ? $_[0] : uc($_[0]);
948 #======================================================================
949 # DISPATCHING FROM REFKIND
950 #======================================================================
953 my ($self, $data) = @_;
959 # blessed objects are treated like scalars
960 $ref = (blessed $data) ? '' : ref $data;
961 $n_steps += 1 if $ref;
962 last if $ref ne 'REF';
966 my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
968 return $base . ('REF' x $n_steps);
974 my ($self, $data) = @_;
975 my @try = ($self->_refkind($data));
976 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
977 push @try, 'FALLBACK';
981 sub _METHOD_FOR_refkind {
982 my ($self, $meth_prefix, $data) = @_;
983 my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
984 $self->_try_refkind($data)
985 or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
990 sub _SWITCH_refkind {
991 my ($self, $data, $dispatch_table) = @_;
993 my $coderef = first {$_} map {$dispatch_table->{$_}}
994 $self->_try_refkind($data)
995 or puke "no dispatch entry for ".$self->_refkind($data);
1002 #======================================================================
1003 # VALUES, GENERATE, AUTOLOAD
1004 #======================================================================
1006 # LDNOTE: original code from nwiger, didn't touch code in that section
1007 # I feel the AUTOLOAD stuff should not be the default, it should
1008 # only be activated on explicit demand by user.
1012 my $data = shift || return;
1013 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1014 unless ref $data eq 'HASH';
1017 foreach my $k ( sort keys %$data ) {
1018 my $v = $data->{$k};
1019 $self->_SWITCH_refkind($v, {
1021 if ($self->{array_datatypes}) { # array datatype
1022 push @all_bind, $self->_bindtype($k, $v);
1024 else { # literal SQL with bind
1025 my ($sql, @bind) = @$v;
1026 $self->_assert_bindval_matches_bindtype(@bind);
1027 push @all_bind, @bind;
1030 ARRAYREFREF => sub { # literal SQL with bind
1031 my ($sql, @bind) = @${$v};
1032 $self->_assert_bindval_matches_bindtype(@bind);
1033 push @all_bind, @bind;
1035 SCALARREF => sub { # literal SQL without bind
1037 SCALAR_or_UNDEF => sub {
1038 push @all_bind, $self->_bindtype($k, $v);
1049 my(@sql, @sqlq, @sqlv);
1053 if ($ref eq 'HASH') {
1054 for my $k (sort keys %$_) {
1057 my $label = $self->_quote($k);
1058 if ($r eq 'ARRAY') {
1059 # literal SQL with bind
1060 my ($sql, @bind) = @$v;
1061 $self->_assert_bindval_matches_bindtype(@bind);
1062 push @sqlq, "$label = $sql";
1064 } elsif ($r eq 'SCALAR') {
1065 # literal SQL without bind
1066 push @sqlq, "$label = $$v";
1068 push @sqlq, "$label = ?";
1069 push @sqlv, $self->_bindtype($k, $v);
1072 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1073 } elsif ($ref eq 'ARRAY') {
1074 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1077 if ($r eq 'ARRAY') { # literal SQL with bind
1078 my ($sql, @bind) = @$v;
1079 $self->_assert_bindval_matches_bindtype(@bind);
1082 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1083 # embedded literal SQL
1090 push @sql, '(' . join(', ', @sqlq) . ')';
1091 } elsif ($ref eq 'SCALAR') {
1095 # strings get case twiddled
1096 push @sql, $self->_sqlcase($_);
1100 my $sql = join ' ', @sql;
1102 # this is pretty tricky
1103 # if ask for an array, return ($stmt, @bind)
1104 # otherwise, s/?/shift @sqlv/ to put it inline
1106 return ($sql, @sqlv);
1108 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1109 ref $d ? $d->[1] : $d/e;
1118 # This allows us to check for a local, then _form, attr
1120 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1121 return $self->generate($name, @_);
1132 SQL::Abstract - Generate SQL from Perl data structures
1138 my $sql = SQL::Abstract->new;
1140 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1142 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1144 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1146 my($stmt, @bind) = $sql->delete($table, \%where);
1148 # Then, use these in your DBI statements
1149 my $sth = $dbh->prepare($stmt);
1150 $sth->execute(@bind);
1152 # Just generate the WHERE clause
1153 my($stmt, @bind) = $sql->where(\%where, \@order);
1155 # Return values in the same order, for hashed queries
1156 # See PERFORMANCE section for more details
1157 my @bind = $sql->values(\%fieldvals);
1161 This module was inspired by the excellent L<DBIx::Abstract>.
1162 However, in using that module I found that what I really wanted
1163 to do was generate SQL, but still retain complete control over my
1164 statement handles and use the DBI interface. So, I set out to
1165 create an abstract SQL generation module.
1167 While based on the concepts used by L<DBIx::Abstract>, there are
1168 several important differences, especially when it comes to WHERE
1169 clauses. I have modified the concepts used to make the SQL easier
1170 to generate from Perl data structures and, IMO, more intuitive.
1171 The underlying idea is for this module to do what you mean, based
1172 on the data structures you provide it. The big advantage is that
1173 you don't have to modify your code every time your data changes,
1174 as this module figures it out.
1176 To begin with, an SQL INSERT is as easy as just specifying a hash
1177 of C<key=value> pairs:
1180 name => 'Jimbo Bobson',
1181 phone => '123-456-7890',
1182 address => '42 Sister Lane',
1183 city => 'St. Louis',
1184 state => 'Louisiana',
1187 The SQL can then be generated with this:
1189 my($stmt, @bind) = $sql->insert('people', \%data);
1191 Which would give you something like this:
1193 $stmt = "INSERT INTO people
1194 (address, city, name, phone, state)
1195 VALUES (?, ?, ?, ?, ?)";
1196 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1197 '123-456-7890', 'Louisiana');
1199 These are then used directly in your DBI code:
1201 my $sth = $dbh->prepare($stmt);
1202 $sth->execute(@bind);
1204 =head2 Inserting and Updating Arrays
1206 If your database has array types (like for example Postgres),
1207 activate the special option C<< array_datatypes => 1 >>
1208 when creating the C<SQL::Abstract> object.
1209 Then you may use an arrayref to insert and update database array types:
1211 my $sql = SQL::Abstract->new(array_datatypes => 1);
1213 planets => [qw/Mercury Venus Earth Mars/]
1216 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1220 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1222 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1225 =head2 Inserting and Updating SQL
1227 In order to apply SQL functions to elements of your C<%data> you may
1228 specify a reference to an arrayref for the given hash value. For example,
1229 if you need to execute the Oracle C<to_date> function on a value, you can
1230 say something like this:
1234 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1237 The first value in the array is the actual SQL. Any other values are
1238 optional and would be included in the bind values array. This gives
1241 my($stmt, @bind) = $sql->insert('people', \%data);
1243 $stmt = "INSERT INTO people (name, date_entered)
1244 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1245 @bind = ('Bill', '03/02/2003');
1247 An UPDATE is just as easy, all you change is the name of the function:
1249 my($stmt, @bind) = $sql->update('people', \%data);
1251 Notice that your C<%data> isn't touched; the module will generate
1252 the appropriately quirky SQL for you automatically. Usually you'll
1253 want to specify a WHERE clause for your UPDATE, though, which is
1254 where handling C<%where> hashes comes in handy...
1256 =head2 Complex where statements
1258 This module can generate pretty complicated WHERE statements
1259 easily. For example, simple C<key=value> pairs are taken to mean
1260 equality, and if you want to see if a field is within a set
1261 of values, you can use an arrayref. Let's say we wanted to
1262 SELECT some data based on this criteria:
1265 requestor => 'inna',
1266 worker => ['nwiger', 'rcwe', 'sfz'],
1267 status => { '!=', 'completed' }
1270 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1272 The above would give you something like this:
1274 $stmt = "SELECT * FROM tickets WHERE
1275 ( requestor = ? ) AND ( status != ? )
1276 AND ( worker = ? OR worker = ? OR worker = ? )";
1277 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1279 Which you could then use in DBI code like so:
1281 my $sth = $dbh->prepare($stmt);
1282 $sth->execute(@bind);
1288 The functions are simple. There's one for each major SQL operation,
1289 and a constructor you use first. The arguments are specified in a
1290 similar order to each function (table, then fields, then a where
1291 clause) to try and simplify things.
1296 =head2 new(option => 'value')
1298 The C<new()> function takes a list of options and values, and returns
1299 a new B<SQL::Abstract> object which can then be used to generate SQL
1300 through the methods below. The options accepted are:
1306 If set to 'lower', then SQL will be generated in all lowercase. By
1307 default SQL is generated in "textbook" case meaning something like:
1309 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1311 Any setting other than 'lower' is ignored.
1315 This determines what the default comparison operator is. By default
1316 it is C<=>, meaning that a hash like this:
1318 %where = (name => 'nwiger', email => 'nate@wiger.org');
1320 Will generate SQL like this:
1322 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1324 However, you may want loose comparisons by default, so if you set
1325 C<cmp> to C<like> you would get SQL such as:
1327 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1329 You can also override the comparsion on an individual basis - see
1330 the huge section on L</"WHERE CLAUSES"> at the bottom.
1332 =item sqltrue, sqlfalse
1334 Expressions for inserting boolean values within SQL statements.
1335 By default these are C<1=1> and C<1=0>. They are used
1336 by the special operators C<-in> and C<-not_in> for generating
1337 correct SQL even when the argument is an empty array (see below).
1341 This determines the default logical operator for multiple WHERE
1342 statements in arrays or hashes. If absent, the default logic is "or"
1343 for arrays, and "and" for hashes. This means that a WHERE
1347 event_date => {'>=', '2/13/99'},
1348 event_date => {'<=', '4/24/03'},
1351 will generate SQL like this:
1353 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1355 This is probably not what you want given this query, though (look
1356 at the dates). To change the "OR" to an "AND", simply specify:
1358 my $sql = SQL::Abstract->new(logic => 'and');
1360 Which will change the above C<WHERE> to:
1362 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1364 The logic can also be changed locally by inserting
1365 a modifier in front of an arrayref :
1367 @where = (-and => [event_date => {'>=', '2/13/99'},
1368 event_date => {'<=', '4/24/03'} ]);
1370 See the L</"WHERE CLAUSES"> section for explanations.
1374 This will automatically convert comparisons using the specified SQL
1375 function for both column and value. This is mostly used with an argument
1376 of C<upper> or C<lower>, so that the SQL will have the effect of
1377 case-insensitive "searches". For example, this:
1379 $sql = SQL::Abstract->new(convert => 'upper');
1380 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1382 Will turn out the following SQL:
1384 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1386 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1387 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1388 not validate this option; it will just pass through what you specify verbatim).
1392 This is a kludge because many databases suck. For example, you can't
1393 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1394 Instead, you have to use C<bind_param()>:
1396 $sth->bind_param(1, 'reg data');
1397 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1399 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1400 which loses track of which field each slot refers to. Fear not.
1402 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1403 Currently, you can specify either C<normal> (default) or C<columns>. If you
1404 specify C<columns>, you will get an array that looks like this:
1406 my $sql = SQL::Abstract->new(bindtype => 'columns');
1407 my($stmt, @bind) = $sql->insert(...);
1410 [ 'column1', 'value1' ],
1411 [ 'column2', 'value2' ],
1412 [ 'column3', 'value3' ],
1415 You can then iterate through this manually, using DBI's C<bind_param()>.
1417 $sth->prepare($stmt);
1420 my($col, $data) = @$_;
1421 if ($col eq 'details' || $col eq 'comments') {
1422 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1423 } elsif ($col eq 'image') {
1424 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1426 $sth->bind_param($i, $data);
1430 $sth->execute; # execute without @bind now
1432 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1433 Basically, the advantage is still that you don't have to care which fields
1434 are or are not included. You could wrap that above C<for> loop in a simple
1435 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1436 get a layer of abstraction over manual SQL specification.
1438 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1439 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1440 will expect the bind values in this format.
1444 This is the character that a table or column name will be quoted
1445 with. By default this is an empty string, but you could set it to
1446 the character C<`>, to generate SQL like this:
1448 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1450 Alternatively, you can supply an array ref of two items, the first being the left
1451 hand quote character, and the second the right hand quote character. For
1452 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1453 that generates SQL like this:
1455 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1457 Quoting is useful if you have tables or columns names that are reserved
1458 words in your database's SQL dialect.
1462 This is the character that separates a table and column name. It is
1463 necessary to specify this when the C<quote_char> option is selected,
1464 so that tables and column names can be individually quoted like this:
1466 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1468 =item array_datatypes
1470 When this option is true, arrayrefs in INSERT or UPDATE are
1471 interpreted as array datatypes and are passed directly
1473 When this option is false, arrayrefs are interpreted
1474 as literal SQL, just like refs to arrayrefs
1475 (but this behavior is for backwards compatibility; when writing
1476 new queries, use the "reference to arrayref" syntax
1482 Takes a reference to a list of "special operators"
1483 to extend the syntax understood by L<SQL::Abstract>.
1484 See section L</"SPECIAL OPERATORS"> for details.
1490 =head2 insert($table, \@values || \%fieldvals)
1492 This is the simplest function. You simply give it a table name
1493 and either an arrayref of values or hashref of field/value pairs.
1494 It returns an SQL INSERT statement and a list of bind values.
1495 See the sections on L</"Inserting and Updating Arrays"> and
1496 L</"Inserting and Updating SQL"> for information on how to insert
1497 with those data types.
1499 =head2 update($table, \%fieldvals, \%where)
1501 This takes a table, hashref of field/value pairs, and an optional
1502 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1504 See the sections on L</"Inserting and Updating Arrays"> and
1505 L</"Inserting and Updating SQL"> for information on how to insert
1506 with those data types.
1508 =head2 select($source, $fields, $where, $order)
1510 This returns a SQL SELECT statement and associated list of bind values, as
1511 specified by the arguments :
1517 Specification of the 'FROM' part of the statement.
1518 The argument can be either a plain scalar (interpreted as a table
1519 name, will be quoted), or an arrayref (interpreted as a list
1520 of table names, joined by commas, quoted), or a scalarref
1521 (literal table name, not quoted), or a ref to an arrayref
1522 (list of literal table names, joined by commas, not quoted).
1526 Specification of the list of fields to retrieve from
1528 The argument can be either an arrayref (interpreted as a list
1529 of field names, will be joined by commas and quoted), or a
1530 plain scalar (literal SQL, not quoted).
1531 Please observe that this API is not as flexible as for
1532 the first argument C<$table>, for backwards compatibility reasons.
1536 Optional argument to specify the WHERE part of the query.
1537 The argument is most often a hashref, but can also be
1538 an arrayref or plain scalar --
1539 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1543 Optional argument to specify the ORDER BY part of the query.
1544 The argument can be a scalar, a hashref or an arrayref
1545 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1551 =head2 delete($table, \%where)
1553 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1554 It returns an SQL DELETE statement and list of bind values.
1556 =head2 where(\%where, \@order)
1558 This is used to generate just the WHERE clause. For example,
1559 if you have an arbitrary data structure and know what the
1560 rest of your SQL is going to look like, but want an easy way
1561 to produce a WHERE clause, use this. It returns an SQL WHERE
1562 clause and list of bind values.
1565 =head2 values(\%data)
1567 This just returns the values from the hash C<%data>, in the same
1568 order that would be returned from any of the other above queries.
1569 Using this allows you to markedly speed up your queries if you
1570 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1572 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1574 Warning: This is an experimental method and subject to change.
1576 This returns arbitrarily generated SQL. It's a really basic shortcut.
1577 It will return two different things, depending on return context:
1579 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1580 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1582 These would return the following:
1584 # First calling form
1585 $stmt = "CREATE TABLE test (?, ?)";
1586 @bind = (field1, field2);
1588 # Second calling form
1589 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1591 Depending on what you're trying to do, it's up to you to choose the correct
1592 format. In this example, the second form is what you would want.
1596 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1600 ALTER SESSION SET nls_date_format = 'MM/YY'
1602 You get the idea. Strings get their case twiddled, but everything
1603 else remains verbatim.
1608 =head1 WHERE CLAUSES
1612 This module uses a variation on the idea from L<DBIx::Abstract>. It
1613 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1614 module is that things in arrays are OR'ed, and things in hashes
1617 The easiest way to explain is to show lots of examples. After
1618 each C<%where> hash shown, it is assumed you used:
1620 my($stmt, @bind) = $sql->where(\%where);
1622 However, note that the C<%where> hash can be used directly in any
1623 of the other functions as well, as described above.
1625 =head2 Key-value pairs
1627 So, let's get started. To begin, a simple hash:
1631 status => 'completed'
1634 Is converted to SQL C<key = val> statements:
1636 $stmt = "WHERE user = ? AND status = ?";
1637 @bind = ('nwiger', 'completed');
1639 One common thing I end up doing is having a list of values that
1640 a field can be in. To do this, simply specify a list inside of
1645 status => ['assigned', 'in-progress', 'pending'];
1648 This simple code will create the following:
1650 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1651 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1653 A field associated to an empty arrayref will be considered a
1654 logical false and will generate 0=1.
1656 =head2 Specific comparison operators
1658 If you want to specify a different type of operator for your comparison,
1659 you can use a hashref for a given column:
1663 status => { '!=', 'completed' }
1666 Which would generate:
1668 $stmt = "WHERE user = ? AND status != ?";
1669 @bind = ('nwiger', 'completed');
1671 To test against multiple values, just enclose the values in an arrayref:
1673 status => { '=', ['assigned', 'in-progress', 'pending'] };
1675 Which would give you:
1677 "WHERE status = ? OR status = ? OR status = ?"
1680 The hashref can also contain multiple pairs, in which case it is expanded
1681 into an C<AND> of its elements:
1685 status => { '!=', 'completed', -not_like => 'pending%' }
1688 # Or more dynamically, like from a form
1689 $where{user} = 'nwiger';
1690 $where{status}{'!='} = 'completed';
1691 $where{status}{'-not_like'} = 'pending%';
1693 # Both generate this
1694 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1695 @bind = ('nwiger', 'completed', 'pending%');
1698 To get an OR instead, you can combine it with the arrayref idea:
1702 priority => [ {'=', 2}, {'!=', 1} ]
1705 Which would generate:
1707 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1708 @bind = ('nwiger', '2', '1');
1710 If you want to include literal SQL (with or without bind values), just use a
1711 scalar reference or array reference as the value:
1714 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1715 date_expires => { '<' => \"now()" }
1718 Which would generate:
1720 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1721 @bind = ('11/26/2008');
1724 =head2 Logic and nesting operators
1726 In the example above,
1727 there is a subtle trap if you want to say something like
1728 this (notice the C<AND>):
1730 WHERE priority != ? AND priority != ?
1732 Because, in Perl you I<can't> do this:
1734 priority => { '!=', 2, '!=', 1 }
1736 As the second C<!=> key will obliterate the first. The solution
1737 is to use the special C<-modifier> form inside an arrayref:
1739 priority => [ -and => {'!=', 2},
1743 Normally, these would be joined by C<OR>, but the modifier tells it
1744 to use C<AND> instead. (Hint: You can use this in conjunction with the
1745 C<logic> option to C<new()> in order to change the way your queries
1746 work by default.) B<Important:> Note that the C<-modifier> goes
1747 B<INSIDE> the arrayref, as an extra first element. This will
1748 B<NOT> do what you think it might:
1750 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1752 Here is a quick list of equivalencies, since there is some overlap:
1755 status => {'!=', 'completed', 'not like', 'pending%' }
1756 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1759 status => {'=', ['assigned', 'in-progress']}
1760 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1761 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1765 =head2 Special operators : IN, BETWEEN, etc.
1767 You can also use the hashref format to compare a list of fields using the
1768 C<IN> comparison operator, by specifying the list as an arrayref:
1771 status => 'completed',
1772 reportid => { -in => [567, 2335, 2] }
1775 Which would generate:
1777 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1778 @bind = ('completed', '567', '2335', '2');
1780 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1783 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1784 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1785 'sqltrue' (by default : C<1=1>).
1789 Another pair of operators is C<-between> and C<-not_between>,
1790 used with an arrayref of two values:
1794 completion_date => {
1795 -not_between => ['2002-10-01', '2003-02-06']
1801 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1803 These are the two builtin "special operators"; but the
1804 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1806 =head2 Nested conditions, -and/-or prefixes
1808 So far, we've seen how multiple conditions are joined with a top-level
1809 C<AND>. We can change this by putting the different conditions we want in
1810 hashes and then putting those hashes in an array. For example:
1815 status => { -like => ['pending%', 'dispatched'] },
1819 status => 'unassigned',
1823 This data structure would create the following:
1825 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1826 OR ( user = ? AND status = ? ) )";
1827 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1830 There is also a special C<-nest>
1831 operator which adds an additional set of parens, to create a subquery.
1832 For example, to get something like this:
1834 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1835 @bind = ('nwiger', '20', 'ASIA');
1841 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1845 Finally, clauses in hashrefs or arrayrefs can be
1846 prefixed with an C<-and> or C<-or> to change the logic
1853 -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
1854 -and => [workhrs => {'<', 50}, geo => 'EURO' ]
1861 WHERE ( user = ? AND
1862 ( ( workhrs > ? AND geo = ? )
1863 OR ( workhrs < ? AND geo = ? ) ) )
1866 =head2 Algebraic inconsistency, for historical reasons
1868 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
1869 operator goes C<outside> of the nested structure; whereas when connecting
1870 several constraints on one column, the C<-and> operator goes
1871 C<inside> the arrayref. Here is an example combining both features :
1874 -and => [a => 1, b => 2],
1875 -or => [c => 3, d => 4],
1876 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
1881 WHERE ( ( ( a = ? AND b = ? )
1882 OR ( c = ? OR d = ? )
1883 OR ( e LIKE ? AND e LIKE ? ) ) )
1885 This difference in syntax is unfortunate but must be preserved for
1886 historical reasons. So be careful : the two examples below would
1887 seem algebraically equivalent, but they are not
1889 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
1890 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
1892 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
1893 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
1898 Finally, sometimes only literal SQL will do. If you want to include
1899 literal SQL verbatim, you can specify it as a scalar reference, namely:
1901 my $inn = 'is Not Null';
1903 priority => { '<', 2 },
1909 $stmt = "WHERE priority < ? AND requestor is Not Null";
1912 Note that in this example, you only get one bind parameter back, since
1913 the verbatim SQL is passed as part of the statement.
1915 Of course, just to prove a point, the above can also be accomplished
1919 priority => { '<', 2 },
1920 requestor => { '!=', undef },
1926 Conditions on boolean columns can be expressed in the
1927 same way, passing a reference to an empty string :
1930 priority => { '<', 2 },
1936 $stmt = "WHERE priority < ? AND is_ready";
1940 =head2 Literal SQL with placeholders and bind values (subqueries)
1942 If the literal SQL to be inserted has placeholders and bind values,
1943 use a reference to an arrayref (yes this is a double reference --
1944 not so common, but perfectly legal Perl). For example, to find a date
1945 in Postgres you can use something like this:
1948 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1953 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1956 Note that you must pass the bind values in the same format as they are returned
1957 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
1958 provide the bind values in the C<< [ column_meta => value ] >> format, where
1959 C<column_meta> is an opaque scalar value; most commonly the column name, but
1960 you can use any scalar value (including references and blessed references),
1961 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
1962 to C<columns> the above example will look like:
1965 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1968 Literal SQL is especially useful for nesting parenthesized clauses in the
1969 main SQL query. Here is a first example :
1971 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1975 bar => \["IN ($sub_stmt)" => @sub_bind],
1980 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1981 WHERE c2 < ? AND c3 LIKE ?))";
1982 @bind = (1234, 100, "foo%");
1984 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1985 are expressed in the same way. Of course the C<$sub_stmt> and
1986 its associated bind values can be generated through a former call
1989 my ($sub_stmt, @sub_bind)
1990 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1991 c3 => {-like => "foo%"}});
1994 bar => \["> ALL ($sub_stmt)" => @sub_bind],
1997 In the examples above, the subquery was used as an operator on a column;
1998 but the same principle also applies for a clause within the main C<%where>
1999 hash, like an EXISTS subquery :
2001 my ($sub_stmt, @sub_bind)
2002 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2005 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
2010 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2011 WHERE c1 = ? AND c2 > t0.c0))";
2015 Observe that the condition on C<c2> in the subquery refers to
2016 column C<t0.c0> of the main query : this is I<not> a bind
2017 value, so we have to express it through a scalar ref.
2018 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2019 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2020 what we wanted here.
2022 Another use of the subquery technique is when some SQL clauses need
2023 parentheses, as it often occurs with some proprietary SQL extensions
2024 like for example fulltext expressions, geospatial expressions,
2025 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
2028 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
2031 Finally, here is an example where a subquery is used
2032 for expressing unary negation:
2034 my ($sub_stmt, @sub_bind)
2035 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2036 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2038 lname => {like => '%son%'},
2039 -nest => \["NOT ($sub_stmt)" => @sub_bind],
2044 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2045 @bind = ('%son%', 10, 20)
2051 These pages could go on for a while, since the nesting of the data
2052 structures this module can handle are pretty much unlimited (the
2053 module implements the C<WHERE> expansion as a recursive function
2054 internally). Your best bet is to "play around" with the module a
2055 little to see how the data structures behave, and choose the best
2056 format for your data based on that.
2058 And of course, all the values above will probably be replaced with
2059 variables gotten from forms or the command line. After all, if you
2060 knew everything ahead of time, you wouldn't have to worry about
2061 dynamically-generating SQL and could just hardwire it into your
2067 =head1 ORDER BY CLAUSES
2069 Some functions take an order by clause. This can either be a scalar (just a
2070 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2071 or an array of either of the two previous forms. Examples:
2073 Given | Will Generate
2074 ----------------------------------------------------------
2075 \'colA DESC' | ORDER BY colA DESC
2076 'colA' | ORDER BY colA
2077 [qw/colA colB/] | ORDER BY colA, colB
2078 {-asc => 'colA'} | ORDER BY colA ASC
2079 {-desc => 'colB'} | ORDER BY colB DESC
2081 {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
2084 [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
2085 ==========================================================
2089 =head1 SPECIAL OPERATORS
2091 my $sqlmaker = SQL::Abstract->new(special_ops => [
2094 my ($self, $field, $op, $arg) = @_;
2100 A "special operator" is a SQL syntactic clause that can be
2101 applied to a field, instead of a usual binary operator.
2104 WHERE field IN (?, ?, ?)
2105 WHERE field BETWEEN ? AND ?
2106 WHERE MATCH(field) AGAINST (?, ?)
2108 Special operators IN and BETWEEN are fairly standard and therefore
2109 are builtin within C<SQL::Abstract>. For other operators,
2110 like the MATCH .. AGAINST example above which is
2111 specific to MySQL, you can write your own operator handlers :
2112 supply a C<special_ops> argument to the C<new> method.
2113 That argument takes an arrayref of operator definitions;
2114 each operator definition is a hashref with two entries
2120 the regular expression to match the operator
2124 coderef that will be called when meeting that operator
2125 in the input tree. The coderef will be called with
2126 arguments C<< ($self, $field, $op, $arg) >>, and
2127 should return a C<< ($sql, @bind) >> structure.
2131 For example, here is an implementation
2132 of the MATCH .. AGAINST syntax for MySQL
2134 my $sqlmaker = SQL::Abstract->new(special_ops => [
2136 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2137 {regex => qr/^match$/i,
2139 my ($self, $field, $op, $arg) = @_;
2140 $arg = [$arg] if not ref $arg;
2141 my $label = $self->_quote($field);
2142 my ($placeholder) = $self->_convert('?');
2143 my $placeholders = join ", ", (($placeholder) x @$arg);
2144 my $sql = $self->_sqlcase('match') . " ($label) "
2145 . $self->_sqlcase('against') . " ($placeholders) ";
2146 my @bind = $self->_bindtype($field, @$arg);
2147 return ($sql, @bind);
2156 Thanks to some benchmarking by Mark Stosberg, it turns out that
2157 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2158 I must admit this wasn't an intentional design issue, but it's a
2159 byproduct of the fact that you get to control your C<DBI> handles
2162 To maximize performance, use a code snippet like the following:
2164 # prepare a statement handle using the first row
2165 # and then reuse it for the rest of the rows
2167 for my $href (@array_of_hashrefs) {
2168 $stmt ||= $sql->insert('table', $href);
2169 $sth ||= $dbh->prepare($stmt);
2170 $sth->execute($sql->values($href));
2173 The reason this works is because the keys in your C<$href> are sorted
2174 internally by B<SQL::Abstract>. Thus, as long as your data retains
2175 the same structure, you only have to generate the SQL the first time
2176 around. On subsequent queries, simply use the C<values> function provided
2177 by this module to return your values in the correct order.
2182 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2183 really like this part (I do, at least). Building up a complex query
2184 can be as simple as the following:
2188 use CGI::FormBuilder;
2191 my $form = CGI::FormBuilder->new(...);
2192 my $sql = SQL::Abstract->new;
2194 if ($form->submitted) {
2195 my $field = $form->field;
2196 my $id = delete $field->{id};
2197 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2200 Of course, you would still have to connect using C<DBI> to run the
2201 query, but the point is that if you make your form look like your
2202 table, the actual query script can be extremely simplistic.
2204 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2205 a fast interface to returning and formatting data. I frequently
2206 use these three modules together to write complex database query
2207 apps in under 50 lines.
2212 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2213 Great care has been taken to preserve the I<published> behavior
2214 documented in previous versions in the 1.* family; however,
2215 some features that were previously undocumented, or behaved
2216 differently from the documentation, had to be changed in order
2217 to clarify the semantics. Hence, client code that was relying
2218 on some dark areas of C<SQL::Abstract> v1.*
2219 B<might behave differently> in v1.50.
2221 The main changes are :
2227 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2231 support for the { operator => \"..." } construct (to embed literal SQL)
2235 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2239 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2243 defensive programming : check arguments
2247 fixed bug with global logic, which was previously implemented
2248 through global variables yielding side-effects. Prior versions would
2249 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2250 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2251 Now this is interpreted
2252 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2257 fixed semantics of _bindtype on array args
2261 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2262 we just avoid shifting arrays within that tree.
2266 dropped the C<_modlogic> function
2272 =head1 ACKNOWLEDGEMENTS
2274 There are a number of individuals that have really helped out with
2275 this module. Unfortunately, most of them submitted bugs via CPAN
2276 so I have no idea who they are! But the people I do know are:
2278 Ash Berlin (order_by hash term support)
2279 Matt Trout (DBIx::Class support)
2280 Mark Stosberg (benchmarking)
2281 Chas Owens (initial "IN" operator support)
2282 Philip Collins (per-field SQL functions)
2283 Eric Kolve (hashref "AND" support)
2284 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2285 Dan Kubb (support for "quote_char" and "name_sep")
2286 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2287 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2288 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2294 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2298 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2300 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2302 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2303 While not an official support venue, C<DBIx::Class> makes heavy use of
2304 C<SQL::Abstract>, and as such list members there are very familiar with
2305 how to create queries.
2307 This module is free software; you may copy this under the terms of
2308 the GNU General Public License, or the Artistic License, copies of
2309 which should have accompanied your Perl kit.