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.54';
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 # unaryish operators - key maps to handler
33 my $BUILTIN_UNARY_OPS = {
34 'AND' => '_where_op_ANDOR',
35 'OR' => '_where_op_ANDOR',
36 'NEST' => '_where_op_NEST',
37 'BOOL' => '_where_op_BOOL',
38 'NOT_BOOL' => '_where_op_BOOL',
41 #======================================================================
42 # DEBUGGING AND ERROR REPORTING
43 #======================================================================
46 return unless $_[0]->{debug}; shift; # a little faster
47 my $func = (caller(1))[3];
48 warn "[$func] ", @_, "\n";
52 my($func) = (caller(1))[3];
53 carp "[$func] Warning: ", @_;
57 my($func) = (caller(1))[3];
58 croak "[$func] Fatal: ", @_;
62 #======================================================================
64 #======================================================================
68 my $class = ref($self) || $self;
69 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
71 # choose our case by keeping an option around
72 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
74 # default logic for interpreting arrayrefs
75 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
77 # how to return bind vars
78 # LDNOTE: changed nwiger code : why this 'delete' ??
79 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
80 $opt{bindtype} ||= 'normal';
82 # default comparison is "=", but can be overridden
85 # try to recognize which are the 'equality' and 'unequality' ops
86 # (temporary quickfix, should go through a more seasoned API)
87 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
88 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
91 $opt{sqltrue} ||= '1=1';
92 $opt{sqlfalse} ||= '0=1';
95 $opt{special_ops} ||= [];
96 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
98 return bless \%opt, $class;
103 #======================================================================
105 #======================================================================
109 my $table = $self->_table(shift);
110 my $data = shift || return;
112 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
113 my ($sql, @bind) = $self->$method($data);
114 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
115 return wantarray ? ($sql, @bind) : $sql;
118 sub _insert_HASHREF { # explicit list of fields and then values
119 my ($self, $data) = @_;
121 my @fields = sort keys %$data;
123 my ($sql, @bind) = $self->_insert_values($data);
126 $_ = $self->_quote($_) foreach @fields;
127 $sql = "( ".join(", ", @fields).") ".$sql;
129 return ($sql, @bind);
132 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
133 my ($self, $data) = @_;
135 # no names (arrayref) so can't generate bindtype
136 $self->{bindtype} ne 'columns'
137 or belch "can't do 'columns' bindtype when called with arrayref";
139 # fold the list of values into a hash of column name - value pairs
140 # (where the column names are artificially generated, and their
141 # lexicographical ordering keep the ordering of the original list)
142 my $i = "a"; # incremented values will be in lexicographical order
143 my $data_in_hash = { map { ($i++ => $_) } @$data };
145 return $self->_insert_values($data_in_hash);
148 sub _insert_ARRAYREFREF { # literal SQL with bind
149 my ($self, $data) = @_;
151 my ($sql, @bind) = @${$data};
152 $self->_assert_bindval_matches_bindtype(@bind);
154 return ($sql, @bind);
158 sub _insert_SCALARREF { # literal SQL without bind
159 my ($self, $data) = @_;
165 my ($self, $data) = @_;
167 my (@values, @all_bind);
168 foreach my $column (sort keys %$data) {
169 my $v = $data->{$column};
171 $self->_SWITCH_refkind($v, {
174 if ($self->{array_datatypes}) { # if array datatype are activated
176 push @all_bind, $self->_bindtype($column, $v);
178 else { # else literal SQL with bind
179 my ($sql, @bind) = @$v;
180 $self->_assert_bindval_matches_bindtype(@bind);
182 push @all_bind, @bind;
186 ARRAYREFREF => sub { # literal SQL with bind
187 my ($sql, @bind) = @${$v};
188 $self->_assert_bindval_matches_bindtype(@bind);
190 push @all_bind, @bind;
193 # THINK : anything useful to do with a HASHREF ?
194 HASHREF => sub { # (nothing, but old SQLA passed it through)
195 #TODO in SQLA >= 2.0 it will die instead
196 belch "HASH ref as bind value in insert is not supported";
198 push @all_bind, $self->_bindtype($column, $v);
201 SCALARREF => sub { # literal SQL without bind
205 SCALAR_or_UNDEF => sub {
207 push @all_bind, $self->_bindtype($column, $v);
214 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
215 return ($sql, @all_bind);
220 #======================================================================
222 #======================================================================
227 my $table = $self->_table(shift);
228 my $data = shift || return;
231 # first build the 'SET' part of the sql statement
232 my (@set, @all_bind);
233 puke "Unsupported data type specified to \$sql->update"
234 unless ref $data eq 'HASH';
236 for my $k (sort keys %$data) {
239 my $label = $self->_quote($k);
241 $self->_SWITCH_refkind($v, {
243 if ($self->{array_datatypes}) { # array datatype
244 push @set, "$label = ?";
245 push @all_bind, $self->_bindtype($k, $v);
247 else { # literal SQL with bind
248 my ($sql, @bind) = @$v;
249 $self->_assert_bindval_matches_bindtype(@bind);
250 push @set, "$label = $sql";
251 push @all_bind, @bind;
254 ARRAYREFREF => sub { # literal SQL with bind
255 my ($sql, @bind) = @${$v};
256 $self->_assert_bindval_matches_bindtype(@bind);
257 push @set, "$label = $sql";
258 push @all_bind, @bind;
260 SCALARREF => sub { # literal SQL without bind
261 push @set, "$label = $$v";
263 SCALAR_or_UNDEF => sub {
264 push @set, "$label = ?";
265 push @all_bind, $self->_bindtype($k, $v);
271 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
275 my($where_sql, @where_bind) = $self->where($where);
277 push @all_bind, @where_bind;
280 return wantarray ? ($sql, @all_bind) : $sql;
286 #======================================================================
288 #======================================================================
293 my $table = $self->_table(shift);
294 my $fields = shift || '*';
298 my($where_sql, @bind) = $self->where($where, $order);
300 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
302 my $sql = join(' ', $self->_sqlcase('select'), $f,
303 $self->_sqlcase('from'), $table)
306 return wantarray ? ($sql, @bind) : $sql;
309 #======================================================================
311 #======================================================================
316 my $table = $self->_table(shift);
320 my($where_sql, @bind) = $self->where($where);
321 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
323 return wantarray ? ($sql, @bind) : $sql;
327 #======================================================================
329 #======================================================================
333 # Finally, a separate routine just to handle WHERE clauses
335 my ($self, $where, $order) = @_;
338 my ($sql, @bind) = $self->_recurse_where($where);
339 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
343 $sql .= $self->_order_by($order);
346 return wantarray ? ($sql, @bind) : $sql;
351 my ($self, $where, $logic) = @_;
353 # dispatch on appropriate method according to refkind of $where
354 my $method = $self->_METHOD_FOR_refkind("_where", $where);
357 my ($sql, @bind) = $self->$method($where, $logic);
359 # DBIx::Class directly calls _recurse_where in scalar context, so
360 # we must implement it, even if not in the official API
361 return wantarray ? ($sql, @bind) : $sql;
366 #======================================================================
367 # WHERE: top-level ARRAYREF
368 #======================================================================
371 sub _where_ARRAYREF {
372 my ($self, $where, $logic) = @_;
374 $logic = uc($logic || $self->{logic});
375 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
377 my @clauses = @$where;
379 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 ARRAYREFREF => sub { @{${$el}} if @{${$el}}},
391 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
392 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
393 # side-effect: the first hashref within an array would change
394 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
395 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
396 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
398 SCALARREF => sub { ($$el); },
400 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
401 $self->_recurse_where({$el => shift(@clauses)})},
403 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
407 push @sql_clauses, $sql;
408 push @all_bind, @bind;
412 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
415 #======================================================================
416 # WHERE: top-level ARRAYREFREF
417 #======================================================================
419 sub _where_ARRAYREFREF {
420 my ($self, $where) = @_;
421 my ($sql, @bind) = @{${$where}};
423 return ($sql, @bind);
426 #======================================================================
427 # WHERE: top-level HASHREF
428 #======================================================================
431 my ($self, $where) = @_;
432 my (@sql_clauses, @all_bind);
434 for my $k (sort keys %$where) {
435 my $v = $where->{$k};
437 # ($k => $v) is either a special op or a regular hashpair
438 my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
440 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
441 $self->$method($k, $v);
444 push @sql_clauses, $sql;
445 push @all_bind, @bind;
448 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
452 sub _where_op_in_hash {
453 my ($self, $op_str, $v) = @_;
455 $op_str =~ /^ ([A-Z_]+[A-Z]) ( \_? \d* ) $/xi
456 or puke "unknown or malstructured operator: -$op_str";
458 my $op = uc($1); # uppercase, remove trailing digits
460 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
461 . "You probably wanted ...-and => [ $op_str => COND1, $op_str => COND2 ... ]";
464 $self->_debug("OP(-$op) within hashref, recursing...");
466 my $handler = $BUILTIN_UNARY_OPS->{$op};
468 puke "unknown operator: -$op_str";
470 elsif (not ref $handler) {
471 return $self->$handler ($op, $v);
473 elsif (ref $handler eq 'CODE') {
474 return $handler->($self, $op, $v);
477 puke "Illegal handler for operator $op - expecting a method name or a coderef";
481 sub _where_op_ANDOR {
482 my ($self, $op, $v) = @_;
484 $self->_SWITCH_refkind($v, {
486 return $self->_where_ARRAYREF($v, $op);
490 return ( $op eq 'OR' )
491 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
492 : $self->_where_HASHREF($v);
496 puke "-$op => \\\$scalar not supported, use -nest => ...";
500 puke "-$op => \\[..] not supported, use -nest => ...";
503 SCALAR => sub { # permissively interpreted as SQL
504 puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
508 puke "-$op => undef not supported";
514 my ($self, $op, $v) = @_;
516 $self->_SWITCH_refkind($v, {
519 return $self->_where_ARRAYREF($v, '');
523 return $self->_where_HASHREF($v);
526 SCALARREF => sub { # literal SQL
530 ARRAYREFREF => sub { # literal SQL
534 SCALAR => sub { # permissively interpreted as SQL
535 belch "literal SQL should be -nest => \\'scalar' "
536 . "instead of -nest => 'scalar' ";
541 puke "-$op => undef not supported";
548 my ($self, $op, $v) = @_;
550 my $prefix = $op eq 'BOOL' ? '' : 'NOT ';
551 $self->_SWITCH_refkind($v, {
552 SCALARREF => sub { # literal SQL
553 return ($prefix . $$v);
556 SCALAR => sub { # interpreted as SQL column
557 return ($prefix . $self->_convert($self->_quote($v)));
563 sub _where_hashpair_ARRAYREF {
564 my ($self, $k, $v) = @_;
567 my @v = @$v; # need copy because of shift below
568 $self->_debug("ARRAY($k) means distribute over elements");
570 # put apart first element if it is an operator (-and, -or)
572 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
576 my @distributed = map { {$k => $_} } @v;
579 $self->_debug("OP($op) reinjected into the distributed array");
580 unshift @distributed, $op;
583 my $logic = $op ? substr($op, 1) : '';
585 return $self->_recurse_where(\@distributed, $logic);
588 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
589 $self->_debug("empty ARRAY($k) means 0=1");
590 return ($self->{sqlfalse});
594 sub _where_hashpair_HASHREF {
595 my ($self, $k, $v, $logic) = @_;
598 my ($all_sql, @all_bind);
600 for my $op (sort keys %$v) {
603 # put the operator in canonical form
604 $op =~ s/^-//; # remove initial dash
605 $op =~ tr/_/ /; # underscores become spaces
606 $op =~ s/^\s+//; # no initial space
607 $op =~ s/\s+$//; # no final space
608 $op =~ s/\s+/ /; # multiple spaces become one
612 # CASE: special operators like -in or -between
613 my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
615 my $handler = $special_op->{handler};
617 puke "No handler supplied for special operator matching $special_op->{regex}";
619 elsif (not ref $handler) {
620 ($sql, @bind) = $self->$handler ($k, $op, $val);
622 elsif (ref $handler eq 'CODE') {
623 ($sql, @bind) = $handler->($self, $k, $op, $val);
626 puke "Illegal handler for special operator matching $special_op->{regex} - expecting a method name or a coderef";
630 $self->_SWITCH_refkind($val, {
632 ARRAYREF => sub { # CASE: col => {op => \@vals}
633 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
636 SCALARREF => sub { # CASE: col => {op => \$scalar} (literal SQL without bind)
637 $sql = join ' ', $self->_convert($self->_quote($k)),
638 $self->_sqlcase($op),
642 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
643 my ($sub_sql, @sub_bind) = @$$val;
644 $self->_assert_bindval_matches_bindtype(@sub_bind);
645 $sql = join ' ', $self->_convert($self->_quote($k)),
646 $self->_sqlcase($op),
652 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $op);
655 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
656 my $is = ($op =~ $self->{equality_op}) ? 'is' :
657 ($op =~ $self->{inequality_op}) ? 'is not' :
658 puke "unexpected operator '$op' with undef operand";
659 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
662 FALLBACK => sub { # CASE: col => {op => $scalar}
663 $sql = join ' ', $self->_convert($self->_quote($k)),
664 $self->_sqlcase($op),
665 $self->_convert('?');
666 @bind = $self->_bindtype($k, $val);
671 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
672 push @all_bind, @bind;
674 return ($all_sql, @all_bind);
679 sub _where_field_op_ARRAYREF {
680 my ($self, $k, $op, $vals) = @_;
683 $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
685 # see if the first element is an -and/-or op
687 if ($vals->[0] =~ /^ - ( AND|OR ) $/ix) {
692 # distribute $op over each remaining member of @$vals, append logic if exists
693 return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
695 # LDNOTE : had planned to change the distribution logic when
696 # $op =~ $self->{inequality_op}, because of Morgan laws :
697 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
698 # WHERE field != 22 OR field != 33 : the user probably means
699 # WHERE field != 22 AND field != 33.
700 # To do this, replace the above to roughly :
701 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
702 # return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
706 # try to DWIM on equality operators
707 # LDNOTE : not 100% sure this is the correct thing to do ...
708 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
709 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
712 puke "operator '$op' applied on an empty array (field '$k')";
717 sub _where_hashpair_SCALARREF {
718 my ($self, $k, $v) = @_;
719 $self->_debug("SCALAR($k) means literal SQL: $$v");
720 my $sql = $self->_quote($k) . " " . $$v;
724 # literal SQL with bind
725 sub _where_hashpair_ARRAYREFREF {
726 my ($self, $k, $v) = @_;
727 $self->_debug("REF($k) means literal SQL: @${$v}");
728 my ($sql, @bind) = @${$v};
729 $self->_assert_bindval_matches_bindtype(@bind);
730 $sql = $self->_quote($k) . " " . $sql;
731 return ($sql, @bind );
734 # literal SQL without bind
735 sub _where_hashpair_SCALAR {
736 my ($self, $k, $v) = @_;
737 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
738 my $sql = join ' ', $self->_convert($self->_quote($k)),
739 $self->_sqlcase($self->{cmp}),
740 $self->_convert('?');
741 my @bind = $self->_bindtype($k, $v);
742 return ( $sql, @bind);
746 sub _where_hashpair_UNDEF {
747 my ($self, $k, $v) = @_;
748 $self->_debug("UNDEF($k) means IS NULL");
749 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
753 #======================================================================
754 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
755 #======================================================================
758 sub _where_SCALARREF {
759 my ($self, $where) = @_;
762 $self->_debug("SCALAR(*top) means literal SQL: $$where");
768 my ($self, $where) = @_;
771 $self->_debug("NOREF(*top) means literal SQL: $where");
782 #======================================================================
783 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
784 #======================================================================
787 sub _where_field_BETWEEN {
788 my ($self, $k, $op, $vals) = @_;
790 (ref $vals eq 'ARRAY' && @$vals == 2) or
791 (ref $vals eq 'REF' && (@$$vals == 1 || @$$vals == 2 || @$$vals == 3))
792 or puke "special op 'between' requires an arrayref of two values (or a scalarref or arrayrefref for literal SQL)";
794 my ($clause, @bind, $label, $and, $placeholder);
795 $label = $self->_convert($self->_quote($k));
796 $and = ' ' . $self->_sqlcase('and') . ' ';
797 $placeholder = $self->_convert('?');
798 $op = $self->_sqlcase($op);
800 if (ref $vals eq 'REF') {
801 ($clause, @bind) = @$$vals;
804 my (@all_sql, @all_bind);
806 foreach my $val (@$vals) {
807 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
809 return ($placeholder, ($val));
812 return ($self->_convert($$val), ());
816 push @all_bind, @bind;
819 $clause = (join $and, @all_sql);
820 @bind = $self->_bindtype($k, @all_bind);
822 my $sql = "( $label $op $clause )";
827 sub _where_field_IN {
828 my ($self, $k, $op, $vals) = @_;
830 # backwards compatibility : if scalar, force into an arrayref
831 $vals = [$vals] if defined $vals && ! ref $vals;
833 my ($label) = $self->_convert($self->_quote($k));
834 my ($placeholder) = $self->_convert('?');
835 $op = $self->_sqlcase($op);
837 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
838 ARRAYREF => sub { # list of choices
839 if (@$vals) { # nonempty list
840 my $placeholders = join ", ", (($placeholder) x @$vals);
841 my $sql = "$label $op ( $placeholders )";
842 my @bind = $self->_bindtype($k, @$vals);
844 return ($sql, @bind);
846 else { # empty list : some databases won't understand "IN ()", so DWIM
847 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
852 ARRAYREFREF => sub { # literal SQL with bind
853 my ($sql, @bind) = @$$vals;
854 $self->_assert_bindval_matches_bindtype(@bind);
855 return ("$label $op ( $sql )", @bind);
859 puke "special op 'in' requires an arrayref (or arrayref-ref)";
863 return ($sql, @bind);
869 #======================================================================
871 #======================================================================
874 my ($self, $arg) = @_;
876 # construct list of ordering instructions
877 my @order = $self->_SWITCH_refkind($arg, {
880 map {$self->_SWITCH_refkind($_, {
881 SCALAR => sub {$self->_quote($_)},
883 SCALARREF => sub {$$_}, # literal SQL, no quoting
884 HASHREF => sub {$self->_order_by_hash($_)}
888 SCALAR => sub {$self->_quote($arg)},
890 SCALARREF => sub {$$arg}, # literal SQL, no quoting
891 HASHREF => sub {$self->_order_by_hash($arg)},
896 my $order = join ', ', @order;
897 return $order ? $self->_sqlcase(' order by')." $order" : '';
902 my ($self, $hash) = @_;
904 # get first pair in hash
905 my ($key, $val) = each %$hash;
907 # check if one pair was found and no other pair in hash
908 $key && !(each %$hash)
909 or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
911 my ($order) = ($key =~ /^-(desc|asc)/i)
912 or puke "invalid key in _order_by hash : $key";
914 $val = ref $val eq 'ARRAY' ? $val : [$val];
915 return join ', ', map { $self->_quote($_) . ' ' . $self->_sqlcase($order) } @$val;
920 #======================================================================
921 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
922 #======================================================================
927 $self->_SWITCH_refkind($from, {
928 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
929 SCALAR => sub {$self->_quote($from)},
930 SCALARREF => sub {$$from},
931 ARRAYREFREF => sub {join ', ', @$from;},
936 #======================================================================
938 #======================================================================
944 $label or puke "can't quote an empty label";
946 # left and right quote characters
947 my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
948 SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
949 ARRAYREF => sub {@{$self->{quote_char}}},
953 or puke "quote_char must be an arrayref of 2 values";
955 # no quoting if no quoting chars
956 $ql or return $label;
958 # no quoting for literal SQL
959 return $$label if ref($label) eq 'SCALAR';
961 # separate table / column (if applicable)
962 my $sep = $self->{name_sep} || '';
963 my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
965 # do the quoting, except for "*" or for `table`.*
966 my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
968 # reassemble and return.
969 return join $sep, @quoted;
973 # Conversion, if applicable
975 my ($self, $arg) = @_;
977 # LDNOTE : modified the previous implementation below because
978 # it was not consistent : the first "return" is always an array,
979 # the second "return" is context-dependent. Anyway, _convert
980 # seems always used with just a single argument, so make it a
982 # return @_ unless $self->{convert};
983 # my $conv = $self->_sqlcase($self->{convert});
984 # my @ret = map { $conv.'('.$_.')' } @_;
985 # return wantarray ? @ret : $ret[0];
986 if ($self->{convert}) {
987 my $conv = $self->_sqlcase($self->{convert});
988 $arg = $conv.'('.$arg.')';
996 my($col, @vals) = @_;
998 #LDNOTE : changed original implementation below because it did not make
999 # sense when bindtype eq 'columns' and @vals > 1.
1000 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1002 return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
1005 # Dies if any element of @bind is not in [colname => value] format
1006 # if bindtype is 'columns'.
1007 sub _assert_bindval_matches_bindtype {
1008 my ($self, @bind) = @_;
1010 if ($self->{bindtype} eq 'columns') {
1011 foreach my $val (@bind) {
1012 if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
1013 die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1019 sub _join_sql_clauses {
1020 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1022 if (@$clauses_aref > 1) {
1023 my $join = " " . $self->_sqlcase($logic) . " ";
1024 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1025 return ($sql, @$bind_aref);
1027 elsif (@$clauses_aref) {
1028 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1031 return (); # if no SQL, ignore @$bind_aref
1036 # Fix SQL case, if so requested
1040 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1041 # don't touch the argument ... crooked logic, but let's not change it!
1042 return $self->{case} ? $_[0] : uc($_[0]);
1046 #======================================================================
1047 # DISPATCHING FROM REFKIND
1048 #======================================================================
1051 my ($self, $data) = @_;
1057 # blessed objects are treated like scalars
1058 $ref = (blessed $data) ? '' : ref $data;
1059 $n_steps += 1 if $ref;
1060 last if $ref ne 'REF';
1064 my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
1066 return $base . ('REF' x $n_steps);
1072 my ($self, $data) = @_;
1073 my @try = ($self->_refkind($data));
1074 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1075 push @try, 'FALLBACK';
1079 sub _METHOD_FOR_refkind {
1080 my ($self, $meth_prefix, $data) = @_;
1081 my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
1082 $self->_try_refkind($data)
1083 or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1088 sub _SWITCH_refkind {
1089 my ($self, $data, $dispatch_table) = @_;
1091 my $coderef = first {$_} map {$dispatch_table->{$_}}
1092 $self->_try_refkind($data)
1093 or puke "no dispatch entry for ".$self->_refkind($data);
1100 #======================================================================
1101 # VALUES, GENERATE, AUTOLOAD
1102 #======================================================================
1104 # LDNOTE: original code from nwiger, didn't touch code in that section
1105 # I feel the AUTOLOAD stuff should not be the default, it should
1106 # only be activated on explicit demand by user.
1110 my $data = shift || return;
1111 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1112 unless ref $data eq 'HASH';
1115 foreach my $k ( sort keys %$data ) {
1116 my $v = $data->{$k};
1117 $self->_SWITCH_refkind($v, {
1119 if ($self->{array_datatypes}) { # array datatype
1120 push @all_bind, $self->_bindtype($k, $v);
1122 else { # literal SQL with bind
1123 my ($sql, @bind) = @$v;
1124 $self->_assert_bindval_matches_bindtype(@bind);
1125 push @all_bind, @bind;
1128 ARRAYREFREF => sub { # literal SQL with bind
1129 my ($sql, @bind) = @${$v};
1130 $self->_assert_bindval_matches_bindtype(@bind);
1131 push @all_bind, @bind;
1133 SCALARREF => sub { # literal SQL without bind
1135 SCALAR_or_UNDEF => sub {
1136 push @all_bind, $self->_bindtype($k, $v);
1147 my(@sql, @sqlq, @sqlv);
1151 if ($ref eq 'HASH') {
1152 for my $k (sort keys %$_) {
1155 my $label = $self->_quote($k);
1156 if ($r eq 'ARRAY') {
1157 # literal SQL with bind
1158 my ($sql, @bind) = @$v;
1159 $self->_assert_bindval_matches_bindtype(@bind);
1160 push @sqlq, "$label = $sql";
1162 } elsif ($r eq 'SCALAR') {
1163 # literal SQL without bind
1164 push @sqlq, "$label = $$v";
1166 push @sqlq, "$label = ?";
1167 push @sqlv, $self->_bindtype($k, $v);
1170 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1171 } elsif ($ref eq 'ARRAY') {
1172 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1175 if ($r eq 'ARRAY') { # literal SQL with bind
1176 my ($sql, @bind) = @$v;
1177 $self->_assert_bindval_matches_bindtype(@bind);
1180 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1181 # embedded literal SQL
1188 push @sql, '(' . join(', ', @sqlq) . ')';
1189 } elsif ($ref eq 'SCALAR') {
1193 # strings get case twiddled
1194 push @sql, $self->_sqlcase($_);
1198 my $sql = join ' ', @sql;
1200 # this is pretty tricky
1201 # if ask for an array, return ($stmt, @bind)
1202 # otherwise, s/?/shift @sqlv/ to put it inline
1204 return ($sql, @sqlv);
1206 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1207 ref $d ? $d->[1] : $d/e;
1216 # This allows us to check for a local, then _form, attr
1218 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1219 return $self->generate($name, @_);
1230 SQL::Abstract - Generate SQL from Perl data structures
1236 my $sql = SQL::Abstract->new;
1238 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1240 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1242 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1244 my($stmt, @bind) = $sql->delete($table, \%where);
1246 # Then, use these in your DBI statements
1247 my $sth = $dbh->prepare($stmt);
1248 $sth->execute(@bind);
1250 # Just generate the WHERE clause
1251 my($stmt, @bind) = $sql->where(\%where, \@order);
1253 # Return values in the same order, for hashed queries
1254 # See PERFORMANCE section for more details
1255 my @bind = $sql->values(\%fieldvals);
1259 This module was inspired by the excellent L<DBIx::Abstract>.
1260 However, in using that module I found that what I really wanted
1261 to do was generate SQL, but still retain complete control over my
1262 statement handles and use the DBI interface. So, I set out to
1263 create an abstract SQL generation module.
1265 While based on the concepts used by L<DBIx::Abstract>, there are
1266 several important differences, especially when it comes to WHERE
1267 clauses. I have modified the concepts used to make the SQL easier
1268 to generate from Perl data structures and, IMO, more intuitive.
1269 The underlying idea is for this module to do what you mean, based
1270 on the data structures you provide it. The big advantage is that
1271 you don't have to modify your code every time your data changes,
1272 as this module figures it out.
1274 To begin with, an SQL INSERT is as easy as just specifying a hash
1275 of C<key=value> pairs:
1278 name => 'Jimbo Bobson',
1279 phone => '123-456-7890',
1280 address => '42 Sister Lane',
1281 city => 'St. Louis',
1282 state => 'Louisiana',
1285 The SQL can then be generated with this:
1287 my($stmt, @bind) = $sql->insert('people', \%data);
1289 Which would give you something like this:
1291 $stmt = "INSERT INTO people
1292 (address, city, name, phone, state)
1293 VALUES (?, ?, ?, ?, ?)";
1294 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1295 '123-456-7890', 'Louisiana');
1297 These are then used directly in your DBI code:
1299 my $sth = $dbh->prepare($stmt);
1300 $sth->execute(@bind);
1302 =head2 Inserting and Updating Arrays
1304 If your database has array types (like for example Postgres),
1305 activate the special option C<< array_datatypes => 1 >>
1306 when creating the C<SQL::Abstract> object.
1307 Then you may use an arrayref to insert and update database array types:
1309 my $sql = SQL::Abstract->new(array_datatypes => 1);
1311 planets => [qw/Mercury Venus Earth Mars/]
1314 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1318 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1320 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1323 =head2 Inserting and Updating SQL
1325 In order to apply SQL functions to elements of your C<%data> you may
1326 specify a reference to an arrayref for the given hash value. For example,
1327 if you need to execute the Oracle C<to_date> function on a value, you can
1328 say something like this:
1332 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1335 The first value in the array is the actual SQL. Any other values are
1336 optional and would be included in the bind values array. This gives
1339 my($stmt, @bind) = $sql->insert('people', \%data);
1341 $stmt = "INSERT INTO people (name, date_entered)
1342 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1343 @bind = ('Bill', '03/02/2003');
1345 An UPDATE is just as easy, all you change is the name of the function:
1347 my($stmt, @bind) = $sql->update('people', \%data);
1349 Notice that your C<%data> isn't touched; the module will generate
1350 the appropriately quirky SQL for you automatically. Usually you'll
1351 want to specify a WHERE clause for your UPDATE, though, which is
1352 where handling C<%where> hashes comes in handy...
1354 =head2 Complex where statements
1356 This module can generate pretty complicated WHERE statements
1357 easily. For example, simple C<key=value> pairs are taken to mean
1358 equality, and if you want to see if a field is within a set
1359 of values, you can use an arrayref. Let's say we wanted to
1360 SELECT some data based on this criteria:
1363 requestor => 'inna',
1364 worker => ['nwiger', 'rcwe', 'sfz'],
1365 status => { '!=', 'completed' }
1368 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1370 The above would give you something like this:
1372 $stmt = "SELECT * FROM tickets WHERE
1373 ( requestor = ? ) AND ( status != ? )
1374 AND ( worker = ? OR worker = ? OR worker = ? )";
1375 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1377 Which you could then use in DBI code like so:
1379 my $sth = $dbh->prepare($stmt);
1380 $sth->execute(@bind);
1386 The functions are simple. There's one for each major SQL operation,
1387 and a constructor you use first. The arguments are specified in a
1388 similar order to each function (table, then fields, then a where
1389 clause) to try and simplify things.
1394 =head2 new(option => 'value')
1396 The C<new()> function takes a list of options and values, and returns
1397 a new B<SQL::Abstract> object which can then be used to generate SQL
1398 through the methods below. The options accepted are:
1404 If set to 'lower', then SQL will be generated in all lowercase. By
1405 default SQL is generated in "textbook" case meaning something like:
1407 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1409 Any setting other than 'lower' is ignored.
1413 This determines what the default comparison operator is. By default
1414 it is C<=>, meaning that a hash like this:
1416 %where = (name => 'nwiger', email => 'nate@wiger.org');
1418 Will generate SQL like this:
1420 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1422 However, you may want loose comparisons by default, so if you set
1423 C<cmp> to C<like> you would get SQL such as:
1425 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1427 You can also override the comparsion on an individual basis - see
1428 the huge section on L</"WHERE CLAUSES"> at the bottom.
1430 =item sqltrue, sqlfalse
1432 Expressions for inserting boolean values within SQL statements.
1433 By default these are C<1=1> and C<1=0>. They are used
1434 by the special operators C<-in> and C<-not_in> for generating
1435 correct SQL even when the argument is an empty array (see below).
1439 This determines the default logical operator for multiple WHERE
1440 statements in arrays or hashes. If absent, the default logic is "or"
1441 for arrays, and "and" for hashes. This means that a WHERE
1445 event_date => {'>=', '2/13/99'},
1446 event_date => {'<=', '4/24/03'},
1449 will generate SQL like this:
1451 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1453 This is probably not what you want given this query, though (look
1454 at the dates). To change the "OR" to an "AND", simply specify:
1456 my $sql = SQL::Abstract->new(logic => 'and');
1458 Which will change the above C<WHERE> to:
1460 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1462 The logic can also be changed locally by inserting
1463 a modifier in front of an arrayref :
1465 @where = (-and => [event_date => {'>=', '2/13/99'},
1466 event_date => {'<=', '4/24/03'} ]);
1468 See the L</"WHERE CLAUSES"> section for explanations.
1472 This will automatically convert comparisons using the specified SQL
1473 function for both column and value. This is mostly used with an argument
1474 of C<upper> or C<lower>, so that the SQL will have the effect of
1475 case-insensitive "searches". For example, this:
1477 $sql = SQL::Abstract->new(convert => 'upper');
1478 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1480 Will turn out the following SQL:
1482 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1484 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1485 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1486 not validate this option; it will just pass through what you specify verbatim).
1490 This is a kludge because many databases suck. For example, you can't
1491 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1492 Instead, you have to use C<bind_param()>:
1494 $sth->bind_param(1, 'reg data');
1495 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1497 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1498 which loses track of which field each slot refers to. Fear not.
1500 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1501 Currently, you can specify either C<normal> (default) or C<columns>. If you
1502 specify C<columns>, you will get an array that looks like this:
1504 my $sql = SQL::Abstract->new(bindtype => 'columns');
1505 my($stmt, @bind) = $sql->insert(...);
1508 [ 'column1', 'value1' ],
1509 [ 'column2', 'value2' ],
1510 [ 'column3', 'value3' ],
1513 You can then iterate through this manually, using DBI's C<bind_param()>.
1515 $sth->prepare($stmt);
1518 my($col, $data) = @$_;
1519 if ($col eq 'details' || $col eq 'comments') {
1520 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1521 } elsif ($col eq 'image') {
1522 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1524 $sth->bind_param($i, $data);
1528 $sth->execute; # execute without @bind now
1530 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1531 Basically, the advantage is still that you don't have to care which fields
1532 are or are not included. You could wrap that above C<for> loop in a simple
1533 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1534 get a layer of abstraction over manual SQL specification.
1536 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1537 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1538 will expect the bind values in this format.
1542 This is the character that a table or column name will be quoted
1543 with. By default this is an empty string, but you could set it to
1544 the character C<`>, to generate SQL like this:
1546 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1548 Alternatively, you can supply an array ref of two items, the first being the left
1549 hand quote character, and the second the right hand quote character. For
1550 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1551 that generates SQL like this:
1553 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1555 Quoting is useful if you have tables or columns names that are reserved
1556 words in your database's SQL dialect.
1560 This is the character that separates a table and column name. It is
1561 necessary to specify this when the C<quote_char> option is selected,
1562 so that tables and column names can be individually quoted like this:
1564 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1566 =item array_datatypes
1568 When this option is true, arrayrefs in INSERT or UPDATE are
1569 interpreted as array datatypes and are passed directly
1571 When this option is false, arrayrefs are interpreted
1572 as literal SQL, just like refs to arrayrefs
1573 (but this behavior is for backwards compatibility; when writing
1574 new queries, use the "reference to arrayref" syntax
1580 Takes a reference to a list of "special operators"
1581 to extend the syntax understood by L<SQL::Abstract>.
1582 See section L</"SPECIAL OPERATORS"> for details.
1588 =head2 insert($table, \@values || \%fieldvals)
1590 This is the simplest function. You simply give it a table name
1591 and either an arrayref of values or hashref of field/value pairs.
1592 It returns an SQL INSERT statement and a list of bind values.
1593 See the sections on L</"Inserting and Updating Arrays"> and
1594 L</"Inserting and Updating SQL"> for information on how to insert
1595 with those data types.
1597 =head2 update($table, \%fieldvals, \%where)
1599 This takes a table, hashref of field/value pairs, and an optional
1600 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1602 See the sections on L</"Inserting and Updating Arrays"> and
1603 L</"Inserting and Updating SQL"> for information on how to insert
1604 with those data types.
1606 =head2 select($source, $fields, $where, $order)
1608 This returns a SQL SELECT statement and associated list of bind values, as
1609 specified by the arguments :
1615 Specification of the 'FROM' part of the statement.
1616 The argument can be either a plain scalar (interpreted as a table
1617 name, will be quoted), or an arrayref (interpreted as a list
1618 of table names, joined by commas, quoted), or a scalarref
1619 (literal table name, not quoted), or a ref to an arrayref
1620 (list of literal table names, joined by commas, not quoted).
1624 Specification of the list of fields to retrieve from
1626 The argument can be either an arrayref (interpreted as a list
1627 of field names, will be joined by commas and quoted), or a
1628 plain scalar (literal SQL, not quoted).
1629 Please observe that this API is not as flexible as for
1630 the first argument C<$table>, for backwards compatibility reasons.
1634 Optional argument to specify the WHERE part of the query.
1635 The argument is most often a hashref, but can also be
1636 an arrayref or plain scalar --
1637 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1641 Optional argument to specify the ORDER BY part of the query.
1642 The argument can be a scalar, a hashref or an arrayref
1643 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1649 =head2 delete($table, \%where)
1651 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1652 It returns an SQL DELETE statement and list of bind values.
1654 =head2 where(\%where, \@order)
1656 This is used to generate just the WHERE clause. For example,
1657 if you have an arbitrary data structure and know what the
1658 rest of your SQL is going to look like, but want an easy way
1659 to produce a WHERE clause, use this. It returns an SQL WHERE
1660 clause and list of bind values.
1663 =head2 values(\%data)
1665 This just returns the values from the hash C<%data>, in the same
1666 order that would be returned from any of the other above queries.
1667 Using this allows you to markedly speed up your queries if you
1668 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1670 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1672 Warning: This is an experimental method and subject to change.
1674 This returns arbitrarily generated SQL. It's a really basic shortcut.
1675 It will return two different things, depending on return context:
1677 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1678 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1680 These would return the following:
1682 # First calling form
1683 $stmt = "CREATE TABLE test (?, ?)";
1684 @bind = (field1, field2);
1686 # Second calling form
1687 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1689 Depending on what you're trying to do, it's up to you to choose the correct
1690 format. In this example, the second form is what you would want.
1694 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1698 ALTER SESSION SET nls_date_format = 'MM/YY'
1700 You get the idea. Strings get their case twiddled, but everything
1701 else remains verbatim.
1706 =head1 WHERE CLAUSES
1710 This module uses a variation on the idea from L<DBIx::Abstract>. It
1711 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1712 module is that things in arrays are OR'ed, and things in hashes
1715 The easiest way to explain is to show lots of examples. After
1716 each C<%where> hash shown, it is assumed you used:
1718 my($stmt, @bind) = $sql->where(\%where);
1720 However, note that the C<%where> hash can be used directly in any
1721 of the other functions as well, as described above.
1723 =head2 Key-value pairs
1725 So, let's get started. To begin, a simple hash:
1729 status => 'completed'
1732 Is converted to SQL C<key = val> statements:
1734 $stmt = "WHERE user = ? AND status = ?";
1735 @bind = ('nwiger', 'completed');
1737 One common thing I end up doing is having a list of values that
1738 a field can be in. To do this, simply specify a list inside of
1743 status => ['assigned', 'in-progress', 'pending'];
1746 This simple code will create the following:
1748 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1749 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1751 A field associated to an empty arrayref will be considered a
1752 logical false and will generate 0=1.
1754 =head2 Specific comparison operators
1756 If you want to specify a different type of operator for your comparison,
1757 you can use a hashref for a given column:
1761 status => { '!=', 'completed' }
1764 Which would generate:
1766 $stmt = "WHERE user = ? AND status != ?";
1767 @bind = ('nwiger', 'completed');
1769 To test against multiple values, just enclose the values in an arrayref:
1771 status => { '=', ['assigned', 'in-progress', 'pending'] };
1773 Which would give you:
1775 "WHERE status = ? OR status = ? OR status = ?"
1778 The hashref can also contain multiple pairs, in which case it is expanded
1779 into an C<AND> of its elements:
1783 status => { '!=', 'completed', -not_like => 'pending%' }
1786 # Or more dynamically, like from a form
1787 $where{user} = 'nwiger';
1788 $where{status}{'!='} = 'completed';
1789 $where{status}{'-not_like'} = 'pending%';
1791 # Both generate this
1792 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1793 @bind = ('nwiger', 'completed', 'pending%');
1796 To get an OR instead, you can combine it with the arrayref idea:
1800 priority => [ {'=', 2}, {'!=', 1} ]
1803 Which would generate:
1805 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1806 @bind = ('nwiger', '2', '1');
1808 If you want to include literal SQL (with or without bind values), just use a
1809 scalar reference or array reference as the value:
1812 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1813 date_expires => { '<' => \"now()" }
1816 Which would generate:
1818 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1819 @bind = ('11/26/2008');
1822 =head2 Logic and nesting operators
1824 In the example above,
1825 there is a subtle trap if you want to say something like
1826 this (notice the C<AND>):
1828 WHERE priority != ? AND priority != ?
1830 Because, in Perl you I<can't> do this:
1832 priority => { '!=', 2, '!=', 1 }
1834 As the second C<!=> key will obliterate the first. The solution
1835 is to use the special C<-modifier> form inside an arrayref:
1837 priority => [ -and => {'!=', 2},
1841 Normally, these would be joined by C<OR>, but the modifier tells it
1842 to use C<AND> instead. (Hint: You can use this in conjunction with the
1843 C<logic> option to C<new()> in order to change the way your queries
1844 work by default.) B<Important:> Note that the C<-modifier> goes
1845 B<INSIDE> the arrayref, as an extra first element. This will
1846 B<NOT> do what you think it might:
1848 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1850 Here is a quick list of equivalencies, since there is some overlap:
1853 status => {'!=', 'completed', 'not like', 'pending%' }
1854 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1857 status => {'=', ['assigned', 'in-progress']}
1858 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1859 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1863 =head2 Special operators : IN, BETWEEN, etc.
1865 You can also use the hashref format to compare a list of fields using the
1866 C<IN> comparison operator, by specifying the list as an arrayref:
1869 status => 'completed',
1870 reportid => { -in => [567, 2335, 2] }
1873 Which would generate:
1875 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1876 @bind = ('completed', '567', '2335', '2');
1878 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1881 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1882 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1883 'sqltrue' (by default : C<1=1>).
1887 Another pair of operators is C<-between> and C<-not_between>,
1888 used with an arrayref of two values:
1892 completion_date => {
1893 -not_between => ['2002-10-01', '2003-02-06']
1899 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1901 These are the two builtin "special operators"; but the
1902 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1904 =head2 Boolean operators
1906 If you wish to test against boolean columns or functions within your
1907 database you can use the C<-bool> and C<-not_bool> operators. For
1908 example to test the column C<is_user> being true and the column
1909 <is_enabled> being false you would use:-
1913 -not_bool => 'is_enabled',
1918 WHERE is_user AND NOT is_enabledmv
1922 =head2 Nested conditions, -and/-or prefixes
1924 So far, we've seen how multiple conditions are joined with a top-level
1925 C<AND>. We can change this by putting the different conditions we want in
1926 hashes and then putting those hashes in an array. For example:
1931 status => { -like => ['pending%', 'dispatched'] },
1935 status => 'unassigned',
1939 This data structure would create the following:
1941 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1942 OR ( user = ? AND status = ? ) )";
1943 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1946 There is also a special C<-nest>
1947 operator which adds an additional set of parens, to create a subquery.
1948 For example, to get something like this:
1950 $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1951 @bind = ('nwiger', '20', 'ASIA');
1957 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1961 Finally, clauses in hashrefs or arrayrefs can be
1962 prefixed with an C<-and> or C<-or> to change the logic
1969 -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
1970 -and => [workhrs => {'<', 50}, geo => 'EURO' ]
1977 WHERE ( user = ? AND
1978 ( ( workhrs > ? AND geo = ? )
1979 OR ( workhrs < ? AND geo = ? ) ) )
1982 =head2 Algebraic inconsistency, for historical reasons
1984 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
1985 operator goes C<outside> of the nested structure; whereas when connecting
1986 several constraints on one column, the C<-and> operator goes
1987 C<inside> the arrayref. Here is an example combining both features :
1990 -and => [a => 1, b => 2],
1991 -or => [c => 3, d => 4],
1992 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
1997 WHERE ( ( ( a = ? AND b = ? )
1998 OR ( c = ? OR d = ? )
1999 OR ( e LIKE ? AND e LIKE ? ) ) )
2001 This difference in syntax is unfortunate but must be preserved for
2002 historical reasons. So be careful : the two examples below would
2003 seem algebraically equivalent, but they are not
2005 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2006 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2008 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2009 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2014 Finally, sometimes only literal SQL will do. If you want to include
2015 literal SQL verbatim, you can specify it as a scalar reference, namely:
2017 my $inn = 'is Not Null';
2019 priority => { '<', 2 },
2025 $stmt = "WHERE priority < ? AND requestor is Not Null";
2028 Note that in this example, you only get one bind parameter back, since
2029 the verbatim SQL is passed as part of the statement.
2031 Of course, just to prove a point, the above can also be accomplished
2035 priority => { '<', 2 },
2036 requestor => { '!=', undef },
2042 Conditions on boolean columns can be expressed in the
2043 same way, passing a reference to an empty string :
2046 priority => { '<', 2 },
2052 $stmt = "WHERE priority < ? AND is_ready";
2056 =head2 Literal SQL with placeholders and bind values (subqueries)
2058 If the literal SQL to be inserted has placeholders and bind values,
2059 use a reference to an arrayref (yes this is a double reference --
2060 not so common, but perfectly legal Perl). For example, to find a date
2061 in Postgres you can use something like this:
2064 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2069 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2072 Note that you must pass the bind values in the same format as they are returned
2073 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2074 provide the bind values in the C<< [ column_meta => value ] >> format, where
2075 C<column_meta> is an opaque scalar value; most commonly the column name, but
2076 you can use any scalar value (including references and blessed references),
2077 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2078 to C<columns> the above example will look like:
2081 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2084 Literal SQL is especially useful for nesting parenthesized clauses in the
2085 main SQL query. Here is a first example :
2087 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2091 bar => \["IN ($sub_stmt)" => @sub_bind],
2096 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2097 WHERE c2 < ? AND c3 LIKE ?))";
2098 @bind = (1234, 100, "foo%");
2100 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2101 are expressed in the same way. Of course the C<$sub_stmt> and
2102 its associated bind values can be generated through a former call
2105 my ($sub_stmt, @sub_bind)
2106 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2107 c3 => {-like => "foo%"}});
2110 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2113 In the examples above, the subquery was used as an operator on a column;
2114 but the same principle also applies for a clause within the main C<%where>
2115 hash, like an EXISTS subquery :
2117 my ($sub_stmt, @sub_bind)
2118 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2121 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
2126 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2127 WHERE c1 = ? AND c2 > t0.c0))";
2131 Observe that the condition on C<c2> in the subquery refers to
2132 column C<t0.c0> of the main query : this is I<not> a bind
2133 value, so we have to express it through a scalar ref.
2134 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2135 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2136 what we wanted here.
2138 Another use of the subquery technique is when some SQL clauses need
2139 parentheses, as it often occurs with some proprietary SQL extensions
2140 like for example fulltext expressions, geospatial expressions,
2141 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
2144 -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
2147 Finally, here is an example where a subquery is used
2148 for expressing unary negation:
2150 my ($sub_stmt, @sub_bind)
2151 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2152 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2154 lname => {like => '%son%'},
2155 -nest => \["NOT ($sub_stmt)" => @sub_bind],
2160 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2161 @bind = ('%son%', 10, 20)
2167 These pages could go on for a while, since the nesting of the data
2168 structures this module can handle are pretty much unlimited (the
2169 module implements the C<WHERE> expansion as a recursive function
2170 internally). Your best bet is to "play around" with the module a
2171 little to see how the data structures behave, and choose the best
2172 format for your data based on that.
2174 And of course, all the values above will probably be replaced with
2175 variables gotten from forms or the command line. After all, if you
2176 knew everything ahead of time, you wouldn't have to worry about
2177 dynamically-generating SQL and could just hardwire it into your
2183 =head1 ORDER BY CLAUSES
2185 Some functions take an order by clause. This can either be a scalar (just a
2186 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2187 or an array of either of the two previous forms. Examples:
2189 Given | Will Generate
2190 ----------------------------------------------------------
2192 \'colA DESC' | ORDER BY colA DESC
2194 'colA' | ORDER BY colA
2196 [qw/colA colB/] | ORDER BY colA, colB
2198 {-asc => 'colA'} | ORDER BY colA ASC
2200 {-desc => 'colB'} | ORDER BY colB DESC
2202 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2204 { -asc => [qw/colA colB] } | ORDER BY colA ASC, colB ASC
2207 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2208 { -desc => [qw/colB/], | colC ASC, colD ASC
2209 { -asc => [qw/colC colD/],|
2211 ===========================================================
2215 =head1 SPECIAL OPERATORS
2217 my $sqlmaker = SQL::Abstract->new(special_ops => [
2221 my ($self, $field, $op, $arg) = @_;
2227 handler => 'method_name',
2231 A "special operator" is a SQL syntactic clause that can be
2232 applied to a field, instead of a usual binary operator.
2235 WHERE field IN (?, ?, ?)
2236 WHERE field BETWEEN ? AND ?
2237 WHERE MATCH(field) AGAINST (?, ?)
2239 Special operators IN and BETWEEN are fairly standard and therefore
2240 are builtin within C<SQL::Abstract> (as the overridable methods
2241 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2242 like the MATCH .. AGAINST example above which is specific to MySQL,
2243 you can write your own operator handlers - supply a C<special_ops>
2244 argument to the C<new> method. That argument takes an arrayref of
2245 operator definitions; each operator definition is a hashref with two
2252 the regular expression to match the operator
2256 Either a coderef or a plain scalar method name. In both cases
2257 the expected return is C<< ($sql, @bind) >>.
2259 When supplied with a method name, it is simply called on the
2260 L<SQL::Abstract/> object as:
2262 $self->$method_name ($field, $op, $arg)
2266 $op is the part that matched the handler regex
2267 $field is the LHS of the operator
2270 When supplied with a coderef, it is called as:
2272 $coderef->($self, $field, $op, $arg)
2277 For example, here is an implementation
2278 of the MATCH .. AGAINST syntax for MySQL
2280 my $sqlmaker = SQL::Abstract->new(special_ops => [
2282 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2283 {regex => qr/^match$/i,
2285 my ($self, $field, $op, $arg) = @_;
2286 $arg = [$arg] if not ref $arg;
2287 my $label = $self->_quote($field);
2288 my ($placeholder) = $self->_convert('?');
2289 my $placeholders = join ", ", (($placeholder) x @$arg);
2290 my $sql = $self->_sqlcase('match') . " ($label) "
2291 . $self->_sqlcase('against') . " ($placeholders) ";
2292 my @bind = $self->_bindtype($field, @$arg);
2293 return ($sql, @bind);
2302 Thanks to some benchmarking by Mark Stosberg, it turns out that
2303 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2304 I must admit this wasn't an intentional design issue, but it's a
2305 byproduct of the fact that you get to control your C<DBI> handles
2308 To maximize performance, use a code snippet like the following:
2310 # prepare a statement handle using the first row
2311 # and then reuse it for the rest of the rows
2313 for my $href (@array_of_hashrefs) {
2314 $stmt ||= $sql->insert('table', $href);
2315 $sth ||= $dbh->prepare($stmt);
2316 $sth->execute($sql->values($href));
2319 The reason this works is because the keys in your C<$href> are sorted
2320 internally by B<SQL::Abstract>. Thus, as long as your data retains
2321 the same structure, you only have to generate the SQL the first time
2322 around. On subsequent queries, simply use the C<values> function provided
2323 by this module to return your values in the correct order.
2328 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2329 really like this part (I do, at least). Building up a complex query
2330 can be as simple as the following:
2334 use CGI::FormBuilder;
2337 my $form = CGI::FormBuilder->new(...);
2338 my $sql = SQL::Abstract->new;
2340 if ($form->submitted) {
2341 my $field = $form->field;
2342 my $id = delete $field->{id};
2343 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2346 Of course, you would still have to connect using C<DBI> to run the
2347 query, but the point is that if you make your form look like your
2348 table, the actual query script can be extremely simplistic.
2350 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2351 a fast interface to returning and formatting data. I frequently
2352 use these three modules together to write complex database query
2353 apps in under 50 lines.
2358 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2359 Great care has been taken to preserve the I<published> behavior
2360 documented in previous versions in the 1.* family; however,
2361 some features that were previously undocumented, or behaved
2362 differently from the documentation, had to be changed in order
2363 to clarify the semantics. Hence, client code that was relying
2364 on some dark areas of C<SQL::Abstract> v1.*
2365 B<might behave differently> in v1.50.
2367 The main changes are :
2373 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2377 support for the { operator => \"..." } construct (to embed literal SQL)
2381 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2385 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2389 defensive programming : check arguments
2393 fixed bug with global logic, which was previously implemented
2394 through global variables yielding side-effects. Prior versions would
2395 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2396 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2397 Now this is interpreted
2398 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2403 fixed semantics of _bindtype on array args
2407 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2408 we just avoid shifting arrays within that tree.
2412 dropped the C<_modlogic> function
2418 =head1 ACKNOWLEDGEMENTS
2420 There are a number of individuals that have really helped out with
2421 this module. Unfortunately, most of them submitted bugs via CPAN
2422 so I have no idea who they are! But the people I do know are:
2424 Ash Berlin (order_by hash term support)
2425 Matt Trout (DBIx::Class support)
2426 Mark Stosberg (benchmarking)
2427 Chas Owens (initial "IN" operator support)
2428 Philip Collins (per-field SQL functions)
2429 Eric Kolve (hashref "AND" support)
2430 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2431 Dan Kubb (support for "quote_char" and "name_sep")
2432 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2433 Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2434 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2435 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2441 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2445 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2447 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2449 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2450 While not an official support venue, C<DBIx::Class> makes heavy use of
2451 C<SQL::Abstract>, and as such list members there are very familiar with
2452 how to create queries.
2456 This module is free software; you may copy this under the terms of
2457 the GNU General Public License, or the Artistic License, copies of
2458 which should have accompanied your Perl kit.