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.80';
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) = @_;
1246 while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
1248 # there are closing parens inside, need the heavy duty machinery
1249 # to reevaluate the extraction starting from $sql (full reevaluation)
1250 if ( $inner =~ /\)/ ) {
1251 require Text::Balanced;
1253 my (undef, $remainder) = do {
1254 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1256 Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
1259 # the entire expression needs to be a balanced bracketed thing
1260 # (after an extract no remainder sans trailing space)
1261 last if defined $remainder and $remainder =~ /\S/;
1271 #======================================================================
1273 #======================================================================
1276 my ($self, $arg) = @_;
1279 for my $c ($self->_order_by_chunks ($arg) ) {
1280 $self->_SWITCH_refkind ($c, {
1281 SCALAR => sub { push @sql, $c },
1282 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1288 $self->_sqlcase(' order by'),
1294 return wantarray ? ($sql, @bind) : $sql;
1297 sub _order_by_chunks {
1298 my ($self, $arg) = @_;
1300 return $self->_SWITCH_refkind($arg, {
1303 map { $self->_order_by_chunks ($_ ) } @$arg;
1306 ARRAYREFREF => sub {
1307 my ($s, @b) = @$$arg;
1308 $self->_assert_bindval_matches_bindtype(@b);
1312 SCALAR => sub {$self->_quote($arg)},
1314 UNDEF => sub {return () },
1316 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1319 # get first pair in hash
1320 my ($key, $val, @rest) = %$arg;
1322 return () unless $key;
1324 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1325 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1331 for my $c ($self->_order_by_chunks ($val)) {
1334 $self->_SWITCH_refkind ($c, {
1339 ($sql, @bind) = @$c;
1343 $sql = $sql . ' ' . $self->_sqlcase($direction);
1345 push @ret, [ $sql, @bind];
1354 #======================================================================
1355 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1356 #======================================================================
1361 $self->_SWITCH_refkind($from, {
1362 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1363 SCALAR => sub {$self->_quote($from)},
1364 SCALARREF => sub {$$from},
1369 #======================================================================
1371 #======================================================================
1373 # highly optimized, as it's called way too often
1375 # my ($self, $label) = @_;
1377 return '' unless defined $_[1];
1378 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1380 unless ($_[0]->{quote_char}) {
1381 $_[0]->_assert_pass_injection_guard($_[1]);
1385 my $qref = ref $_[0]->{quote_char};
1388 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1390 elsif ($qref eq 'ARRAY') {
1391 ($l, $r) = @{$_[0]->{quote_char}};
1394 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1396 my $esc = $_[0]->{escape_char} || $r;
1398 # parts containing * are naturally unquoted
1399 return join( $_[0]->{name_sep}||'', map
1400 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1401 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1406 # Conversion, if applicable
1408 #my ($self, $arg) = @_;
1409 if ($_[0]->{convert}) {
1410 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1417 #my ($self, $col, @vals) = @_;
1418 # called often - tighten code
1419 return $_[0]->{bindtype} eq 'columns'
1420 ? map {[$_[1], $_]} @_[2 .. $#_]
1425 # Dies if any element of @bind is not in [colname => value] format
1426 # if bindtype is 'columns'.
1427 sub _assert_bindval_matches_bindtype {
1428 # my ($self, @bind) = @_;
1430 if ($self->{bindtype} eq 'columns') {
1432 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1433 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1439 sub _join_sql_clauses {
1440 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1442 if (@$clauses_aref > 1) {
1443 my $join = " " . $self->_sqlcase($logic) . " ";
1444 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1445 return ($sql, @$bind_aref);
1447 elsif (@$clauses_aref) {
1448 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1451 return (); # if no SQL, ignore @$bind_aref
1456 # Fix SQL case, if so requested
1458 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1459 # don't touch the argument ... crooked logic, but let's not change it!
1460 return $_[0]->{case} ? $_[1] : uc($_[1]);
1464 #======================================================================
1465 # DISPATCHING FROM REFKIND
1466 #======================================================================
1469 my ($self, $data) = @_;
1471 return 'UNDEF' unless defined $data;
1473 # blessed objects are treated like scalars
1474 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1476 return 'SCALAR' unless $ref;
1479 while ($ref eq 'REF') {
1481 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1485 return ($ref||'SCALAR') . ('REF' x $n_steps);
1489 my ($self, $data) = @_;
1490 my @try = ($self->_refkind($data));
1491 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1492 push @try, 'FALLBACK';
1496 sub _METHOD_FOR_refkind {
1497 my ($self, $meth_prefix, $data) = @_;
1500 for (@{$self->_try_refkind($data)}) {
1501 $method = $self->can($meth_prefix."_".$_)
1505 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1509 sub _SWITCH_refkind {
1510 my ($self, $data, $dispatch_table) = @_;
1513 for (@{$self->_try_refkind($data)}) {
1514 $coderef = $dispatch_table->{$_}
1518 puke "no dispatch entry for ".$self->_refkind($data)
1527 #======================================================================
1528 # VALUES, GENERATE, AUTOLOAD
1529 #======================================================================
1531 # LDNOTE: original code from nwiger, didn't touch code in that section
1532 # I feel the AUTOLOAD stuff should not be the default, it should
1533 # only be activated on explicit demand by user.
1537 my $data = shift || return;
1538 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1539 unless ref $data eq 'HASH';
1542 foreach my $k ( sort keys %$data ) {
1543 my $v = $data->{$k};
1544 $self->_SWITCH_refkind($v, {
1546 if ($self->{array_datatypes}) { # array datatype
1547 push @all_bind, $self->_bindtype($k, $v);
1549 else { # literal SQL with bind
1550 my ($sql, @bind) = @$v;
1551 $self->_assert_bindval_matches_bindtype(@bind);
1552 push @all_bind, @bind;
1555 ARRAYREFREF => sub { # literal SQL with bind
1556 my ($sql, @bind) = @${$v};
1557 $self->_assert_bindval_matches_bindtype(@bind);
1558 push @all_bind, @bind;
1560 SCALARREF => sub { # literal SQL without bind
1562 SCALAR_or_UNDEF => sub {
1563 push @all_bind, $self->_bindtype($k, $v);
1574 my(@sql, @sqlq, @sqlv);
1578 if ($ref eq 'HASH') {
1579 for my $k (sort keys %$_) {
1582 my $label = $self->_quote($k);
1583 if ($r eq 'ARRAY') {
1584 # literal SQL with bind
1585 my ($sql, @bind) = @$v;
1586 $self->_assert_bindval_matches_bindtype(@bind);
1587 push @sqlq, "$label = $sql";
1589 } elsif ($r eq 'SCALAR') {
1590 # literal SQL without bind
1591 push @sqlq, "$label = $$v";
1593 push @sqlq, "$label = ?";
1594 push @sqlv, $self->_bindtype($k, $v);
1597 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1598 } elsif ($ref eq 'ARRAY') {
1599 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1602 if ($r eq 'ARRAY') { # literal SQL with bind
1603 my ($sql, @bind) = @$v;
1604 $self->_assert_bindval_matches_bindtype(@bind);
1607 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1608 # embedded literal SQL
1615 push @sql, '(' . join(', ', @sqlq) . ')';
1616 } elsif ($ref eq 'SCALAR') {
1620 # strings get case twiddled
1621 push @sql, $self->_sqlcase($_);
1625 my $sql = join ' ', @sql;
1627 # this is pretty tricky
1628 # if ask for an array, return ($stmt, @bind)
1629 # otherwise, s/?/shift @sqlv/ to put it inline
1631 return ($sql, @sqlv);
1633 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1634 ref $d ? $d->[1] : $d/e;
1643 # This allows us to check for a local, then _form, attr
1645 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1646 return $self->generate($name, @_);
1657 SQL::Abstract - Generate SQL from Perl data structures
1663 my $sql = SQL::Abstract->new;
1665 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1667 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1669 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1671 my($stmt, @bind) = $sql->delete($table, \%where);
1673 # Then, use these in your DBI statements
1674 my $sth = $dbh->prepare($stmt);
1675 $sth->execute(@bind);
1677 # Just generate the WHERE clause
1678 my($stmt, @bind) = $sql->where(\%where, \@order);
1680 # Return values in the same order, for hashed queries
1681 # See PERFORMANCE section for more details
1682 my @bind = $sql->values(\%fieldvals);
1686 This module was inspired by the excellent L<DBIx::Abstract>.
1687 However, in using that module I found that what I really wanted
1688 to do was generate SQL, but still retain complete control over my
1689 statement handles and use the DBI interface. So, I set out to
1690 create an abstract SQL generation module.
1692 While based on the concepts used by L<DBIx::Abstract>, there are
1693 several important differences, especially when it comes to WHERE
1694 clauses. I have modified the concepts used to make the SQL easier
1695 to generate from Perl data structures and, IMO, more intuitive.
1696 The underlying idea is for this module to do what you mean, based
1697 on the data structures you provide it. The big advantage is that
1698 you don't have to modify your code every time your data changes,
1699 as this module figures it out.
1701 To begin with, an SQL INSERT is as easy as just specifying a hash
1702 of C<key=value> pairs:
1705 name => 'Jimbo Bobson',
1706 phone => '123-456-7890',
1707 address => '42 Sister Lane',
1708 city => 'St. Louis',
1709 state => 'Louisiana',
1712 The SQL can then be generated with this:
1714 my($stmt, @bind) = $sql->insert('people', \%data);
1716 Which would give you something like this:
1718 $stmt = "INSERT INTO people
1719 (address, city, name, phone, state)
1720 VALUES (?, ?, ?, ?, ?)";
1721 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1722 '123-456-7890', 'Louisiana');
1724 These are then used directly in your DBI code:
1726 my $sth = $dbh->prepare($stmt);
1727 $sth->execute(@bind);
1729 =head2 Inserting and Updating Arrays
1731 If your database has array types (like for example Postgres),
1732 activate the special option C<< array_datatypes => 1 >>
1733 when creating the C<SQL::Abstract> object.
1734 Then you may use an arrayref to insert and update database array types:
1736 my $sql = SQL::Abstract->new(array_datatypes => 1);
1738 planets => [qw/Mercury Venus Earth Mars/]
1741 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1745 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1747 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1750 =head2 Inserting and Updating SQL
1752 In order to apply SQL functions to elements of your C<%data> you may
1753 specify a reference to an arrayref for the given hash value. For example,
1754 if you need to execute the Oracle C<to_date> function on a value, you can
1755 say something like this:
1759 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1762 The first value in the array is the actual SQL. Any other values are
1763 optional and would be included in the bind values array. This gives
1766 my($stmt, @bind) = $sql->insert('people', \%data);
1768 $stmt = "INSERT INTO people (name, date_entered)
1769 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1770 @bind = ('Bill', '03/02/2003');
1772 An UPDATE is just as easy, all you change is the name of the function:
1774 my($stmt, @bind) = $sql->update('people', \%data);
1776 Notice that your C<%data> isn't touched; the module will generate
1777 the appropriately quirky SQL for you automatically. Usually you'll
1778 want to specify a WHERE clause for your UPDATE, though, which is
1779 where handling C<%where> hashes comes in handy...
1781 =head2 Complex where statements
1783 This module can generate pretty complicated WHERE statements
1784 easily. For example, simple C<key=value> pairs are taken to mean
1785 equality, and if you want to see if a field is within a set
1786 of values, you can use an arrayref. Let's say we wanted to
1787 SELECT some data based on this criteria:
1790 requestor => 'inna',
1791 worker => ['nwiger', 'rcwe', 'sfz'],
1792 status => { '!=', 'completed' }
1795 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1797 The above would give you something like this:
1799 $stmt = "SELECT * FROM tickets WHERE
1800 ( requestor = ? ) AND ( status != ? )
1801 AND ( worker = ? OR worker = ? OR worker = ? )";
1802 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1804 Which you could then use in DBI code like so:
1806 my $sth = $dbh->prepare($stmt);
1807 $sth->execute(@bind);
1813 The methods are simple. There's one for every major SQL operation,
1814 and a constructor you use first. The arguments are specified in a
1815 similar order for each method (table, then fields, then a where
1816 clause) to try and simplify things.
1818 =head2 new(option => 'value')
1820 The C<new()> function takes a list of options and values, and returns
1821 a new B<SQL::Abstract> object which can then be used to generate SQL
1822 through the methods below. The options accepted are:
1828 If set to 'lower', then SQL will be generated in all lowercase. By
1829 default SQL is generated in "textbook" case meaning something like:
1831 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1833 Any setting other than 'lower' is ignored.
1837 This determines what the default comparison operator is. By default
1838 it is C<=>, meaning that a hash like this:
1840 %where = (name => 'nwiger', email => 'nate@wiger.org');
1842 Will generate SQL like this:
1844 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1846 However, you may want loose comparisons by default, so if you set
1847 C<cmp> to C<like> you would get SQL such as:
1849 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1851 You can also override the comparison on an individual basis - see
1852 the huge section on L</"WHERE CLAUSES"> at the bottom.
1854 =item sqltrue, sqlfalse
1856 Expressions for inserting boolean values within SQL statements.
1857 By default these are C<1=1> and C<1=0>. They are used
1858 by the special operators C<-in> and C<-not_in> for generating
1859 correct SQL even when the argument is an empty array (see below).
1863 This determines the default logical operator for multiple WHERE
1864 statements in arrays or hashes. If absent, the default logic is "or"
1865 for arrays, and "and" for hashes. This means that a WHERE
1869 event_date => {'>=', '2/13/99'},
1870 event_date => {'<=', '4/24/03'},
1873 will generate SQL like this:
1875 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1877 This is probably not what you want given this query, though (look
1878 at the dates). To change the "OR" to an "AND", simply specify:
1880 my $sql = SQL::Abstract->new(logic => 'and');
1882 Which will change the above C<WHERE> to:
1884 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1886 The logic can also be changed locally by inserting
1887 a modifier in front of an arrayref :
1889 @where = (-and => [event_date => {'>=', '2/13/99'},
1890 event_date => {'<=', '4/24/03'} ]);
1892 See the L</"WHERE CLAUSES"> section for explanations.
1896 This will automatically convert comparisons using the specified SQL
1897 function for both column and value. This is mostly used with an argument
1898 of C<upper> or C<lower>, so that the SQL will have the effect of
1899 case-insensitive "searches". For example, this:
1901 $sql = SQL::Abstract->new(convert => 'upper');
1902 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1904 Will turn out the following SQL:
1906 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1908 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1909 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1910 not validate this option; it will just pass through what you specify verbatim).
1914 This is a kludge because many databases suck. For example, you can't
1915 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1916 Instead, you have to use C<bind_param()>:
1918 $sth->bind_param(1, 'reg data');
1919 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1921 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1922 which loses track of which field each slot refers to. Fear not.
1924 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1925 Currently, you can specify either C<normal> (default) or C<columns>. If you
1926 specify C<columns>, you will get an array that looks like this:
1928 my $sql = SQL::Abstract->new(bindtype => 'columns');
1929 my($stmt, @bind) = $sql->insert(...);
1932 [ 'column1', 'value1' ],
1933 [ 'column2', 'value2' ],
1934 [ 'column3', 'value3' ],
1937 You can then iterate through this manually, using DBI's C<bind_param()>.
1939 $sth->prepare($stmt);
1942 my($col, $data) = @$_;
1943 if ($col eq 'details' || $col eq 'comments') {
1944 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1945 } elsif ($col eq 'image') {
1946 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1948 $sth->bind_param($i, $data);
1952 $sth->execute; # execute without @bind now
1954 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1955 Basically, the advantage is still that you don't have to care which fields
1956 are or are not included. You could wrap that above C<for> loop in a simple
1957 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1958 get a layer of abstraction over manual SQL specification.
1960 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
1961 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1962 will expect the bind values in this format.
1966 This is the character that a table or column name will be quoted
1967 with. By default this is an empty string, but you could set it to
1968 the character C<`>, to generate SQL like this:
1970 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1972 Alternatively, you can supply an array ref of two items, the first being the left
1973 hand quote character, and the second the right hand quote character. For
1974 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1975 that generates SQL like this:
1977 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1979 Quoting is useful if you have tables or columns names that are reserved
1980 words in your database's SQL dialect.
1984 This is the character that will be used to escape L</quote_char>s appearing
1985 in an identifier before it has been quoted.
1987 The parameter default in case of a single L</quote_char> character is the quote
1990 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1991 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
1992 of the B<opening (left)> L</quote_char> within the identifier are currently left
1993 untouched. The default for opening-closing-style quotes may change in future
1994 versions, thus you are B<strongly encouraged> to specify the escape character
1999 This is the character that separates a table and column name. It is
2000 necessary to specify this when the C<quote_char> option is selected,
2001 so that tables and column names can be individually quoted like this:
2003 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2005 =item injection_guard
2007 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2008 column name specified in a query structure. This is a safety mechanism to avoid
2009 injection attacks when mishandling user input e.g.:
2011 my %condition_as_column_value_pairs = get_values_from_user();
2012 $sqla->select( ... , \%condition_as_column_value_pairs );
2014 If the expression matches an exception is thrown. Note that literal SQL
2015 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2017 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2019 =item array_datatypes
2021 When this option is true, arrayrefs in INSERT or UPDATE are
2022 interpreted as array datatypes and are passed directly
2024 When this option is false, arrayrefs are interpreted
2025 as literal SQL, just like refs to arrayrefs
2026 (but this behavior is for backwards compatibility; when writing
2027 new queries, use the "reference to arrayref" syntax
2033 Takes a reference to a list of "special operators"
2034 to extend the syntax understood by L<SQL::Abstract>.
2035 See section L</"SPECIAL OPERATORS"> for details.
2039 Takes a reference to a list of "unary operators"
2040 to extend the syntax understood by L<SQL::Abstract>.
2041 See section L</"UNARY OPERATORS"> for details.
2047 =head2 insert($table, \@values || \%fieldvals, \%options)
2049 This is the simplest function. You simply give it a table name
2050 and either an arrayref of values or hashref of field/value pairs.
2051 It returns an SQL INSERT statement and a list of bind values.
2052 See the sections on L</"Inserting and Updating Arrays"> and
2053 L</"Inserting and Updating SQL"> for information on how to insert
2054 with those data types.
2056 The optional C<\%options> hash reference may contain additional
2057 options to generate the insert SQL. Currently supported options
2064 Takes either a scalar of raw SQL fields, or an array reference of
2065 field names, and adds on an SQL C<RETURNING> statement at the end.
2066 This allows you to return data generated by the insert statement
2067 (such as row IDs) without performing another C<SELECT> statement.
2068 Note, however, this is not part of the SQL standard and may not
2069 be supported by all database engines.
2073 =head2 update($table, \%fieldvals, \%where)
2075 This takes a table, hashref of field/value pairs, and an optional
2076 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2078 See the sections on L</"Inserting and Updating Arrays"> and
2079 L</"Inserting and Updating SQL"> for information on how to insert
2080 with those data types.
2082 =head2 select($source, $fields, $where, $order)
2084 This returns a SQL SELECT statement and associated list of bind values, as
2085 specified by the arguments :
2091 Specification of the 'FROM' part of the statement.
2092 The argument can be either a plain scalar (interpreted as a table
2093 name, will be quoted), or an arrayref (interpreted as a list
2094 of table names, joined by commas, quoted), or a scalarref
2095 (literal table name, not quoted), or a ref to an arrayref
2096 (list of literal table names, joined by commas, not quoted).
2100 Specification of the list of fields to retrieve from
2102 The argument can be either an arrayref (interpreted as a list
2103 of field names, will be joined by commas and quoted), or a
2104 plain scalar (literal SQL, not quoted).
2105 Please observe that this API is not as flexible as that of
2106 the first argument C<$source>, for backwards compatibility reasons.
2110 Optional argument to specify the WHERE part of the query.
2111 The argument is most often a hashref, but can also be
2112 an arrayref or plain scalar --
2113 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2117 Optional argument to specify the ORDER BY part of the query.
2118 The argument can be a scalar, a hashref or an arrayref
2119 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2125 =head2 delete($table, \%where)
2127 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2128 It returns an SQL DELETE statement and list of bind values.
2130 =head2 where(\%where, \@order)
2132 This is used to generate just the WHERE clause. For example,
2133 if you have an arbitrary data structure and know what the
2134 rest of your SQL is going to look like, but want an easy way
2135 to produce a WHERE clause, use this. It returns an SQL WHERE
2136 clause and list of bind values.
2139 =head2 values(\%data)
2141 This just returns the values from the hash C<%data>, in the same
2142 order that would be returned from any of the other above queries.
2143 Using this allows you to markedly speed up your queries if you
2144 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2146 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2148 Warning: This is an experimental method and subject to change.
2150 This returns arbitrarily generated SQL. It's a really basic shortcut.
2151 It will return two different things, depending on return context:
2153 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2154 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2156 These would return the following:
2158 # First calling form
2159 $stmt = "CREATE TABLE test (?, ?)";
2160 @bind = (field1, field2);
2162 # Second calling form
2163 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2165 Depending on what you're trying to do, it's up to you to choose the correct
2166 format. In this example, the second form is what you would want.
2170 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2174 ALTER SESSION SET nls_date_format = 'MM/YY'
2176 You get the idea. Strings get their case twiddled, but everything
2177 else remains verbatim.
2179 =head1 EXPORTABLE FUNCTIONS
2181 =head2 is_plain_value
2183 Determines if the supplied argument is a plain value as understood by this
2188 =item * The value is C<undef>
2190 =item * The value is a non-reference
2192 =item * The value is an object with stringification overloading
2194 =item * The value is of the form C<< { -value => $anything } >>
2198 On failure returns C<undef>, on sucess returns a B<scalar> reference
2199 to the original supplied argument.
2205 The stringification overloading detection is rather advanced: it takes
2206 into consideration not only the presence of a C<""> overload, but if that
2207 fails also checks for enabled
2208 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2209 on either C<0+> or C<bool>.
2211 Unfortunately testing in the field indicates that this
2212 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2213 but only when very large numbers of stringifying objects are involved.
2214 At the time of writing ( Sep 2014 ) there is no clear explanation of
2215 the direct cause, nor is there a manageably small test case that reliably
2216 reproduces the problem.
2218 If you encounter any of the following exceptions in B<random places within
2219 your application stack> - this module may be to blame:
2221 Operation "ne": no method found,
2222 left argument in overloaded package <something>,
2223 right argument in overloaded package <something>
2227 Stub found while resolving method "???" overloading """" in package <something>
2229 If you fall victim to the above - please attempt to reduce the problem
2230 to something that could be sent to the L<SQL::Abstract developers
2231 |DBIx::Class/GETTING HELP/SUPPORT>
2232 (either publicly or privately). As a workaround in the meantime you can
2233 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2234 value, which will most likely eliminate your problem (at the expense of
2235 not being able to properly detect exotic forms of stringification).
2237 This notice and environment variable will be removed in a future version,
2238 as soon as the underlying problem is found and a reliable workaround is
2243 =head2 is_literal_value
2245 Determines if the supplied argument is a literal value as understood by this
2250 =item * C<\$sql_string>
2252 =item * C<\[ $sql_string, @bind_values ]>
2256 On failure returns C<undef>, on sucess returns an B<array> reference
2257 containing the unpacked version of the supplied literal SQL and bind values.
2259 =head1 WHERE CLAUSES
2263 This module uses a variation on the idea from L<DBIx::Abstract>. It
2264 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2265 module is that things in arrays are OR'ed, and things in hashes
2268 The easiest way to explain is to show lots of examples. After
2269 each C<%where> hash shown, it is assumed you used:
2271 my($stmt, @bind) = $sql->where(\%where);
2273 However, note that the C<%where> hash can be used directly in any
2274 of the other functions as well, as described above.
2276 =head2 Key-value pairs
2278 So, let's get started. To begin, a simple hash:
2282 status => 'completed'
2285 Is converted to SQL C<key = val> statements:
2287 $stmt = "WHERE user = ? AND status = ?";
2288 @bind = ('nwiger', 'completed');
2290 One common thing I end up doing is having a list of values that
2291 a field can be in. To do this, simply specify a list inside of
2296 status => ['assigned', 'in-progress', 'pending'];
2299 This simple code will create the following:
2301 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2302 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2304 A field associated to an empty arrayref will be considered a
2305 logical false and will generate 0=1.
2307 =head2 Tests for NULL values
2309 If the value part is C<undef> then this is converted to SQL <IS NULL>
2318 $stmt = "WHERE user = ? AND status IS NULL";
2321 To test if a column IS NOT NULL:
2325 status => { '!=', undef },
2328 =head2 Specific comparison operators
2330 If you want to specify a different type of operator for your comparison,
2331 you can use a hashref for a given column:
2335 status => { '!=', 'completed' }
2338 Which would generate:
2340 $stmt = "WHERE user = ? AND status != ?";
2341 @bind = ('nwiger', 'completed');
2343 To test against multiple values, just enclose the values in an arrayref:
2345 status => { '=', ['assigned', 'in-progress', 'pending'] };
2347 Which would give you:
2349 "WHERE status = ? OR status = ? OR status = ?"
2352 The hashref can also contain multiple pairs, in which case it is expanded
2353 into an C<AND> of its elements:
2357 status => { '!=', 'completed', -not_like => 'pending%' }
2360 # Or more dynamically, like from a form
2361 $where{user} = 'nwiger';
2362 $where{status}{'!='} = 'completed';
2363 $where{status}{'-not_like'} = 'pending%';
2365 # Both generate this
2366 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2367 @bind = ('nwiger', 'completed', 'pending%');
2370 To get an OR instead, you can combine it with the arrayref idea:
2374 priority => [ { '=', 2 }, { '>', 5 } ]
2377 Which would generate:
2379 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2380 @bind = ('2', '5', 'nwiger');
2382 If you want to include literal SQL (with or without bind values), just use a
2383 scalar reference or reference to an arrayref as the value:
2386 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2387 date_expires => { '<' => \"now()" }
2390 Which would generate:
2392 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2393 @bind = ('11/26/2008');
2396 =head2 Logic and nesting operators
2398 In the example above,
2399 there is a subtle trap if you want to say something like
2400 this (notice the C<AND>):
2402 WHERE priority != ? AND priority != ?
2404 Because, in Perl you I<can't> do this:
2406 priority => { '!=' => 2, '!=' => 1 }
2408 As the second C<!=> key will obliterate the first. The solution
2409 is to use the special C<-modifier> form inside an arrayref:
2411 priority => [ -and => {'!=', 2},
2415 Normally, these would be joined by C<OR>, but the modifier tells it
2416 to use C<AND> instead. (Hint: You can use this in conjunction with the
2417 C<logic> option to C<new()> in order to change the way your queries
2418 work by default.) B<Important:> Note that the C<-modifier> goes
2419 B<INSIDE> the arrayref, as an extra first element. This will
2420 B<NOT> do what you think it might:
2422 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2424 Here is a quick list of equivalencies, since there is some overlap:
2427 status => {'!=', 'completed', 'not like', 'pending%' }
2428 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2431 status => {'=', ['assigned', 'in-progress']}
2432 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2433 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2437 =head2 Special operators : IN, BETWEEN, etc.
2439 You can also use the hashref format to compare a list of fields using the
2440 C<IN> comparison operator, by specifying the list as an arrayref:
2443 status => 'completed',
2444 reportid => { -in => [567, 2335, 2] }
2447 Which would generate:
2449 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2450 @bind = ('completed', '567', '2335', '2');
2452 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2455 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2456 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2457 'sqltrue' (by default : C<1=1>).
2459 In addition to the array you can supply a chunk of literal sql or
2460 literal sql with bind:
2463 customer => { -in => \[
2464 'SELECT cust_id FROM cust WHERE balance > ?',
2467 status => { -in => \'SELECT status_codes FROM states' },
2473 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2474 AND status IN ( SELECT status_codes FROM states )
2478 Finally, if the argument to C<-in> is not a reference, it will be
2479 treated as a single-element array.
2481 Another pair of operators is C<-between> and C<-not_between>,
2482 used with an arrayref of two values:
2486 completion_date => {
2487 -not_between => ['2002-10-01', '2003-02-06']
2493 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2495 Just like with C<-in> all plausible combinations of literal SQL
2499 start0 => { -between => [ 1, 2 ] },
2500 start1 => { -between => \["? AND ?", 1, 2] },
2501 start2 => { -between => \"lower(x) AND upper(y)" },
2502 start3 => { -between => [
2504 \["upper(?)", 'stuff' ],
2511 ( start0 BETWEEN ? AND ? )
2512 AND ( start1 BETWEEN ? AND ? )
2513 AND ( start2 BETWEEN lower(x) AND upper(y) )
2514 AND ( start3 BETWEEN lower(x) AND upper(?) )
2516 @bind = (1, 2, 1, 2, 'stuff');
2519 These are the two builtin "special operators"; but the
2520 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2522 =head2 Unary operators: bool
2524 If you wish to test against boolean columns or functions within your
2525 database you can use the C<-bool> and C<-not_bool> operators. For
2526 example to test the column C<is_user> being true and the column
2527 C<is_enabled> being false you would use:-
2531 -not_bool => 'is_enabled',
2536 WHERE is_user AND NOT is_enabled
2538 If a more complex combination is required, testing more conditions,
2539 then you should use the and/or operators:-
2544 -not_bool => { two=> { -rlike => 'bar' } },
2545 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2556 (NOT ( three = ? OR three > ? ))
2559 =head2 Nested conditions, -and/-or prefixes
2561 So far, we've seen how multiple conditions are joined with a top-level
2562 C<AND>. We can change this by putting the different conditions we want in
2563 hashes and then putting those hashes in an array. For example:
2568 status => { -like => ['pending%', 'dispatched'] },
2572 status => 'unassigned',
2576 This data structure would create the following:
2578 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2579 OR ( user = ? AND status = ? ) )";
2580 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2583 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2584 to change the logic inside :
2590 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2591 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2598 $stmt = "WHERE ( user = ?
2599 AND ( ( workhrs > ? AND geo = ? )
2600 OR ( workhrs < ? OR geo = ? ) ) )";
2601 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2603 =head3 Algebraic inconsistency, for historical reasons
2605 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2606 operator goes C<outside> of the nested structure; whereas when connecting
2607 several constraints on one column, the C<-and> operator goes
2608 C<inside> the arrayref. Here is an example combining both features :
2611 -and => [a => 1, b => 2],
2612 -or => [c => 3, d => 4],
2613 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2618 WHERE ( ( ( a = ? AND b = ? )
2619 OR ( c = ? OR d = ? )
2620 OR ( e LIKE ? AND e LIKE ? ) ) )
2622 This difference in syntax is unfortunate but must be preserved for
2623 historical reasons. So be careful : the two examples below would
2624 seem algebraically equivalent, but they are not
2626 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2627 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2629 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2630 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2633 =head2 Literal SQL and value type operators
2635 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2636 side" is a column name and the "right side" is a value (normally rendered as
2637 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2638 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2639 alter this behavior. There are several ways of doing so.
2643 This is a virtual operator that signals the string to its right side is an
2644 identifier (a column name) and not a value. For example to compare two
2645 columns you would write:
2648 priority => { '<', 2 },
2649 requestor => { -ident => 'submitter' },
2654 $stmt = "WHERE priority < ? AND requestor = submitter";
2657 If you are maintaining legacy code you may see a different construct as
2658 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2663 This is a virtual operator that signals that the construct to its right side
2664 is a value to be passed to DBI. This is for example necessary when you want
2665 to write a where clause against an array (for RDBMS that support such
2666 datatypes). For example:
2669 array => { -value => [1, 2, 3] }
2674 $stmt = 'WHERE array = ?';
2675 @bind = ([1, 2, 3]);
2677 Note that if you were to simply say:
2683 the result would probably not be what you wanted:
2685 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2690 Finally, sometimes only literal SQL will do. To include a random snippet
2691 of SQL verbatim, you specify it as a scalar reference. Consider this only
2692 as a last resort. Usually there is a better way. For example:
2695 priority => { '<', 2 },
2696 requestor => { -in => \'(SELECT name FROM hitmen)' },
2701 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2704 Note that in this example, you only get one bind parameter back, since
2705 the verbatim SQL is passed as part of the statement.
2709 Never use untrusted input as a literal SQL argument - this is a massive
2710 security risk (there is no way to check literal snippets for SQL
2711 injections and other nastyness). If you need to deal with untrusted input
2712 use literal SQL with placeholders as described next.
2714 =head3 Literal SQL with placeholders and bind values (subqueries)
2716 If the literal SQL to be inserted has placeholders and bind values,
2717 use a reference to an arrayref (yes this is a double reference --
2718 not so common, but perfectly legal Perl). For example, to find a date
2719 in Postgres you can use something like this:
2722 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2727 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2730 Note that you must pass the bind values in the same format as they are returned
2731 by L<where|/where(\%where, \@order)>. This means that if you set L</bindtype>
2732 to C<columns>, you must provide the bind values in the
2733 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2734 scalar value; most commonly the column name, but you can use any scalar value
2735 (including references and blessed references), L<SQL::Abstract> will simply
2736 pass it through intact. So if C<bindtype> is set to C<columns> the above
2737 example will look like:
2740 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2743 Literal SQL is especially useful for nesting parenthesized clauses in the
2744 main SQL query. Here is a first example :
2746 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2750 bar => \["IN ($sub_stmt)" => @sub_bind],
2755 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2756 WHERE c2 < ? AND c3 LIKE ?))";
2757 @bind = (1234, 100, "foo%");
2759 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2760 are expressed in the same way. Of course the C<$sub_stmt> and
2761 its associated bind values can be generated through a former call
2764 my ($sub_stmt, @sub_bind)
2765 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2766 c3 => {-like => "foo%"}});
2769 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2772 In the examples above, the subquery was used as an operator on a column;
2773 but the same principle also applies for a clause within the main C<%where>
2774 hash, like an EXISTS subquery :
2776 my ($sub_stmt, @sub_bind)
2777 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2778 my %where = ( -and => [
2780 \["EXISTS ($sub_stmt)" => @sub_bind],
2785 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2786 WHERE c1 = ? AND c2 > t0.c0))";
2790 Observe that the condition on C<c2> in the subquery refers to
2791 column C<t0.c0> of the main query : this is I<not> a bind
2792 value, so we have to express it through a scalar ref.
2793 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2794 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2795 what we wanted here.
2797 Finally, here is an example where a subquery is used
2798 for expressing unary negation:
2800 my ($sub_stmt, @sub_bind)
2801 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2802 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2804 lname => {like => '%son%'},
2805 \["NOT ($sub_stmt)" => @sub_bind],
2810 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2811 @bind = ('%son%', 10, 20)
2813 =head3 Deprecated usage of Literal SQL
2815 Below are some examples of archaic use of literal SQL. It is shown only as
2816 reference for those who deal with legacy code. Each example has a much
2817 better, cleaner and safer alternative that users should opt for in new code.
2823 my %where = ( requestor => \'IS NOT NULL' )
2825 $stmt = "WHERE requestor IS NOT NULL"
2827 This used to be the way of generating NULL comparisons, before the handling
2828 of C<undef> got formalized. For new code please use the superior syntax as
2829 described in L</Tests for NULL values>.
2833 my %where = ( requestor => \'= submitter' )
2835 $stmt = "WHERE requestor = submitter"
2837 This used to be the only way to compare columns. Use the superior L</-ident>
2838 method for all new code. For example an identifier declared in such a way
2839 will be properly quoted if L</quote_char> is properly set, while the legacy
2840 form will remain as supplied.
2844 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2846 $stmt = "WHERE completed > ? AND is_ready"
2847 @bind = ('2012-12-21')
2849 Using an empty string literal used to be the only way to express a boolean.
2850 For all new code please use the much more readable
2851 L<-bool|/Unary operators: bool> operator.
2857 These pages could go on for a while, since the nesting of the data
2858 structures this module can handle are pretty much unlimited (the
2859 module implements the C<WHERE> expansion as a recursive function
2860 internally). Your best bet is to "play around" with the module a
2861 little to see how the data structures behave, and choose the best
2862 format for your data based on that.
2864 And of course, all the values above will probably be replaced with
2865 variables gotten from forms or the command line. After all, if you
2866 knew everything ahead of time, you wouldn't have to worry about
2867 dynamically-generating SQL and could just hardwire it into your
2870 =head1 ORDER BY CLAUSES
2872 Some functions take an order by clause. This can either be a scalar (just a
2873 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2874 or an array of either of the two previous forms. Examples:
2876 Given | Will Generate
2877 ----------------------------------------------------------
2879 \'colA DESC' | ORDER BY colA DESC
2881 'colA' | ORDER BY colA
2883 [qw/colA colB/] | ORDER BY colA, colB
2885 {-asc => 'colA'} | ORDER BY colA ASC
2887 {-desc => 'colB'} | ORDER BY colB DESC
2889 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2891 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2894 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2895 { -desc => [qw/colB/], | colC ASC, colD ASC
2896 { -asc => [qw/colC colD/],|
2898 ===========================================================
2902 =head1 SPECIAL OPERATORS
2904 my $sqlmaker = SQL::Abstract->new(special_ops => [
2908 my ($self, $field, $op, $arg) = @_;
2914 handler => 'method_name',
2918 A "special operator" is a SQL syntactic clause that can be
2919 applied to a field, instead of a usual binary operator.
2922 WHERE field IN (?, ?, ?)
2923 WHERE field BETWEEN ? AND ?
2924 WHERE MATCH(field) AGAINST (?, ?)
2926 Special operators IN and BETWEEN are fairly standard and therefore
2927 are builtin within C<SQL::Abstract> (as the overridable methods
2928 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2929 like the MATCH .. AGAINST example above which is specific to MySQL,
2930 you can write your own operator handlers - supply a C<special_ops>
2931 argument to the C<new> method. That argument takes an arrayref of
2932 operator definitions; each operator definition is a hashref with two
2939 the regular expression to match the operator
2943 Either a coderef or a plain scalar method name. In both cases
2944 the expected return is C<< ($sql, @bind) >>.
2946 When supplied with a method name, it is simply called on the
2947 L<SQL::Abstract> object as:
2949 $self->$method_name ($field, $op, $arg)
2953 $field is the LHS of the operator
2954 $op is the part that matched the handler regex
2957 When supplied with a coderef, it is called as:
2959 $coderef->($self, $field, $op, $arg)
2964 For example, here is an implementation
2965 of the MATCH .. AGAINST syntax for MySQL
2967 my $sqlmaker = SQL::Abstract->new(special_ops => [
2969 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2970 {regex => qr/^match$/i,
2972 my ($self, $field, $op, $arg) = @_;
2973 $arg = [$arg] if not ref $arg;
2974 my $label = $self->_quote($field);
2975 my ($placeholder) = $self->_convert('?');
2976 my $placeholders = join ", ", (($placeholder) x @$arg);
2977 my $sql = $self->_sqlcase('match') . " ($label) "
2978 . $self->_sqlcase('against') . " ($placeholders) ";
2979 my @bind = $self->_bindtype($field, @$arg);
2980 return ($sql, @bind);
2987 =head1 UNARY OPERATORS
2989 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2993 my ($self, $op, $arg) = @_;
2999 handler => 'method_name',
3003 A "unary operator" is a SQL syntactic clause that can be
3004 applied to a field - the operator goes before the field
3006 You can write your own operator handlers - supply a C<unary_ops>
3007 argument to the C<new> method. That argument takes an arrayref of
3008 operator definitions; each operator definition is a hashref with two
3015 the regular expression to match the operator
3019 Either a coderef or a plain scalar method name. In both cases
3020 the expected return is C<< $sql >>.
3022 When supplied with a method name, it is simply called on the
3023 L<SQL::Abstract> object as:
3025 $self->$method_name ($op, $arg)
3029 $op is the part that matched the handler regex
3030 $arg is the RHS or argument of the operator
3032 When supplied with a coderef, it is called as:
3034 $coderef->($self, $op, $arg)
3042 Thanks to some benchmarking by Mark Stosberg, it turns out that
3043 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3044 I must admit this wasn't an intentional design issue, but it's a
3045 byproduct of the fact that you get to control your C<DBI> handles
3048 To maximize performance, use a code snippet like the following:
3050 # prepare a statement handle using the first row
3051 # and then reuse it for the rest of the rows
3053 for my $href (@array_of_hashrefs) {
3054 $stmt ||= $sql->insert('table', $href);
3055 $sth ||= $dbh->prepare($stmt);
3056 $sth->execute($sql->values($href));
3059 The reason this works is because the keys in your C<$href> are sorted
3060 internally by B<SQL::Abstract>. Thus, as long as your data retains
3061 the same structure, you only have to generate the SQL the first time
3062 around. On subsequent queries, simply use the C<values> function provided
3063 by this module to return your values in the correct order.
3065 However this depends on the values having the same type - if, for
3066 example, the values of a where clause may either have values
3067 (resulting in sql of the form C<column = ?> with a single bind
3068 value), or alternatively the values might be C<undef> (resulting in
3069 sql of the form C<column IS NULL> with no bind value) then the
3070 caching technique suggested will not work.
3074 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3075 really like this part (I do, at least). Building up a complex query
3076 can be as simple as the following:
3083 use CGI::FormBuilder;
3086 my $form = CGI::FormBuilder->new(...);
3087 my $sql = SQL::Abstract->new;
3089 if ($form->submitted) {
3090 my $field = $form->field;
3091 my $id = delete $field->{id};
3092 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3095 Of course, you would still have to connect using C<DBI> to run the
3096 query, but the point is that if you make your form look like your
3097 table, the actual query script can be extremely simplistic.
3099 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3100 a fast interface to returning and formatting data. I frequently
3101 use these three modules together to write complex database query
3102 apps in under 50 lines.
3104 =head1 HOW TO CONTRIBUTE
3106 Contributions are always welcome, in all usable forms (we especially
3107 welcome documentation improvements). The delivery methods include git-
3108 or unified-diff formatted patches, GitHub pull requests, or plain bug
3109 reports either via RT or the Mailing list. Contributors are generally
3110 granted full access to the official repository after their first several
3111 patches pass successful review.
3113 This project is maintained in a git repository. The code and related tools are
3114 accessible at the following locations:
3118 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3120 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3122 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3124 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3130 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3131 Great care has been taken to preserve the I<published> behavior
3132 documented in previous versions in the 1.* family; however,
3133 some features that were previously undocumented, or behaved
3134 differently from the documentation, had to be changed in order
3135 to clarify the semantics. Hence, client code that was relying
3136 on some dark areas of C<SQL::Abstract> v1.*
3137 B<might behave differently> in v1.50.
3139 The main changes are :
3145 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3149 support for the { operator => \"..." } construct (to embed literal SQL)
3153 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3157 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3161 defensive programming : check arguments
3165 fixed bug with global logic, which was previously implemented
3166 through global variables yielding side-effects. Prior versions would
3167 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3168 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3169 Now this is interpreted
3170 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3175 fixed semantics of _bindtype on array args
3179 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3180 we just avoid shifting arrays within that tree.
3184 dropped the C<_modlogic> function
3188 =head1 ACKNOWLEDGEMENTS
3190 There are a number of individuals that have really helped out with
3191 this module. Unfortunately, most of them submitted bugs via CPAN
3192 so I have no idea who they are! But the people I do know are:
3194 Ash Berlin (order_by hash term support)
3195 Matt Trout (DBIx::Class support)
3196 Mark Stosberg (benchmarking)
3197 Chas Owens (initial "IN" operator support)
3198 Philip Collins (per-field SQL functions)
3199 Eric Kolve (hashref "AND" support)
3200 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3201 Dan Kubb (support for "quote_char" and "name_sep")
3202 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3203 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3204 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3205 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3206 Oliver Charles (support for "RETURNING" after "INSERT")
3212 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3216 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3218 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3220 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3221 While not an official support venue, C<DBIx::Class> makes heavy use of
3222 C<SQL::Abstract>, and as such list members there are very familiar with
3223 how to create queries.
3227 This module is free software; you may copy this under the same
3228 terms as perl itself (either the GNU General Public License or
3229 the Artistic License)