1 package SQL::Abstract; # see doc at end of file
10 our @EXPORT_OK = qw(is_plain_value is_literal_value);
20 *SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}
26 #======================================================================
28 #======================================================================
30 our $VERSION = '1.79';
32 # This would confuse some packagers
33 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
37 # special operators (-in, -between). May be extended/overridden by user.
38 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
39 my @BUILTIN_SPECIAL_OPS = (
40 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
41 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
42 {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
43 {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
44 {regex => qr/^ is (?: \s+ not )? $/ix, handler => '_where_field_IS'},
47 # unaryish operators - key maps to handler
48 my @BUILTIN_UNARY_OPS = (
49 # the digits are backcompat stuff
50 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
51 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
52 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
53 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
54 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
55 { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
58 #======================================================================
59 # DEBUGGING AND ERROR REPORTING
60 #======================================================================
63 return unless $_[0]->{debug}; shift; # a little faster
64 my $func = (caller(1))[3];
65 warn "[$func] ", @_, "\n";
69 my($func) = (caller(1))[3];
70 Carp::carp "[$func] Warning: ", @_;
74 my($func) = (caller(1))[3];
75 Carp::croak "[$func] Fatal: ", @_;
78 sub is_literal_value ($) {
79 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
80 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
84 # FIXME XSify - this can be done so much more efficiently
85 sub is_plain_value ($) {
87 ! length ref $_[0] ? \($_[0])
89 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
91 exists $_[0]->{-value}
92 ) ? \($_[0]->{-value})
94 # reuse @_ for even moar speedz
95 defined ( $_[1] = Scalar::Util::blessed $_[0] )
97 # deliberately not using Devel::OverloadInfo - the checks we are
98 # intersted in are much more limited than the fullblown thing, and
99 # this is a very hot piece of code
101 # simply using ->can('(""') can leave behind stub methods that
102 # break actually using the overload later (see L<perldiag/Stub
103 # found while resolving method "%s" overloading "%s" in package
104 # "%s"> and the source of overload::mycan())
106 # either has stringification which DBI SHOULD prefer out of the box
107 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
109 # has nummification or boolification, AND fallback is *not* disabled
111 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
114 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
116 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
120 # no fallback specified at all
121 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
123 # fallback explicitly undef
124 ! defined ${"$_[3]::()"}
137 #======================================================================
139 #======================================================================
143 my $class = ref($self) || $self;
144 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
146 # choose our case by keeping an option around
147 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
149 # default logic for interpreting arrayrefs
150 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
152 # how to return bind vars
153 $opt{bindtype} ||= 'normal';
155 # default comparison is "=", but can be overridden
158 # try to recognize which are the 'equality' and 'inequality' ops
159 # (temporary quickfix (in 2007), should go through a more seasoned API)
160 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
161 $opt{inequality_op} = qr/^( != | <> )$/ix;
163 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
164 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
167 $opt{sqltrue} ||= '1=1';
168 $opt{sqlfalse} ||= '0=1';
171 $opt{special_ops} ||= [];
172 # regexes are applied in order, thus push after user-defines
173 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
176 $opt{unary_ops} ||= [];
177 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
179 # rudimentary sanity-check for user supplied bits treated as functions/operators
180 # If a purported function matches this regular expression, an exception is thrown.
181 # Literal SQL is *NOT* subject to this check, only functions (and column names
182 # when quoting is not in effect)
185 # need to guard against ()'s in column names too, but this will break tons of
186 # hacks... ideas anyone?
187 $opt{injection_guard} ||= qr/
193 return bless \%opt, $class;
197 sub _assert_pass_injection_guard {
198 if ($_[1] =~ $_[0]->{injection_guard}) {
199 my $class = ref $_[0];
200 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
201 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
202 . "{injection_guard} attribute to ${class}->new()"
207 #======================================================================
209 #======================================================================
213 my $table = $self->_table(shift);
214 my $data = shift || return;
217 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
218 my ($sql, @bind) = $self->$method($data);
219 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
221 if ($options->{returning}) {
222 my ($s, @b) = $self->_insert_returning ($options);
227 return wantarray ? ($sql, @bind) : $sql;
230 sub _insert_returning {
231 my ($self, $options) = @_;
233 my $f = $options->{returning};
235 my $fieldlist = $self->_SWITCH_refkind($f, {
236 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
237 SCALAR => sub {$self->_quote($f)},
238 SCALARREF => sub {$$f},
240 return $self->_sqlcase(' returning ') . $fieldlist;
243 sub _insert_HASHREF { # explicit list of fields and then values
244 my ($self, $data) = @_;
246 my @fields = sort keys %$data;
248 my ($sql, @bind) = $self->_insert_values($data);
251 $_ = $self->_quote($_) foreach @fields;
252 $sql = "( ".join(", ", @fields).") ".$sql;
254 return ($sql, @bind);
257 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
258 my ($self, $data) = @_;
260 # no names (arrayref) so can't generate bindtype
261 $self->{bindtype} ne 'columns'
262 or belch "can't do 'columns' bindtype when called with arrayref";
264 # fold the list of values into a hash of column name - value pairs
265 # (where the column names are artificially generated, and their
266 # lexicographical ordering keep the ordering of the original list)
267 my $i = "a"; # incremented values will be in lexicographical order
268 my $data_in_hash = { map { ($i++ => $_) } @$data };
270 return $self->_insert_values($data_in_hash);
273 sub _insert_ARRAYREFREF { # literal SQL with bind
274 my ($self, $data) = @_;
276 my ($sql, @bind) = @${$data};
277 $self->_assert_bindval_matches_bindtype(@bind);
279 return ($sql, @bind);
283 sub _insert_SCALARREF { # literal SQL without bind
284 my ($self, $data) = @_;
290 my ($self, $data) = @_;
292 my (@values, @all_bind);
293 foreach my $column (sort keys %$data) {
294 my $v = $data->{$column};
296 $self->_SWITCH_refkind($v, {
299 if ($self->{array_datatypes}) { # if array datatype are activated
301 push @all_bind, $self->_bindtype($column, $v);
303 else { # else literal SQL with bind
304 my ($sql, @bind) = @$v;
305 $self->_assert_bindval_matches_bindtype(@bind);
307 push @all_bind, @bind;
311 ARRAYREFREF => sub { # literal SQL with bind
312 my ($sql, @bind) = @${$v};
313 $self->_assert_bindval_matches_bindtype(@bind);
315 push @all_bind, @bind;
318 # THINK : anything useful to do with a HASHREF ?
319 HASHREF => sub { # (nothing, but old SQLA passed it through)
320 #TODO in SQLA >= 2.0 it will die instead
321 belch "HASH ref as bind value in insert is not supported";
323 push @all_bind, $self->_bindtype($column, $v);
326 SCALARREF => sub { # literal SQL without bind
330 SCALAR_or_UNDEF => sub {
332 push @all_bind, $self->_bindtype($column, $v);
339 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
340 return ($sql, @all_bind);
345 #======================================================================
347 #======================================================================
352 my $table = $self->_table(shift);
353 my $data = shift || return;
356 # first build the 'SET' part of the sql statement
357 my (@set, @all_bind);
358 puke "Unsupported data type specified to \$sql->update"
359 unless ref $data eq 'HASH';
361 for my $k (sort keys %$data) {
364 my $label = $self->_quote($k);
366 $self->_SWITCH_refkind($v, {
368 if ($self->{array_datatypes}) { # array datatype
369 push @set, "$label = ?";
370 push @all_bind, $self->_bindtype($k, $v);
372 else { # literal SQL with bind
373 my ($sql, @bind) = @$v;
374 $self->_assert_bindval_matches_bindtype(@bind);
375 push @set, "$label = $sql";
376 push @all_bind, @bind;
379 ARRAYREFREF => sub { # literal SQL with bind
380 my ($sql, @bind) = @${$v};
381 $self->_assert_bindval_matches_bindtype(@bind);
382 push @set, "$label = $sql";
383 push @all_bind, @bind;
385 SCALARREF => sub { # literal SQL without bind
386 push @set, "$label = $$v";
389 my ($op, $arg, @rest) = %$v;
391 puke 'Operator calls in update must be in the form { -op => $arg }'
392 if (@rest or not $op =~ /^\-(.+)/);
394 local $self->{_nested_func_lhs} = $k;
395 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
397 push @set, "$label = $sql";
398 push @all_bind, @bind;
400 SCALAR_or_UNDEF => sub {
401 push @set, "$label = ?";
402 push @all_bind, $self->_bindtype($k, $v);
408 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
412 my($where_sql, @where_bind) = $self->where($where);
414 push @all_bind, @where_bind;
417 return wantarray ? ($sql, @all_bind) : $sql;
423 #======================================================================
425 #======================================================================
430 my $table = $self->_table(shift);
431 my $fields = shift || '*';
435 my($where_sql, @bind) = $self->where($where, $order);
437 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
439 my $sql = join(' ', $self->_sqlcase('select'), $f,
440 $self->_sqlcase('from'), $table)
443 return wantarray ? ($sql, @bind) : $sql;
446 #======================================================================
448 #======================================================================
453 my $table = $self->_table(shift);
457 my($where_sql, @bind) = $self->where($where);
458 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
460 return wantarray ? ($sql, @bind) : $sql;
464 #======================================================================
466 #======================================================================
470 # Finally, a separate routine just to handle WHERE clauses
472 my ($self, $where, $order) = @_;
475 my ($sql, @bind) = $self->_recurse_where($where);
476 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
480 $sql .= $self->_order_by($order);
483 return wantarray ? ($sql, @bind) : $sql;
488 my ($self, $where, $logic) = @_;
490 # dispatch on appropriate method according to refkind of $where
491 my $method = $self->_METHOD_FOR_refkind("_where", $where);
493 my ($sql, @bind) = $self->$method($where, $logic);
495 # DBIx::Class used to call _recurse_where in scalar context
496 # something else might too...
498 return ($sql, @bind);
501 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
508 #======================================================================
509 # WHERE: top-level ARRAYREF
510 #======================================================================
513 sub _where_ARRAYREF {
514 my ($self, $where, $logic) = @_;
516 $logic = uc($logic || $self->{logic});
517 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
519 my @clauses = @$where;
521 my (@sql_clauses, @all_bind);
522 # need to use while() so can shift() for pairs
524 my $el = shift @clauses;
526 $el = undef if (defined $el and ! length $el);
528 # switch according to kind of $el and get corresponding ($sql, @bind)
529 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
531 # skip empty elements, otherwise get invalid trailing AND stuff
532 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
536 $self->_assert_bindval_matches_bindtype(@b);
540 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
542 SCALARREF => sub { ($$el); },
545 # top-level arrayref with scalars, recurse in pairs
546 $self->_recurse_where({$el => shift(@clauses)})
549 UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
553 push @sql_clauses, $sql;
554 push @all_bind, @bind;
558 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
561 #======================================================================
562 # WHERE: top-level ARRAYREFREF
563 #======================================================================
565 sub _where_ARRAYREFREF {
566 my ($self, $where) = @_;
567 my ($sql, @bind) = @$$where;
568 $self->_assert_bindval_matches_bindtype(@bind);
569 return ($sql, @bind);
572 #======================================================================
573 # WHERE: top-level HASHREF
574 #======================================================================
577 my ($self, $where) = @_;
578 my (@sql_clauses, @all_bind);
580 for my $k (sort keys %$where) {
581 my $v = $where->{$k};
583 # ($k => $v) is either a special unary op or a regular hashpair
584 my ($sql, @bind) = do {
586 # put the operator in canonical form
588 $op = substr $op, 1; # remove initial dash
589 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
590 $op =~ s/\s+/ /g; # compress whitespace
592 # so that -not_foo works correctly
593 $op =~ s/^not_/NOT /i;
595 $self->_debug("Unary OP(-$op) within hashref, recursing...");
596 my ($s, @b) = $self->_where_unary_op ($op, $v);
598 # top level vs nested
599 # we assume that handled unary ops will take care of their ()s
601 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
603 ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
609 if (is_literal_value ($v) ) {
610 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
613 puke "Supplying an empty left hand side argument is not supported in hash-pairs";
617 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
618 $self->$method($k, $v);
622 push @sql_clauses, $sql;
623 push @all_bind, @bind;
626 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
629 sub _where_unary_op {
630 my ($self, $op, $rhs) = @_;
632 # top level special ops are illegal in general
633 # this includes the -ident/-value ops (dual purpose unary and special)
634 puke "Illegal use of top-level '-$op'"
635 if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}};
637 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
638 my $handler = $op_entry->{handler};
640 if (not ref $handler) {
641 if ($op =~ s/ [_\s]? \d+ $//x ) {
642 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
643 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
645 return $self->$handler ($op, $rhs);
647 elsif (ref $handler eq 'CODE') {
648 return $handler->($self, $op, $rhs);
651 puke "Illegal handler for operator $op - expecting a method name or a coderef";
655 $self->_debug("Generic unary OP: $op - recursing as function");
657 $self->_assert_pass_injection_guard($op);
659 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
661 puke "Illegal use of top-level '-$op'"
662 unless defined $self->{_nested_func_lhs};
665 $self->_convert('?'),
666 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
670 $self->_recurse_where ($rhs)
674 $sql = sprintf ('%s %s',
675 $self->_sqlcase($op),
679 return ($sql, @bind);
682 sub _where_op_ANDOR {
683 my ($self, $op, $v) = @_;
685 $self->_SWITCH_refkind($v, {
687 return $self->_where_ARRAYREF($v, $op);
691 return ( $op =~ /^or/i )
692 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
693 : $self->_where_HASHREF($v);
697 puke "-$op => \\\$scalar makes little sense, use " .
699 ? '[ \$scalar, \%rest_of_conditions ] instead'
700 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
705 puke "-$op => \\[...] makes little sense, use " .
707 ? '[ \[...], \%rest_of_conditions ] instead'
708 : '-and => [ \[...], \%rest_of_conditions ] instead'
712 SCALAR => sub { # permissively interpreted as SQL
713 puke "-$op => \$value makes little sense, use -bool => \$value instead";
717 puke "-$op => undef not supported";
723 my ($self, $op, $v) = @_;
725 $self->_SWITCH_refkind($v, {
727 SCALAR => sub { # permissively interpreted as SQL
728 belch "literal SQL should be -nest => \\'scalar' "
729 . "instead of -nest => 'scalar' ";
734 puke "-$op => undef not supported";
738 $self->_recurse_where ($v);
746 my ($self, $op, $v) = @_;
748 my ($s, @b) = $self->_SWITCH_refkind($v, {
749 SCALAR => sub { # interpreted as SQL column
750 $self->_convert($self->_quote($v));
754 puke "-$op => undef not supported";
758 $self->_recurse_where ($v);
762 $s = "(NOT $s)" if $op =~ /^not/i;
767 sub _where_op_IDENT {
769 my ($op, $rhs) = splice @_, -2;
770 if (! defined $rhs or length ref $rhs) {
771 puke "-$op requires a single plain scalar argument (a quotable identifier)";
774 # in case we are called as a top level special op (no '=')
777 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
785 sub _where_op_VALUE {
787 my ($op, $rhs) = splice @_, -2;
789 # in case we are called as a top level special op (no '=')
793 if (! defined $rhs) {
795 ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
802 ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ),
809 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
813 $self->_convert('?'),
819 sub _where_hashpair_ARRAYREF {
820 my ($self, $k, $v) = @_;
823 my @v = @$v; # need copy because of shift below
824 $self->_debug("ARRAY($k) means distribute over elements");
826 # put apart first element if it is an operator (-and, -or)
828 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
832 my @distributed = map { {$k => $_} } @v;
835 $self->_debug("OP($op) reinjected into the distributed array");
836 unshift @distributed, $op;
839 my $logic = $op ? substr($op, 1) : '';
841 return $self->_recurse_where(\@distributed, $logic);
844 $self->_debug("empty ARRAY($k) means 0=1");
845 return ($self->{sqlfalse});
849 sub _where_hashpair_HASHREF {
850 my ($self, $k, $v, $logic) = @_;
853 local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
854 ? $self->{_nested_func_lhs}
858 my ($all_sql, @all_bind);
860 for my $orig_op (sort keys %$v) {
861 my $val = $v->{$orig_op};
863 # put the operator in canonical form
866 # FIXME - we need to phase out dash-less ops
867 $op =~ s/^-//; # remove possible initial dash
868 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
869 $op =~ s/\s+/ /g; # compress whitespace
871 $self->_assert_pass_injection_guard($op);
874 $op =~ s/^is_not/IS NOT/i;
876 # so that -not_foo works correctly
877 $op =~ s/^not_/NOT /i;
879 # another retarded special case: foo => { $op => { -value => undef } }
880 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
886 # CASE: col-value logic modifiers
887 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
888 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
890 # CASE: special operators like -in or -between
891 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
892 my $handler = $special_op->{handler};
894 puke "No handler supplied for special operator $orig_op";
896 elsif (not ref $handler) {
897 ($sql, @bind) = $self->$handler ($k, $op, $val);
899 elsif (ref $handler eq 'CODE') {
900 ($sql, @bind) = $handler->($self, $k, $op, $val);
903 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
907 $self->_SWITCH_refkind($val, {
909 ARRAYREF => sub { # CASE: col => {op => \@vals}
910 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
913 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
914 my ($sub_sql, @sub_bind) = @$$val;
915 $self->_assert_bindval_matches_bindtype(@sub_bind);
916 $sql = join ' ', $self->_convert($self->_quote($k)),
917 $self->_sqlcase($op),
922 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
924 $op =~ /^not$/i ? 'is not' # legacy
925 : $op =~ $self->{equality_op} ? 'is'
926 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
927 : $op =~ $self->{inequality_op} ? 'is not'
928 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
929 : puke "unexpected operator '$orig_op' with undef operand";
931 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
934 FALLBACK => sub { # CASE: col => {op/func => $stuff}
935 ($sql, @bind) = $self->_where_unary_op ($op, $val);
938 $self->_convert($self->_quote($k)),
939 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
945 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
946 push @all_bind, @bind;
948 return ($all_sql, @all_bind);
951 sub _where_field_IS {
952 my ($self, $k, $op, $v) = @_;
954 my ($s) = $self->_SWITCH_refkind($v, {
957 $self->_convert($self->_quote($k)),
958 map { $self->_sqlcase($_)} ($op, 'null')
961 puke "$op can only take undef as argument";
968 sub _where_field_op_ARRAYREF {
969 my ($self, $k, $op, $vals) = @_;
971 my @vals = @$vals; #always work on a copy
974 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
976 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
979 # see if the first element is an -and/-or op
981 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
986 # a long standing API wart - an attempt to change this behavior during
987 # the 1.50 series failed *spectacularly*. Warn instead and leave the
992 (!$logic or $logic eq 'OR')
994 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
997 belch "A multi-element arrayref as an argument to the inequality op '$o' "
998 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
999 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1003 # distribute $op over each remaining member of @vals, append logic if exists
1004 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1008 # try to DWIM on equality operators
1010 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1011 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1012 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1013 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1014 : puke "operator '$op' applied on an empty array (field '$k')";
1019 sub _where_hashpair_SCALARREF {
1020 my ($self, $k, $v) = @_;
1021 $self->_debug("SCALAR($k) means literal SQL: $$v");
1022 my $sql = $self->_quote($k) . " " . $$v;
1026 # literal SQL with bind
1027 sub _where_hashpair_ARRAYREFREF {
1028 my ($self, $k, $v) = @_;
1029 $self->_debug("REF($k) means literal SQL: @${$v}");
1030 my ($sql, @bind) = @$$v;
1031 $self->_assert_bindval_matches_bindtype(@bind);
1032 $sql = $self->_quote($k) . " " . $sql;
1033 return ($sql, @bind );
1036 # literal SQL without bind
1037 sub _where_hashpair_SCALAR {
1038 my ($self, $k, $v) = @_;
1039 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1040 my $sql = join ' ', $self->_convert($self->_quote($k)),
1041 $self->_sqlcase($self->{cmp}),
1042 $self->_convert('?');
1043 my @bind = $self->_bindtype($k, $v);
1044 return ( $sql, @bind);
1048 sub _where_hashpair_UNDEF {
1049 my ($self, $k, $v) = @_;
1050 $self->_debug("UNDEF($k) means IS NULL");
1051 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
1055 #======================================================================
1056 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1057 #======================================================================
1060 sub _where_SCALARREF {
1061 my ($self, $where) = @_;
1064 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1070 my ($self, $where) = @_;
1073 $self->_debug("NOREF(*top) means literal SQL: $where");
1084 #======================================================================
1085 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1086 #======================================================================
1089 sub _where_field_BETWEEN {
1090 my ($self, $k, $op, $vals) = @_;
1092 my ($label, $and, $placeholder);
1093 $label = $self->_convert($self->_quote($k));
1094 $and = ' ' . $self->_sqlcase('and') . ' ';
1095 $placeholder = $self->_convert('?');
1096 $op = $self->_sqlcase($op);
1098 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1100 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1101 ARRAYREFREF => sub {
1102 my ($s, @b) = @$$vals;
1103 $self->_assert_bindval_matches_bindtype(@b);
1110 puke $invalid_args if @$vals != 2;
1112 my (@all_sql, @all_bind);
1113 foreach my $val (@$vals) {
1114 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1116 return ($placeholder, $self->_bindtype($k, $val) );
1121 ARRAYREFREF => sub {
1122 my ($sql, @bind) = @$$val;
1123 $self->_assert_bindval_matches_bindtype(@bind);
1124 return ($sql, @bind);
1127 my ($func, $arg, @rest) = %$val;
1128 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1129 if (@rest or $func !~ /^ \- (.+)/x);
1130 $self->_where_unary_op ($1 => $arg);
1136 push @all_sql, $sql;
1137 push @all_bind, @bind;
1141 (join $and, @all_sql),
1150 my $sql = "( $label $op $clause )";
1151 return ($sql, @bind)
1155 sub _where_field_IN {
1156 my ($self, $k, $op, $vals) = @_;
1158 # backwards compatibility : if scalar, force into an arrayref
1159 $vals = [$vals] if defined $vals && ! ref $vals;
1161 my ($label) = $self->_convert($self->_quote($k));
1162 my ($placeholder) = $self->_convert('?');
1163 $op = $self->_sqlcase($op);
1165 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1166 ARRAYREF => sub { # list of choices
1167 if (@$vals) { # nonempty list
1168 my (@all_sql, @all_bind);
1170 for my $val (@$vals) {
1171 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1173 return ($placeholder, $val);
1178 ARRAYREFREF => sub {
1179 my ($sql, @bind) = @$$val;
1180 $self->_assert_bindval_matches_bindtype(@bind);
1181 return ($sql, @bind);
1184 my ($func, $arg, @rest) = %$val;
1185 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1186 if (@rest or $func !~ /^ \- (.+)/x);
1187 $self->_where_unary_op ($1 => $arg);
1191 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1192 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1193 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1194 . 'will emit the logically correct SQL instead of raising this exception)'
1198 push @all_sql, $sql;
1199 push @all_bind, @bind;
1203 sprintf ('%s %s ( %s )',
1206 join (', ', @all_sql)
1208 $self->_bindtype($k, @all_bind),
1211 else { # empty list : some databases won't understand "IN ()", so DWIM
1212 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1217 SCALARREF => sub { # literal SQL
1218 my $sql = $self->_open_outer_paren ($$vals);
1219 return ("$label $op ( $sql )");
1221 ARRAYREFREF => sub { # literal SQL with bind
1222 my ($sql, @bind) = @$$vals;
1223 $self->_assert_bindval_matches_bindtype(@bind);
1224 $sql = $self->_open_outer_paren ($sql);
1225 return ("$label $op ( $sql )", @bind);
1229 puke "Argument passed to the '$op' operator can not be undefined";
1233 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1237 return ($sql, @bind);
1240 # Some databases (SQLite) treat col IN (1, 2) different from
1241 # col IN ( (1, 2) ). Use this to strip all outer parens while
1242 # adding them back in the corresponding method
1243 sub _open_outer_paren {
1244 my ($self, $sql) = @_;
1245 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1250 #======================================================================
1252 #======================================================================
1255 my ($self, $arg) = @_;
1258 for my $c ($self->_order_by_chunks ($arg) ) {
1259 $self->_SWITCH_refkind ($c, {
1260 SCALAR => sub { push @sql, $c },
1261 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1267 $self->_sqlcase(' order by'),
1273 return wantarray ? ($sql, @bind) : $sql;
1276 sub _order_by_chunks {
1277 my ($self, $arg) = @_;
1279 return $self->_SWITCH_refkind($arg, {
1282 map { $self->_order_by_chunks ($_ ) } @$arg;
1285 ARRAYREFREF => sub {
1286 my ($s, @b) = @$$arg;
1287 $self->_assert_bindval_matches_bindtype(@b);
1291 SCALAR => sub {$self->_quote($arg)},
1293 UNDEF => sub {return () },
1295 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1298 # get first pair in hash
1299 my ($key, $val, @rest) = %$arg;
1301 return () unless $key;
1303 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1304 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1310 for my $c ($self->_order_by_chunks ($val)) {
1313 $self->_SWITCH_refkind ($c, {
1318 ($sql, @bind) = @$c;
1322 $sql = $sql . ' ' . $self->_sqlcase($direction);
1324 push @ret, [ $sql, @bind];
1333 #======================================================================
1334 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1335 #======================================================================
1340 $self->_SWITCH_refkind($from, {
1341 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1342 SCALAR => sub {$self->_quote($from)},
1343 SCALARREF => sub {$$from},
1348 #======================================================================
1350 #======================================================================
1352 # highly optimized, as it's called way too often
1354 # my ($self, $label) = @_;
1356 return '' unless defined $_[1];
1357 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1359 unless ($_[0]->{quote_char}) {
1360 $_[0]->_assert_pass_injection_guard($_[1]);
1364 my $qref = ref $_[0]->{quote_char};
1367 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1369 elsif ($qref eq 'ARRAY') {
1370 ($l, $r) = @{$_[0]->{quote_char}};
1373 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1375 my $esc = $_[0]->{escape_char} || $r;
1377 # parts containing * are naturally unquoted
1378 return join( $_[0]->{name_sep}||'', map
1379 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1380 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1385 # Conversion, if applicable
1387 #my ($self, $arg) = @_;
1388 if ($_[0]->{convert}) {
1389 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1396 #my ($self, $col, @vals) = @_;
1397 # called often - tighten code
1398 return $_[0]->{bindtype} eq 'columns'
1399 ? map {[$_[1], $_]} @_[2 .. $#_]
1404 # Dies if any element of @bind is not in [colname => value] format
1405 # if bindtype is 'columns'.
1406 sub _assert_bindval_matches_bindtype {
1407 # my ($self, @bind) = @_;
1409 if ($self->{bindtype} eq 'columns') {
1411 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1412 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1418 sub _join_sql_clauses {
1419 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1421 if (@$clauses_aref > 1) {
1422 my $join = " " . $self->_sqlcase($logic) . " ";
1423 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1424 return ($sql, @$bind_aref);
1426 elsif (@$clauses_aref) {
1427 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1430 return (); # if no SQL, ignore @$bind_aref
1435 # Fix SQL case, if so requested
1437 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1438 # don't touch the argument ... crooked logic, but let's not change it!
1439 return $_[0]->{case} ? $_[1] : uc($_[1]);
1443 #======================================================================
1444 # DISPATCHING FROM REFKIND
1445 #======================================================================
1448 my ($self, $data) = @_;
1450 return 'UNDEF' unless defined $data;
1452 # blessed objects are treated like scalars
1453 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1455 return 'SCALAR' unless $ref;
1458 while ($ref eq 'REF') {
1460 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1464 return ($ref||'SCALAR') . ('REF' x $n_steps);
1468 my ($self, $data) = @_;
1469 my @try = ($self->_refkind($data));
1470 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1471 push @try, 'FALLBACK';
1475 sub _METHOD_FOR_refkind {
1476 my ($self, $meth_prefix, $data) = @_;
1479 for (@{$self->_try_refkind($data)}) {
1480 $method = $self->can($meth_prefix."_".$_)
1484 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1488 sub _SWITCH_refkind {
1489 my ($self, $data, $dispatch_table) = @_;
1492 for (@{$self->_try_refkind($data)}) {
1493 $coderef = $dispatch_table->{$_}
1497 puke "no dispatch entry for ".$self->_refkind($data)
1506 #======================================================================
1507 # VALUES, GENERATE, AUTOLOAD
1508 #======================================================================
1510 # LDNOTE: original code from nwiger, didn't touch code in that section
1511 # I feel the AUTOLOAD stuff should not be the default, it should
1512 # only be activated on explicit demand by user.
1516 my $data = shift || return;
1517 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1518 unless ref $data eq 'HASH';
1521 foreach my $k ( sort keys %$data ) {
1522 my $v = $data->{$k};
1523 $self->_SWITCH_refkind($v, {
1525 if ($self->{array_datatypes}) { # array datatype
1526 push @all_bind, $self->_bindtype($k, $v);
1528 else { # literal SQL with bind
1529 my ($sql, @bind) = @$v;
1530 $self->_assert_bindval_matches_bindtype(@bind);
1531 push @all_bind, @bind;
1534 ARRAYREFREF => sub { # literal SQL with bind
1535 my ($sql, @bind) = @${$v};
1536 $self->_assert_bindval_matches_bindtype(@bind);
1537 push @all_bind, @bind;
1539 SCALARREF => sub { # literal SQL without bind
1541 SCALAR_or_UNDEF => sub {
1542 push @all_bind, $self->_bindtype($k, $v);
1553 my(@sql, @sqlq, @sqlv);
1557 if ($ref eq 'HASH') {
1558 for my $k (sort keys %$_) {
1561 my $label = $self->_quote($k);
1562 if ($r eq 'ARRAY') {
1563 # literal SQL with bind
1564 my ($sql, @bind) = @$v;
1565 $self->_assert_bindval_matches_bindtype(@bind);
1566 push @sqlq, "$label = $sql";
1568 } elsif ($r eq 'SCALAR') {
1569 # literal SQL without bind
1570 push @sqlq, "$label = $$v";
1572 push @sqlq, "$label = ?";
1573 push @sqlv, $self->_bindtype($k, $v);
1576 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1577 } elsif ($ref eq 'ARRAY') {
1578 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1581 if ($r eq 'ARRAY') { # literal SQL with bind
1582 my ($sql, @bind) = @$v;
1583 $self->_assert_bindval_matches_bindtype(@bind);
1586 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1587 # embedded literal SQL
1594 push @sql, '(' . join(', ', @sqlq) . ')';
1595 } elsif ($ref eq 'SCALAR') {
1599 # strings get case twiddled
1600 push @sql, $self->_sqlcase($_);
1604 my $sql = join ' ', @sql;
1606 # this is pretty tricky
1607 # if ask for an array, return ($stmt, @bind)
1608 # otherwise, s/?/shift @sqlv/ to put it inline
1610 return ($sql, @sqlv);
1612 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1613 ref $d ? $d->[1] : $d/e;
1622 # This allows us to check for a local, then _form, attr
1624 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1625 return $self->generate($name, @_);
1636 SQL::Abstract - Generate SQL from Perl data structures
1642 my $sql = SQL::Abstract->new;
1644 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1646 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1648 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1650 my($stmt, @bind) = $sql->delete($table, \%where);
1652 # Then, use these in your DBI statements
1653 my $sth = $dbh->prepare($stmt);
1654 $sth->execute(@bind);
1656 # Just generate the WHERE clause
1657 my($stmt, @bind) = $sql->where(\%where, \@order);
1659 # Return values in the same order, for hashed queries
1660 # See PERFORMANCE section for more details
1661 my @bind = $sql->values(\%fieldvals);
1665 This module was inspired by the excellent L<DBIx::Abstract>.
1666 However, in using that module I found that what I really wanted
1667 to do was generate SQL, but still retain complete control over my
1668 statement handles and use the DBI interface. So, I set out to
1669 create an abstract SQL generation module.
1671 While based on the concepts used by L<DBIx::Abstract>, there are
1672 several important differences, especially when it comes to WHERE
1673 clauses. I have modified the concepts used to make the SQL easier
1674 to generate from Perl data structures and, IMO, more intuitive.
1675 The underlying idea is for this module to do what you mean, based
1676 on the data structures you provide it. The big advantage is that
1677 you don't have to modify your code every time your data changes,
1678 as this module figures it out.
1680 To begin with, an SQL INSERT is as easy as just specifying a hash
1681 of C<key=value> pairs:
1684 name => 'Jimbo Bobson',
1685 phone => '123-456-7890',
1686 address => '42 Sister Lane',
1687 city => 'St. Louis',
1688 state => 'Louisiana',
1691 The SQL can then be generated with this:
1693 my($stmt, @bind) = $sql->insert('people', \%data);
1695 Which would give you something like this:
1697 $stmt = "INSERT INTO people
1698 (address, city, name, phone, state)
1699 VALUES (?, ?, ?, ?, ?)";
1700 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1701 '123-456-7890', 'Louisiana');
1703 These are then used directly in your DBI code:
1705 my $sth = $dbh->prepare($stmt);
1706 $sth->execute(@bind);
1708 =head2 Inserting and Updating Arrays
1710 If your database has array types (like for example Postgres),
1711 activate the special option C<< array_datatypes => 1 >>
1712 when creating the C<SQL::Abstract> object.
1713 Then you may use an arrayref to insert and update database array types:
1715 my $sql = SQL::Abstract->new(array_datatypes => 1);
1717 planets => [qw/Mercury Venus Earth Mars/]
1720 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1724 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1726 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1729 =head2 Inserting and Updating SQL
1731 In order to apply SQL functions to elements of your C<%data> you may
1732 specify a reference to an arrayref for the given hash value. For example,
1733 if you need to execute the Oracle C<to_date> function on a value, you can
1734 say something like this:
1738 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1741 The first value in the array is the actual SQL. Any other values are
1742 optional and would be included in the bind values array. This gives
1745 my($stmt, @bind) = $sql->insert('people', \%data);
1747 $stmt = "INSERT INTO people (name, date_entered)
1748 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1749 @bind = ('Bill', '03/02/2003');
1751 An UPDATE is just as easy, all you change is the name of the function:
1753 my($stmt, @bind) = $sql->update('people', \%data);
1755 Notice that your C<%data> isn't touched; the module will generate
1756 the appropriately quirky SQL for you automatically. Usually you'll
1757 want to specify a WHERE clause for your UPDATE, though, which is
1758 where handling C<%where> hashes comes in handy...
1760 =head2 Complex where statements
1762 This module can generate pretty complicated WHERE statements
1763 easily. For example, simple C<key=value> pairs are taken to mean
1764 equality, and if you want to see if a field is within a set
1765 of values, you can use an arrayref. Let's say we wanted to
1766 SELECT some data based on this criteria:
1769 requestor => 'inna',
1770 worker => ['nwiger', 'rcwe', 'sfz'],
1771 status => { '!=', 'completed' }
1774 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1776 The above would give you something like this:
1778 $stmt = "SELECT * FROM tickets WHERE
1779 ( requestor = ? ) AND ( status != ? )
1780 AND ( worker = ? OR worker = ? OR worker = ? )";
1781 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1783 Which you could then use in DBI code like so:
1785 my $sth = $dbh->prepare($stmt);
1786 $sth->execute(@bind);
1792 The methods are simple. There's one for every major SQL operation,
1793 and a constructor you use first. The arguments are specified in a
1794 similar order for each method (table, then fields, then a where
1795 clause) to try and simplify things.
1797 =head2 new(option => 'value')
1799 The C<new()> function takes a list of options and values, and returns
1800 a new B<SQL::Abstract> object which can then be used to generate SQL
1801 through the methods below. The options accepted are:
1807 If set to 'lower', then SQL will be generated in all lowercase. By
1808 default SQL is generated in "textbook" case meaning something like:
1810 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1812 Any setting other than 'lower' is ignored.
1816 This determines what the default comparison operator is. By default
1817 it is C<=>, meaning that a hash like this:
1819 %where = (name => 'nwiger', email => 'nate@wiger.org');
1821 Will generate SQL like this:
1823 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1825 However, you may want loose comparisons by default, so if you set
1826 C<cmp> to C<like> you would get SQL such as:
1828 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1830 You can also override the comparison on an individual basis - see
1831 the huge section on L</"WHERE CLAUSES"> at the bottom.
1833 =item sqltrue, sqlfalse
1835 Expressions for inserting boolean values within SQL statements.
1836 By default these are C<1=1> and C<1=0>. They are used
1837 by the special operators C<-in> and C<-not_in> for generating
1838 correct SQL even when the argument is an empty array (see below).
1842 This determines the default logical operator for multiple WHERE
1843 statements in arrays or hashes. If absent, the default logic is "or"
1844 for arrays, and "and" for hashes. This means that a WHERE
1848 event_date => {'>=', '2/13/99'},
1849 event_date => {'<=', '4/24/03'},
1852 will generate SQL like this:
1854 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1856 This is probably not what you want given this query, though (look
1857 at the dates). To change the "OR" to an "AND", simply specify:
1859 my $sql = SQL::Abstract->new(logic => 'and');
1861 Which will change the above C<WHERE> to:
1863 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1865 The logic can also be changed locally by inserting
1866 a modifier in front of an arrayref :
1868 @where = (-and => [event_date => {'>=', '2/13/99'},
1869 event_date => {'<=', '4/24/03'} ]);
1871 See the L</"WHERE CLAUSES"> section for explanations.
1875 This will automatically convert comparisons using the specified SQL
1876 function for both column and value. This is mostly used with an argument
1877 of C<upper> or C<lower>, so that the SQL will have the effect of
1878 case-insensitive "searches". For example, this:
1880 $sql = SQL::Abstract->new(convert => 'upper');
1881 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1883 Will turn out the following SQL:
1885 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1887 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1888 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1889 not validate this option; it will just pass through what you specify verbatim).
1893 This is a kludge because many databases suck. For example, you can't
1894 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1895 Instead, you have to use C<bind_param()>:
1897 $sth->bind_param(1, 'reg data');
1898 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1900 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1901 which loses track of which field each slot refers to. Fear not.
1903 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1904 Currently, you can specify either C<normal> (default) or C<columns>. If you
1905 specify C<columns>, you will get an array that looks like this:
1907 my $sql = SQL::Abstract->new(bindtype => 'columns');
1908 my($stmt, @bind) = $sql->insert(...);
1911 [ 'column1', 'value1' ],
1912 [ 'column2', 'value2' ],
1913 [ 'column3', 'value3' ],
1916 You can then iterate through this manually, using DBI's C<bind_param()>.
1918 $sth->prepare($stmt);
1921 my($col, $data) = @$_;
1922 if ($col eq 'details' || $col eq 'comments') {
1923 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1924 } elsif ($col eq 'image') {
1925 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1927 $sth->bind_param($i, $data);
1931 $sth->execute; # execute without @bind now
1933 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1934 Basically, the advantage is still that you don't have to care which fields
1935 are or are not included. You could wrap that above C<for> loop in a simple
1936 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1937 get a layer of abstraction over manual SQL specification.
1939 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
1940 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1941 will expect the bind values in this format.
1945 This is the character that a table or column name will be quoted
1946 with. By default this is an empty string, but you could set it to
1947 the character C<`>, to generate SQL like this:
1949 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1951 Alternatively, you can supply an array ref of two items, the first being the left
1952 hand quote character, and the second the right hand quote character. For
1953 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1954 that generates SQL like this:
1956 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1958 Quoting is useful if you have tables or columns names that are reserved
1959 words in your database's SQL dialect.
1963 This is the character that will be used to escape L</quote_char>s appearing
1964 in an identifier before it has been quoted.
1966 The parameter default in case of a single L</quote_char> character is the quote
1969 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1970 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
1971 of the B<opening (left)> L</quote_char> within the identifier are currently left
1972 untouched. The default for opening-closing-style quotes may change in future
1973 versions, thus you are B<strongly encouraged> to specify the escape character
1978 This is the character that separates a table and column name. It is
1979 necessary to specify this when the C<quote_char> option is selected,
1980 so that tables and column names can be individually quoted like this:
1982 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1984 =item injection_guard
1986 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1987 column name specified in a query structure. This is a safety mechanism to avoid
1988 injection attacks when mishandling user input e.g.:
1990 my %condition_as_column_value_pairs = get_values_from_user();
1991 $sqla->select( ... , \%condition_as_column_value_pairs );
1993 If the expression matches an exception is thrown. Note that literal SQL
1994 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1996 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1998 =item array_datatypes
2000 When this option is true, arrayrefs in INSERT or UPDATE are
2001 interpreted as array datatypes and are passed directly
2003 When this option is false, arrayrefs are interpreted
2004 as literal SQL, just like refs to arrayrefs
2005 (but this behavior is for backwards compatibility; when writing
2006 new queries, use the "reference to arrayref" syntax
2012 Takes a reference to a list of "special operators"
2013 to extend the syntax understood by L<SQL::Abstract>.
2014 See section L</"SPECIAL OPERATORS"> for details.
2018 Takes a reference to a list of "unary operators"
2019 to extend the syntax understood by L<SQL::Abstract>.
2020 See section L</"UNARY OPERATORS"> for details.
2026 =head2 insert($table, \@values || \%fieldvals, \%options)
2028 This is the simplest function. You simply give it a table name
2029 and either an arrayref of values or hashref of field/value pairs.
2030 It returns an SQL INSERT statement and a list of bind values.
2031 See the sections on L</"Inserting and Updating Arrays"> and
2032 L</"Inserting and Updating SQL"> for information on how to insert
2033 with those data types.
2035 The optional C<\%options> hash reference may contain additional
2036 options to generate the insert SQL. Currently supported options
2043 Takes either a scalar of raw SQL fields, or an array reference of
2044 field names, and adds on an SQL C<RETURNING> statement at the end.
2045 This allows you to return data generated by the insert statement
2046 (such as row IDs) without performing another C<SELECT> statement.
2047 Note, however, this is not part of the SQL standard and may not
2048 be supported by all database engines.
2052 =head2 update($table, \%fieldvals, \%where)
2054 This takes a table, hashref of field/value pairs, and an optional
2055 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2057 See the sections on L</"Inserting and Updating Arrays"> and
2058 L</"Inserting and Updating SQL"> for information on how to insert
2059 with those data types.
2061 =head2 select($source, $fields, $where, $order)
2063 This returns a SQL SELECT statement and associated list of bind values, as
2064 specified by the arguments :
2070 Specification of the 'FROM' part of the statement.
2071 The argument can be either a plain scalar (interpreted as a table
2072 name, will be quoted), or an arrayref (interpreted as a list
2073 of table names, joined by commas, quoted), or a scalarref
2074 (literal table name, not quoted), or a ref to an arrayref
2075 (list of literal table names, joined by commas, not quoted).
2079 Specification of the list of fields to retrieve from
2081 The argument can be either an arrayref (interpreted as a list
2082 of field names, will be joined by commas and quoted), or a
2083 plain scalar (literal SQL, not quoted).
2084 Please observe that this API is not as flexible as that of
2085 the first argument C<$source>, for backwards compatibility reasons.
2089 Optional argument to specify the WHERE part of the query.
2090 The argument is most often a hashref, but can also be
2091 an arrayref or plain scalar --
2092 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2096 Optional argument to specify the ORDER BY part of the query.
2097 The argument can be a scalar, a hashref or an arrayref
2098 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2104 =head2 delete($table, \%where)
2106 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2107 It returns an SQL DELETE statement and list of bind values.
2109 =head2 where(\%where, \@order)
2111 This is used to generate just the WHERE clause. For example,
2112 if you have an arbitrary data structure and know what the
2113 rest of your SQL is going to look like, but want an easy way
2114 to produce a WHERE clause, use this. It returns an SQL WHERE
2115 clause and list of bind values.
2118 =head2 values(\%data)
2120 This just returns the values from the hash C<%data>, in the same
2121 order that would be returned from any of the other above queries.
2122 Using this allows you to markedly speed up your queries if you
2123 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2125 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2127 Warning: This is an experimental method and subject to change.
2129 This returns arbitrarily generated SQL. It's a really basic shortcut.
2130 It will return two different things, depending on return context:
2132 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2133 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2135 These would return the following:
2137 # First calling form
2138 $stmt = "CREATE TABLE test (?, ?)";
2139 @bind = (field1, field2);
2141 # Second calling form
2142 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2144 Depending on what you're trying to do, it's up to you to choose the correct
2145 format. In this example, the second form is what you would want.
2149 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2153 ALTER SESSION SET nls_date_format = 'MM/YY'
2155 You get the idea. Strings get their case twiddled, but everything
2156 else remains verbatim.
2158 =head1 EXPORTABLE FUNCTIONS
2160 =head2 is_plain_value
2162 Determines if the supplied argument is a plain value as understood by this
2167 =item * The value is C<undef>
2169 =item * The value is a non-reference
2171 =item * The value is an object with stringification overloading
2173 =item * The value is of the form C<< { -value => $anything } >>
2177 On failure returns C<undef>, on sucess returns a B<scalar> reference
2178 to the original supplied argument.
2184 The stringification overloading detection is rather advanced: it takes
2185 into consideration not only the presence of a C<""> overload, but if that
2186 fails also checks for enabled
2187 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2188 on either C<0+> or C<bool>.
2190 Unfortunately testing in the field indicates that this
2191 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2192 but only when very large numbers of stringifying objects are involved.
2193 At the time of writing ( Sep 2014 ) there is no clear explanation of
2194 the direct cause, nor is there a manageably small test case that reliably
2195 reproduces the problem.
2197 If you encounter any of the following exceptions in B<random places within
2198 your application stack> - this module may be to blame:
2200 Operation "ne": no method found,
2201 left argument in overloaded package <something>,
2202 right argument in overloaded package <something>
2206 Stub found while resolving method "???" overloading """" in package <something>
2208 If you fall victim to the above - please attempt to reduce the problem
2209 to something that could be sent to the L<SQL::Abstract developers
2210 |DBIx::Class/GETTING HELP/SUPPORT>
2211 (either publicly or privately). As a workaround in the meantime you can
2212 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2213 value, which will most likely eliminate your problem (at the expense of
2214 not being able to properly detect exotic forms of stringification).
2216 This notice and environment variable will be removed in a future version,
2217 as soon as the underlying problem is found and a reliable workaround is
2222 =head2 is_literal_value
2224 Determines if the supplied argument is a literal value as understood by this
2229 =item * C<\$sql_string>
2231 =item * C<\[ $sql_string, @bind_values ]>
2235 On failure returns C<undef>, on sucess returns an B<array> reference
2236 containing the unpacked version of the supplied literal SQL and bind values.
2238 =head1 WHERE CLAUSES
2242 This module uses a variation on the idea from L<DBIx::Abstract>. It
2243 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2244 module is that things in arrays are OR'ed, and things in hashes
2247 The easiest way to explain is to show lots of examples. After
2248 each C<%where> hash shown, it is assumed you used:
2250 my($stmt, @bind) = $sql->where(\%where);
2252 However, note that the C<%where> hash can be used directly in any
2253 of the other functions as well, as described above.
2255 =head2 Key-value pairs
2257 So, let's get started. To begin, a simple hash:
2261 status => 'completed'
2264 Is converted to SQL C<key = val> statements:
2266 $stmt = "WHERE user = ? AND status = ?";
2267 @bind = ('nwiger', 'completed');
2269 One common thing I end up doing is having a list of values that
2270 a field can be in. To do this, simply specify a list inside of
2275 status => ['assigned', 'in-progress', 'pending'];
2278 This simple code will create the following:
2280 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2281 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2283 A field associated to an empty arrayref will be considered a
2284 logical false and will generate 0=1.
2286 =head2 Tests for NULL values
2288 If the value part is C<undef> then this is converted to SQL <IS NULL>
2297 $stmt = "WHERE user = ? AND status IS NULL";
2300 To test if a column IS NOT NULL:
2304 status => { '!=', undef },
2307 =head2 Specific comparison operators
2309 If you want to specify a different type of operator for your comparison,
2310 you can use a hashref for a given column:
2314 status => { '!=', 'completed' }
2317 Which would generate:
2319 $stmt = "WHERE user = ? AND status != ?";
2320 @bind = ('nwiger', 'completed');
2322 To test against multiple values, just enclose the values in an arrayref:
2324 status => { '=', ['assigned', 'in-progress', 'pending'] };
2326 Which would give you:
2328 "WHERE status = ? OR status = ? OR status = ?"
2331 The hashref can also contain multiple pairs, in which case it is expanded
2332 into an C<AND> of its elements:
2336 status => { '!=', 'completed', -not_like => 'pending%' }
2339 # Or more dynamically, like from a form
2340 $where{user} = 'nwiger';
2341 $where{status}{'!='} = 'completed';
2342 $where{status}{'-not_like'} = 'pending%';
2344 # Both generate this
2345 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2346 @bind = ('nwiger', 'completed', 'pending%');
2349 To get an OR instead, you can combine it with the arrayref idea:
2353 priority => [ { '=', 2 }, { '>', 5 } ]
2356 Which would generate:
2358 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2359 @bind = ('2', '5', 'nwiger');
2361 If you want to include literal SQL (with or without bind values), just use a
2362 scalar reference or reference to an arrayref as the value:
2365 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2366 date_expires => { '<' => \"now()" }
2369 Which would generate:
2371 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2372 @bind = ('11/26/2008');
2375 =head2 Logic and nesting operators
2377 In the example above,
2378 there is a subtle trap if you want to say something like
2379 this (notice the C<AND>):
2381 WHERE priority != ? AND priority != ?
2383 Because, in Perl you I<can't> do this:
2385 priority => { '!=' => 2, '!=' => 1 }
2387 As the second C<!=> key will obliterate the first. The solution
2388 is to use the special C<-modifier> form inside an arrayref:
2390 priority => [ -and => {'!=', 2},
2394 Normally, these would be joined by C<OR>, but the modifier tells it
2395 to use C<AND> instead. (Hint: You can use this in conjunction with the
2396 C<logic> option to C<new()> in order to change the way your queries
2397 work by default.) B<Important:> Note that the C<-modifier> goes
2398 B<INSIDE> the arrayref, as an extra first element. This will
2399 B<NOT> do what you think it might:
2401 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2403 Here is a quick list of equivalencies, since there is some overlap:
2406 status => {'!=', 'completed', 'not like', 'pending%' }
2407 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2410 status => {'=', ['assigned', 'in-progress']}
2411 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2412 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2416 =head2 Special operators : IN, BETWEEN, etc.
2418 You can also use the hashref format to compare a list of fields using the
2419 C<IN> comparison operator, by specifying the list as an arrayref:
2422 status => 'completed',
2423 reportid => { -in => [567, 2335, 2] }
2426 Which would generate:
2428 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2429 @bind = ('completed', '567', '2335', '2');
2431 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2434 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2435 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2436 'sqltrue' (by default : C<1=1>).
2438 In addition to the array you can supply a chunk of literal sql or
2439 literal sql with bind:
2442 customer => { -in => \[
2443 'SELECT cust_id FROM cust WHERE balance > ?',
2446 status => { -in => \'SELECT status_codes FROM states' },
2452 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2453 AND status IN ( SELECT status_codes FROM states )
2457 Finally, if the argument to C<-in> is not a reference, it will be
2458 treated as a single-element array.
2460 Another pair of operators is C<-between> and C<-not_between>,
2461 used with an arrayref of two values:
2465 completion_date => {
2466 -not_between => ['2002-10-01', '2003-02-06']
2472 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2474 Just like with C<-in> all plausible combinations of literal SQL
2478 start0 => { -between => [ 1, 2 ] },
2479 start1 => { -between => \["? AND ?", 1, 2] },
2480 start2 => { -between => \"lower(x) AND upper(y)" },
2481 start3 => { -between => [
2483 \["upper(?)", 'stuff' ],
2490 ( start0 BETWEEN ? AND ? )
2491 AND ( start1 BETWEEN ? AND ? )
2492 AND ( start2 BETWEEN lower(x) AND upper(y) )
2493 AND ( start3 BETWEEN lower(x) AND upper(?) )
2495 @bind = (1, 2, 1, 2, 'stuff');
2498 These are the two builtin "special operators"; but the
2499 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2501 =head2 Unary operators: bool
2503 If you wish to test against boolean columns or functions within your
2504 database you can use the C<-bool> and C<-not_bool> operators. For
2505 example to test the column C<is_user> being true and the column
2506 C<is_enabled> being false you would use:-
2510 -not_bool => 'is_enabled',
2515 WHERE is_user AND NOT is_enabled
2517 If a more complex combination is required, testing more conditions,
2518 then you should use the and/or operators:-
2523 -not_bool => { two=> { -rlike => 'bar' } },
2524 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2535 (NOT ( three = ? OR three > ? ))
2538 =head2 Nested conditions, -and/-or prefixes
2540 So far, we've seen how multiple conditions are joined with a top-level
2541 C<AND>. We can change this by putting the different conditions we want in
2542 hashes and then putting those hashes in an array. For example:
2547 status => { -like => ['pending%', 'dispatched'] },
2551 status => 'unassigned',
2555 This data structure would create the following:
2557 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2558 OR ( user = ? AND status = ? ) )";
2559 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2562 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2563 to change the logic inside :
2569 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2570 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2577 $stmt = "WHERE ( user = ?
2578 AND ( ( workhrs > ? AND geo = ? )
2579 OR ( workhrs < ? OR geo = ? ) ) )";
2580 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2582 =head3 Algebraic inconsistency, for historical reasons
2584 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2585 operator goes C<outside> of the nested structure; whereas when connecting
2586 several constraints on one column, the C<-and> operator goes
2587 C<inside> the arrayref. Here is an example combining both features :
2590 -and => [a => 1, b => 2],
2591 -or => [c => 3, d => 4],
2592 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2597 WHERE ( ( ( a = ? AND b = ? )
2598 OR ( c = ? OR d = ? )
2599 OR ( e LIKE ? AND e LIKE ? ) ) )
2601 This difference in syntax is unfortunate but must be preserved for
2602 historical reasons. So be careful : the two examples below would
2603 seem algebraically equivalent, but they are not
2605 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2606 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2608 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2609 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2612 =head2 Literal SQL and value type operators
2614 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2615 side" is a column name and the "right side" is a value (normally rendered as
2616 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2617 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2618 alter this behavior. There are several ways of doing so.
2622 This is a virtual operator that signals the string to its right side is an
2623 identifier (a column name) and not a value. For example to compare two
2624 columns you would write:
2627 priority => { '<', 2 },
2628 requestor => { -ident => 'submitter' },
2633 $stmt = "WHERE priority < ? AND requestor = submitter";
2636 If you are maintaining legacy code you may see a different construct as
2637 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2642 This is a virtual operator that signals that the construct to its right side
2643 is a value to be passed to DBI. This is for example necessary when you want
2644 to write a where clause against an array (for RDBMS that support such
2645 datatypes). For example:
2648 array => { -value => [1, 2, 3] }
2653 $stmt = 'WHERE array = ?';
2654 @bind = ([1, 2, 3]);
2656 Note that if you were to simply say:
2662 the result would probably not be what you wanted:
2664 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2669 Finally, sometimes only literal SQL will do. To include a random snippet
2670 of SQL verbatim, you specify it as a scalar reference. Consider this only
2671 as a last resort. Usually there is a better way. For example:
2674 priority => { '<', 2 },
2675 requestor => { -in => \'(SELECT name FROM hitmen)' },
2680 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2683 Note that in this example, you only get one bind parameter back, since
2684 the verbatim SQL is passed as part of the statement.
2688 Never use untrusted input as a literal SQL argument - this is a massive
2689 security risk (there is no way to check literal snippets for SQL
2690 injections and other nastyness). If you need to deal with untrusted input
2691 use literal SQL with placeholders as described next.
2693 =head3 Literal SQL with placeholders and bind values (subqueries)
2695 If the literal SQL to be inserted has placeholders and bind values,
2696 use a reference to an arrayref (yes this is a double reference --
2697 not so common, but perfectly legal Perl). For example, to find a date
2698 in Postgres you can use something like this:
2701 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2706 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2709 Note that you must pass the bind values in the same format as they are returned
2710 by L<where|/where(\%where, \@order)>. This means that if you set L</bindtype>
2711 to C<columns>, you must provide the bind values in the
2712 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2713 scalar value; most commonly the column name, but you can use any scalar value
2714 (including references and blessed references), L<SQL::Abstract> will simply
2715 pass it through intact. So if C<bindtype> is set to C<columns> the above
2716 example will look like:
2719 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2722 Literal SQL is especially useful for nesting parenthesized clauses in the
2723 main SQL query. Here is a first example :
2725 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2729 bar => \["IN ($sub_stmt)" => @sub_bind],
2734 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2735 WHERE c2 < ? AND c3 LIKE ?))";
2736 @bind = (1234, 100, "foo%");
2738 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2739 are expressed in the same way. Of course the C<$sub_stmt> and
2740 its associated bind values can be generated through a former call
2743 my ($sub_stmt, @sub_bind)
2744 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2745 c3 => {-like => "foo%"}});
2748 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2751 In the examples above, the subquery was used as an operator on a column;
2752 but the same principle also applies for a clause within the main C<%where>
2753 hash, like an EXISTS subquery :
2755 my ($sub_stmt, @sub_bind)
2756 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2757 my %where = ( -and => [
2759 \["EXISTS ($sub_stmt)" => @sub_bind],
2764 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2765 WHERE c1 = ? AND c2 > t0.c0))";
2769 Observe that the condition on C<c2> in the subquery refers to
2770 column C<t0.c0> of the main query : this is I<not> a bind
2771 value, so we have to express it through a scalar ref.
2772 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2773 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2774 what we wanted here.
2776 Finally, here is an example where a subquery is used
2777 for expressing unary negation:
2779 my ($sub_stmt, @sub_bind)
2780 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2781 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2783 lname => {like => '%son%'},
2784 \["NOT ($sub_stmt)" => @sub_bind],
2789 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2790 @bind = ('%son%', 10, 20)
2792 =head3 Deprecated usage of Literal SQL
2794 Below are some examples of archaic use of literal SQL. It is shown only as
2795 reference for those who deal with legacy code. Each example has a much
2796 better, cleaner and safer alternative that users should opt for in new code.
2802 my %where = ( requestor => \'IS NOT NULL' )
2804 $stmt = "WHERE requestor IS NOT NULL"
2806 This used to be the way of generating NULL comparisons, before the handling
2807 of C<undef> got formalized. For new code please use the superior syntax as
2808 described in L</Tests for NULL values>.
2812 my %where = ( requestor => \'= submitter' )
2814 $stmt = "WHERE requestor = submitter"
2816 This used to be the only way to compare columns. Use the superior L</-ident>
2817 method for all new code. For example an identifier declared in such a way
2818 will be properly quoted if L</quote_char> is properly set, while the legacy
2819 form will remain as supplied.
2823 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2825 $stmt = "WHERE completed > ? AND is_ready"
2826 @bind = ('2012-12-21')
2828 Using an empty string literal used to be the only way to express a boolean.
2829 For all new code please use the much more readable
2830 L<-bool|/Unary operators: bool> operator.
2836 These pages could go on for a while, since the nesting of the data
2837 structures this module can handle are pretty much unlimited (the
2838 module implements the C<WHERE> expansion as a recursive function
2839 internally). Your best bet is to "play around" with the module a
2840 little to see how the data structures behave, and choose the best
2841 format for your data based on that.
2843 And of course, all the values above will probably be replaced with
2844 variables gotten from forms or the command line. After all, if you
2845 knew everything ahead of time, you wouldn't have to worry about
2846 dynamically-generating SQL and could just hardwire it into your
2849 =head1 ORDER BY CLAUSES
2851 Some functions take an order by clause. This can either be a scalar (just a
2852 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2853 or an array of either of the two previous forms. Examples:
2855 Given | Will Generate
2856 ----------------------------------------------------------
2858 \'colA DESC' | ORDER BY colA DESC
2860 'colA' | ORDER BY colA
2862 [qw/colA colB/] | ORDER BY colA, colB
2864 {-asc => 'colA'} | ORDER BY colA ASC
2866 {-desc => 'colB'} | ORDER BY colB DESC
2868 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2870 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2873 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2874 { -desc => [qw/colB/], | colC ASC, colD ASC
2875 { -asc => [qw/colC colD/],|
2877 ===========================================================
2881 =head1 SPECIAL OPERATORS
2883 my $sqlmaker = SQL::Abstract->new(special_ops => [
2887 my ($self, $field, $op, $arg) = @_;
2893 handler => 'method_name',
2897 A "special operator" is a SQL syntactic clause that can be
2898 applied to a field, instead of a usual binary operator.
2901 WHERE field IN (?, ?, ?)
2902 WHERE field BETWEEN ? AND ?
2903 WHERE MATCH(field) AGAINST (?, ?)
2905 Special operators IN and BETWEEN are fairly standard and therefore
2906 are builtin within C<SQL::Abstract> (as the overridable methods
2907 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2908 like the MATCH .. AGAINST example above which is specific to MySQL,
2909 you can write your own operator handlers - supply a C<special_ops>
2910 argument to the C<new> method. That argument takes an arrayref of
2911 operator definitions; each operator definition is a hashref with two
2918 the regular expression to match the operator
2922 Either a coderef or a plain scalar method name. In both cases
2923 the expected return is C<< ($sql, @bind) >>.
2925 When supplied with a method name, it is simply called on the
2926 L<SQL::Abstract> object as:
2928 $self->$method_name ($field, $op, $arg)
2932 $field is the LHS of the operator
2933 $op is the part that matched the handler regex
2936 When supplied with a coderef, it is called as:
2938 $coderef->($self, $field, $op, $arg)
2943 For example, here is an implementation
2944 of the MATCH .. AGAINST syntax for MySQL
2946 my $sqlmaker = SQL::Abstract->new(special_ops => [
2948 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2949 {regex => qr/^match$/i,
2951 my ($self, $field, $op, $arg) = @_;
2952 $arg = [$arg] if not ref $arg;
2953 my $label = $self->_quote($field);
2954 my ($placeholder) = $self->_convert('?');
2955 my $placeholders = join ", ", (($placeholder) x @$arg);
2956 my $sql = $self->_sqlcase('match') . " ($label) "
2957 . $self->_sqlcase('against') . " ($placeholders) ";
2958 my @bind = $self->_bindtype($field, @$arg);
2959 return ($sql, @bind);
2966 =head1 UNARY OPERATORS
2968 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2972 my ($self, $op, $arg) = @_;
2978 handler => 'method_name',
2982 A "unary operator" is a SQL syntactic clause that can be
2983 applied to a field - the operator goes before the field
2985 You can write your own operator handlers - supply a C<unary_ops>
2986 argument to the C<new> method. That argument takes an arrayref of
2987 operator definitions; each operator definition is a hashref with two
2994 the regular expression to match the operator
2998 Either a coderef or a plain scalar method name. In both cases
2999 the expected return is C<< $sql >>.
3001 When supplied with a method name, it is simply called on the
3002 L<SQL::Abstract> object as:
3004 $self->$method_name ($op, $arg)
3008 $op is the part that matched the handler regex
3009 $arg is the RHS or argument of the operator
3011 When supplied with a coderef, it is called as:
3013 $coderef->($self, $op, $arg)
3021 Thanks to some benchmarking by Mark Stosberg, it turns out that
3022 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3023 I must admit this wasn't an intentional design issue, but it's a
3024 byproduct of the fact that you get to control your C<DBI> handles
3027 To maximize performance, use a code snippet like the following:
3029 # prepare a statement handle using the first row
3030 # and then reuse it for the rest of the rows
3032 for my $href (@array_of_hashrefs) {
3033 $stmt ||= $sql->insert('table', $href);
3034 $sth ||= $dbh->prepare($stmt);
3035 $sth->execute($sql->values($href));
3038 The reason this works is because the keys in your C<$href> are sorted
3039 internally by B<SQL::Abstract>. Thus, as long as your data retains
3040 the same structure, you only have to generate the SQL the first time
3041 around. On subsequent queries, simply use the C<values> function provided
3042 by this module to return your values in the correct order.
3044 However this depends on the values having the same type - if, for
3045 example, the values of a where clause may either have values
3046 (resulting in sql of the form C<column = ?> with a single bind
3047 value), or alternatively the values might be C<undef> (resulting in
3048 sql of the form C<column IS NULL> with no bind value) then the
3049 caching technique suggested will not work.
3053 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3054 really like this part (I do, at least). Building up a complex query
3055 can be as simple as the following:
3062 use CGI::FormBuilder;
3065 my $form = CGI::FormBuilder->new(...);
3066 my $sql = SQL::Abstract->new;
3068 if ($form->submitted) {
3069 my $field = $form->field;
3070 my $id = delete $field->{id};
3071 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3074 Of course, you would still have to connect using C<DBI> to run the
3075 query, but the point is that if you make your form look like your
3076 table, the actual query script can be extremely simplistic.
3078 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3079 a fast interface to returning and formatting data. I frequently
3080 use these three modules together to write complex database query
3081 apps in under 50 lines.
3083 =head1 HOW TO CONTRIBUTE
3085 Contributions are always welcome, in all usable forms (we especially
3086 welcome documentation improvements). The delivery methods include git-
3087 or unified-diff formatted patches, GitHub pull requests, or plain bug
3088 reports either via RT or the Mailing list. Contributors are generally
3089 granted full access to the official repository after their first several
3090 patches pass successful review.
3092 This project is maintained in a git repository. The code and related tools are
3093 accessible at the following locations:
3097 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3099 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3101 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3103 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3109 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3110 Great care has been taken to preserve the I<published> behavior
3111 documented in previous versions in the 1.* family; however,
3112 some features that were previously undocumented, or behaved
3113 differently from the documentation, had to be changed in order
3114 to clarify the semantics. Hence, client code that was relying
3115 on some dark areas of C<SQL::Abstract> v1.*
3116 B<might behave differently> in v1.50.
3118 The main changes are :
3124 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3128 support for the { operator => \"..." } construct (to embed literal SQL)
3132 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3136 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3140 defensive programming : check arguments
3144 fixed bug with global logic, which was previously implemented
3145 through global variables yielding side-effects. Prior versions would
3146 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3147 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3148 Now this is interpreted
3149 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3154 fixed semantics of _bindtype on array args
3158 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3159 we just avoid shifting arrays within that tree.
3163 dropped the C<_modlogic> function
3167 =head1 ACKNOWLEDGEMENTS
3169 There are a number of individuals that have really helped out with
3170 this module. Unfortunately, most of them submitted bugs via CPAN
3171 so I have no idea who they are! But the people I do know are:
3173 Ash Berlin (order_by hash term support)
3174 Matt Trout (DBIx::Class support)
3175 Mark Stosberg (benchmarking)
3176 Chas Owens (initial "IN" operator support)
3177 Philip Collins (per-field SQL functions)
3178 Eric Kolve (hashref "AND" support)
3179 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3180 Dan Kubb (support for "quote_char" and "name_sep")
3181 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3182 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3183 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3184 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3185 Oliver Charles (support for "RETURNING" after "INSERT")
3191 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3195 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3197 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3199 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3200 While not an official support venue, C<DBIx::Class> makes heavy use of
3201 C<SQL::Abstract>, and as such list members there are very familiar with
3202 how to create queries.
3206 This module is free software; you may copy this under the same
3207 terms as perl itself (either the GNU General Public License or
3208 the Artistic License)