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.78';
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] } ]
82 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
84 defined $_[0]->{-ident} and ! length ref $_[0]->{-ident}
85 ) ? [ $_[0]->{-ident} ]
89 # FIXME XSify - this can be done so much more efficiently
90 sub is_plain_value ($) {
92 ! length ref $_[0] ? \($_[0])
94 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
96 exists $_[0]->{-value}
97 ) ? \($_[0]->{-value})
99 # reuse @_ for even moar speedz
100 defined ( $_[1] = Scalar::Util::blessed $_[0] )
102 # deliberately not using Devel::OverloadInfo - the checks we are
103 # intersted in are much more limited than the fullblown thing, and
104 # this is a very hot piece of code
106 # simply using ->can('(""') can leave behind stub methods that
107 # break actually using the overload later (see L<perldiag/Stub
108 # found while resolving method "%s" overloading "%s" in package
109 # "%s"> and the source of overload::mycan())
111 # either has stringification which DBI SHOULD prefer out of the box
112 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
114 # has nummification or boolification, AND fallback is *not* disabled
116 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
119 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
121 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
125 # no fallback specified at all
126 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
128 # fallback explicitly undef
129 ! defined ${"$_[3]::()"}
142 #======================================================================
144 #======================================================================
148 my $class = ref($self) || $self;
149 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
151 # choose our case by keeping an option around
152 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
154 # default logic for interpreting arrayrefs
155 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
157 # how to return bind vars
158 $opt{bindtype} ||= 'normal';
160 # default comparison is "=", but can be overridden
163 # try to recognize which are the 'equality' and 'inequality' ops
164 # (temporary quickfix (in 2007), should go through a more seasoned API)
165 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
166 $opt{inequality_op} = qr/^( != | <> )$/ix;
168 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
169 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
172 $opt{sqltrue} ||= '1=1';
173 $opt{sqlfalse} ||= '0=1';
176 $opt{special_ops} ||= [];
177 # regexes are applied in order, thus push after user-defines
178 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
181 $opt{unary_ops} ||= [];
182 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
184 # rudimentary sanity-check for user supplied bits treated as functions/operators
185 # If a purported function matches this regular expression, an exception is thrown.
186 # Literal SQL is *NOT* subject to this check, only functions (and column names
187 # when quoting is not in effect)
190 # need to guard against ()'s in column names too, but this will break tons of
191 # hacks... ideas anyone?
192 $opt{injection_guard} ||= qr/
198 return bless \%opt, $class;
202 sub _assert_pass_injection_guard {
203 if ($_[1] =~ $_[0]->{injection_guard}) {
204 my $class = ref $_[0];
205 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
206 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
207 . "{injection_guard} attribute to ${class}->new()"
212 #======================================================================
214 #======================================================================
218 my $table = $self->_table(shift);
219 my $data = shift || return;
222 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
223 my ($sql, @bind) = $self->$method($data);
224 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
226 if ($options->{returning}) {
227 my ($s, @b) = $self->_insert_returning ($options);
232 return wantarray ? ($sql, @bind) : $sql;
235 sub _insert_returning {
236 my ($self, $options) = @_;
238 my $f = $options->{returning};
240 my $fieldlist = $self->_SWITCH_refkind($f, {
241 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
242 SCALAR => sub {$self->_quote($f)},
243 SCALARREF => sub {$$f},
245 return $self->_sqlcase(' returning ') . $fieldlist;
248 sub _insert_HASHREF { # explicit list of fields and then values
249 my ($self, $data) = @_;
251 my @fields = sort keys %$data;
253 my ($sql, @bind) = $self->_insert_values($data);
256 $_ = $self->_quote($_) foreach @fields;
257 $sql = "( ".join(", ", @fields).") ".$sql;
259 return ($sql, @bind);
262 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
263 my ($self, $data) = @_;
265 # no names (arrayref) so can't generate bindtype
266 $self->{bindtype} ne 'columns'
267 or belch "can't do 'columns' bindtype when called with arrayref";
269 # fold the list of values into a hash of column name - value pairs
270 # (where the column names are artificially generated, and their
271 # lexicographical ordering keep the ordering of the original list)
272 my $i = "a"; # incremented values will be in lexicographical order
273 my $data_in_hash = { map { ($i++ => $_) } @$data };
275 return $self->_insert_values($data_in_hash);
278 sub _insert_ARRAYREFREF { # literal SQL with bind
279 my ($self, $data) = @_;
281 my ($sql, @bind) = @${$data};
282 $self->_assert_bindval_matches_bindtype(@bind);
284 return ($sql, @bind);
288 sub _insert_SCALARREF { # literal SQL without bind
289 my ($self, $data) = @_;
295 my ($self, $data) = @_;
297 my (@values, @all_bind);
298 foreach my $column (sort keys %$data) {
299 my $v = $data->{$column};
301 $self->_SWITCH_refkind($v, {
304 if ($self->{array_datatypes}) { # if array datatype are activated
306 push @all_bind, $self->_bindtype($column, $v);
308 else { # else literal SQL with bind
309 my ($sql, @bind) = @$v;
310 $self->_assert_bindval_matches_bindtype(@bind);
312 push @all_bind, @bind;
316 ARRAYREFREF => sub { # literal SQL with bind
317 my ($sql, @bind) = @${$v};
318 $self->_assert_bindval_matches_bindtype(@bind);
320 push @all_bind, @bind;
323 # THINK : anything useful to do with a HASHREF ?
324 HASHREF => sub { # (nothing, but old SQLA passed it through)
325 #TODO in SQLA >= 2.0 it will die instead
326 belch "HASH ref as bind value in insert is not supported";
328 push @all_bind, $self->_bindtype($column, $v);
331 SCALARREF => sub { # literal SQL without bind
335 SCALAR_or_UNDEF => sub {
337 push @all_bind, $self->_bindtype($column, $v);
344 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
345 return ($sql, @all_bind);
350 #======================================================================
352 #======================================================================
357 my $table = $self->_table(shift);
358 my $data = shift || return;
361 # first build the 'SET' part of the sql statement
362 my (@set, @all_bind);
363 puke "Unsupported data type specified to \$sql->update"
364 unless ref $data eq 'HASH';
366 for my $k (sort keys %$data) {
369 my $label = $self->_quote($k);
371 $self->_SWITCH_refkind($v, {
373 if ($self->{array_datatypes}) { # array datatype
374 push @set, "$label = ?";
375 push @all_bind, $self->_bindtype($k, $v);
377 else { # literal SQL with bind
378 my ($sql, @bind) = @$v;
379 $self->_assert_bindval_matches_bindtype(@bind);
380 push @set, "$label = $sql";
381 push @all_bind, @bind;
384 ARRAYREFREF => sub { # literal SQL with bind
385 my ($sql, @bind) = @${$v};
386 $self->_assert_bindval_matches_bindtype(@bind);
387 push @set, "$label = $sql";
388 push @all_bind, @bind;
390 SCALARREF => sub { # literal SQL without bind
391 push @set, "$label = $$v";
394 my ($op, $arg, @rest) = %$v;
396 puke 'Operator calls in update must be in the form { -op => $arg }'
397 if (@rest or not $op =~ /^\-(.+)/);
399 local $self->{_nested_func_lhs} = $k;
400 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
402 push @set, "$label = $sql";
403 push @all_bind, @bind;
405 SCALAR_or_UNDEF => sub {
406 push @set, "$label = ?";
407 push @all_bind, $self->_bindtype($k, $v);
413 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
417 my($where_sql, @where_bind) = $self->where($where);
419 push @all_bind, @where_bind;
422 return wantarray ? ($sql, @all_bind) : $sql;
428 #======================================================================
430 #======================================================================
435 my $table = $self->_table(shift);
436 my $fields = shift || '*';
440 my($where_sql, @bind) = $self->where($where, $order);
442 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
444 my $sql = join(' ', $self->_sqlcase('select'), $f,
445 $self->_sqlcase('from'), $table)
448 return wantarray ? ($sql, @bind) : $sql;
451 #======================================================================
453 #======================================================================
458 my $table = $self->_table(shift);
462 my($where_sql, @bind) = $self->where($where);
463 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
465 return wantarray ? ($sql, @bind) : $sql;
469 #======================================================================
471 #======================================================================
475 # Finally, a separate routine just to handle WHERE clauses
477 my ($self, $where, $order) = @_;
480 my ($sql, @bind) = $self->_recurse_where($where);
481 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
485 $sql .= $self->_order_by($order);
488 return wantarray ? ($sql, @bind) : $sql;
493 my ($self, $where, $logic) = @_;
495 # dispatch on appropriate method according to refkind of $where
496 my $method = $self->_METHOD_FOR_refkind("_where", $where);
498 my ($sql, @bind) = $self->$method($where, $logic);
500 # DBIx::Class used to call _recurse_where in scalar context
501 # something else might too...
503 return ($sql, @bind);
506 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
513 #======================================================================
514 # WHERE: top-level ARRAYREF
515 #======================================================================
518 sub _where_ARRAYREF {
519 my ($self, $where, $logic) = @_;
521 $logic = uc($logic || $self->{logic});
522 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
524 my @clauses = @$where;
526 my (@sql_clauses, @all_bind);
527 # need to use while() so can shift() for pairs
529 my $el = shift @clauses;
531 $el = undef if (defined $el and ! length $el);
533 # switch according to kind of $el and get corresponding ($sql, @bind)
534 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
536 # skip empty elements, otherwise get invalid trailing AND stuff
537 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
541 $self->_assert_bindval_matches_bindtype(@b);
545 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
547 SCALARREF => sub { ($$el); },
550 # top-level arrayref with scalars, recurse in pairs
551 $self->_recurse_where({$el => shift(@clauses)})
554 UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
558 push @sql_clauses, $sql;
559 push @all_bind, @bind;
563 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
566 #======================================================================
567 # WHERE: top-level ARRAYREFREF
568 #======================================================================
570 sub _where_ARRAYREFREF {
571 my ($self, $where) = @_;
572 my ($sql, @bind) = @$$where;
573 $self->_assert_bindval_matches_bindtype(@bind);
574 return ($sql, @bind);
577 #======================================================================
578 # WHERE: top-level HASHREF
579 #======================================================================
582 my ($self, $where) = @_;
583 my (@sql_clauses, @all_bind);
585 for my $k (sort keys %$where) {
586 my $v = $where->{$k};
588 # ($k => $v) is either a special unary op or a regular hashpair
589 my ($sql, @bind) = do {
591 # put the operator in canonical form
593 $op = substr $op, 1; # remove initial dash
594 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
595 $op =~ s/\s+/ /g; # compress whitespace
597 # so that -not_foo works correctly
598 $op =~ s/^not_/NOT /i;
600 $self->_debug("Unary OP(-$op) within hashref, recursing...");
601 my ($s, @b) = $self->_where_unary_op ($op, $v);
603 # top level vs nested
604 # we assume that handled unary ops will take care of their ()s
606 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
608 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
614 if (is_literal_value ($v) ) {
615 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
618 puke "Supplying an empty left hand side argument is not supported in hash-pairs";
622 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
623 $self->$method($k, $v);
627 push @sql_clauses, $sql;
628 push @all_bind, @bind;
631 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
634 sub _where_unary_op {
635 my ($self, $op, $rhs) = @_;
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 $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 ($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} = $self->{_nested_func_lhs};
855 my ($all_sql, @all_bind);
857 for my $orig_op (sort keys %$v) {
858 my $val = $v->{$orig_op};
860 # put the operator in canonical form
863 # FIXME - we need to phase out dash-less ops
864 $op =~ s/^-//; # remove possible initial dash
865 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
866 $op =~ s/\s+/ /g; # compress whitespace
868 $self->_assert_pass_injection_guard($op);
871 $op =~ s/^is_not/IS NOT/i;
873 # so that -not_foo works correctly
874 $op =~ s/^not_/NOT /i;
876 # another retarded special case: foo => { $op => { -value => undef } }
877 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
883 # CASE: col-value logic modifiers
884 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
885 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
887 # CASE: special operators like -in or -between
888 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
889 my $handler = $special_op->{handler};
891 puke "No handler supplied for special operator $orig_op";
893 elsif (not ref $handler) {
894 ($sql, @bind) = $self->$handler ($k, $op, $val);
896 elsif (ref $handler eq 'CODE') {
897 ($sql, @bind) = $handler->($self, $k, $op, $val);
900 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
904 $self->_SWITCH_refkind($val, {
906 ARRAYREF => sub { # CASE: col => {op => \@vals}
907 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
910 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
911 my ($sub_sql, @sub_bind) = @$$val;
912 $self->_assert_bindval_matches_bindtype(@sub_bind);
913 $sql = join ' ', $self->_convert($self->_quote($k)),
914 $self->_sqlcase($op),
919 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
921 $op =~ /^not$/i ? 'is not' # legacy
922 : $op =~ $self->{equality_op} ? 'is'
923 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
924 : $op =~ $self->{inequality_op} ? 'is not'
925 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
926 : puke "unexpected operator '$orig_op' with undef operand";
928 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
931 FALLBACK => sub { # CASE: col => {op/func => $stuff}
933 # retain for proper column type bind
934 $self->{_nested_func_lhs} ||= $k;
936 ($sql, @bind) = $self->_where_unary_op ($op, $val);
939 $self->_convert($self->_quote($k)),
940 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
946 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
947 push @all_bind, @bind;
949 return ($all_sql, @all_bind);
952 sub _where_field_IS {
953 my ($self, $k, $op, $v) = @_;
955 my ($s) = $self->_SWITCH_refkind($v, {
958 $self->_convert($self->_quote($k)),
959 map { $self->_sqlcase($_)} ($op, 'null')
962 puke "$op can only take undef as argument";
969 sub _where_field_op_ARRAYREF {
970 my ($self, $k, $op, $vals) = @_;
972 my @vals = @$vals; #always work on a copy
975 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
977 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
980 # see if the first element is an -and/-or op
982 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
987 # a long standing API wart - an attempt to change this behavior during
988 # the 1.50 series failed *spectacularly*. Warn instead and leave the
993 (!$logic or $logic eq 'OR')
995 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
998 belch "A multi-element arrayref as an argument to the inequality op '$o' "
999 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
1000 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1004 # distribute $op over each remaining member of @vals, append logic if exists
1005 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1009 # try to DWIM on equality operators
1011 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1012 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1013 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1014 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1015 : puke "operator '$op' applied on an empty array (field '$k')";
1020 sub _where_hashpair_SCALARREF {
1021 my ($self, $k, $v) = @_;
1022 $self->_debug("SCALAR($k) means literal SQL: $$v");
1023 my $sql = $self->_quote($k) . " " . $$v;
1027 # literal SQL with bind
1028 sub _where_hashpair_ARRAYREFREF {
1029 my ($self, $k, $v) = @_;
1030 $self->_debug("REF($k) means literal SQL: @${$v}");
1031 my ($sql, @bind) = @$$v;
1032 $self->_assert_bindval_matches_bindtype(@bind);
1033 $sql = $self->_quote($k) . " " . $sql;
1034 return ($sql, @bind );
1037 # literal SQL without bind
1038 sub _where_hashpair_SCALAR {
1039 my ($self, $k, $v) = @_;
1040 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1041 my $sql = join ' ', $self->_convert($self->_quote($k)),
1042 $self->_sqlcase($self->{cmp}),
1043 $self->_convert('?');
1044 my @bind = $self->_bindtype($k, $v);
1045 return ( $sql, @bind);
1049 sub _where_hashpair_UNDEF {
1050 my ($self, $k, $v) = @_;
1051 $self->_debug("UNDEF($k) means IS NULL");
1052 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
1056 #======================================================================
1057 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1058 #======================================================================
1061 sub _where_SCALARREF {
1062 my ($self, $where) = @_;
1065 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1071 my ($self, $where) = @_;
1074 $self->_debug("NOREF(*top) means literal SQL: $where");
1085 #======================================================================
1086 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1087 #======================================================================
1090 sub _where_field_BETWEEN {
1091 my ($self, $k, $op, $vals) = @_;
1093 my ($label, $and, $placeholder);
1094 $label = $self->_convert($self->_quote($k));
1095 $and = ' ' . $self->_sqlcase('and') . ' ';
1096 $placeholder = $self->_convert('?');
1097 $op = $self->_sqlcase($op);
1099 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1101 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1102 ARRAYREFREF => sub {
1103 my ($s, @b) = @$$vals;
1104 $self->_assert_bindval_matches_bindtype(@b);
1111 puke $invalid_args if @$vals != 2;
1113 my (@all_sql, @all_bind);
1114 foreach my $val (@$vals) {
1115 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1117 return ($placeholder, $self->_bindtype($k, $val) );
1122 ARRAYREFREF => sub {
1123 my ($sql, @bind) = @$$val;
1124 $self->_assert_bindval_matches_bindtype(@bind);
1125 return ($sql, @bind);
1128 my ($func, $arg, @rest) = %$val;
1129 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1130 if (@rest or $func !~ /^ \- (.+)/x);
1131 local $self->{_nested_func_lhs} = $k;
1132 $self->_where_unary_op ($1 => $arg);
1138 push @all_sql, $sql;
1139 push @all_bind, @bind;
1143 (join $and, @all_sql),
1152 my $sql = "( $label $op $clause )";
1153 return ($sql, @bind)
1157 sub _where_field_IN {
1158 my ($self, $k, $op, $vals) = @_;
1160 # backwards compatibility : if scalar, force into an arrayref
1161 $vals = [$vals] if defined $vals && ! ref $vals;
1163 my ($label) = $self->_convert($self->_quote($k));
1164 my ($placeholder) = $self->_convert('?');
1165 $op = $self->_sqlcase($op);
1167 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1168 ARRAYREF => sub { # list of choices
1169 if (@$vals) { # nonempty list
1170 my (@all_sql, @all_bind);
1172 for my $val (@$vals) {
1173 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1175 return ($placeholder, $val);
1180 ARRAYREFREF => sub {
1181 my ($sql, @bind) = @$$val;
1182 $self->_assert_bindval_matches_bindtype(@bind);
1183 return ($sql, @bind);
1186 my ($func, $arg, @rest) = %$val;
1187 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1188 if (@rest or $func !~ /^ \- (.+)/x);
1189 local $self->{_nested_func_lhs} = $k;
1190 $self->_where_unary_op ($1 => $arg);
1194 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1195 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1196 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1197 . 'will emit the logically correct SQL instead of raising this exception)'
1201 push @all_sql, $sql;
1202 push @all_bind, @bind;
1206 sprintf ('%s %s ( %s )',
1209 join (', ', @all_sql)
1211 $self->_bindtype($k, @all_bind),
1214 else { # empty list : some databases won't understand "IN ()", so DWIM
1215 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1220 SCALARREF => sub { # literal SQL
1221 my $sql = $self->_open_outer_paren ($$vals);
1222 return ("$label $op ( $sql )");
1224 ARRAYREFREF => sub { # literal SQL with bind
1225 my ($sql, @bind) = @$$vals;
1226 $self->_assert_bindval_matches_bindtype(@bind);
1227 $sql = $self->_open_outer_paren ($sql);
1228 return ("$label $op ( $sql )", @bind);
1232 puke "Argument passed to the '$op' operator can not be undefined";
1236 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1240 return ($sql, @bind);
1243 # Some databases (SQLite) treat col IN (1, 2) different from
1244 # col IN ( (1, 2) ). Use this to strip all outer parens while
1245 # adding them back in the corresponding method
1246 sub _open_outer_paren {
1247 my ($self, $sql) = @_;
1248 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1253 #======================================================================
1255 #======================================================================
1258 my ($self, $arg) = @_;
1261 for my $c ($self->_order_by_chunks ($arg) ) {
1262 $self->_SWITCH_refkind ($c, {
1263 SCALAR => sub { push @sql, $c },
1264 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1270 $self->_sqlcase(' order by'),
1276 return wantarray ? ($sql, @bind) : $sql;
1279 sub _order_by_chunks {
1280 my ($self, $arg) = @_;
1282 return $self->_SWITCH_refkind($arg, {
1285 map { $self->_order_by_chunks ($_ ) } @$arg;
1288 ARRAYREFREF => sub {
1289 my ($s, @b) = @$$arg;
1290 $self->_assert_bindval_matches_bindtype(@b);
1294 SCALAR => sub {$self->_quote($arg)},
1296 UNDEF => sub {return () },
1298 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1301 # get first pair in hash
1302 my ($key, $val, @rest) = %$arg;
1304 return () unless $key;
1306 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1307 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1313 for my $c ($self->_order_by_chunks ($val)) {
1316 $self->_SWITCH_refkind ($c, {
1321 ($sql, @bind) = @$c;
1325 $sql = $sql . ' ' . $self->_sqlcase($direction);
1327 push @ret, [ $sql, @bind];
1336 #======================================================================
1337 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1338 #======================================================================
1343 $self->_SWITCH_refkind($from, {
1344 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1345 SCALAR => sub {$self->_quote($from)},
1346 SCALARREF => sub {$$from},
1351 #======================================================================
1353 #======================================================================
1355 # highly optimized, as it's called way too often
1357 # my ($self, $label) = @_;
1359 return '' unless defined $_[1];
1360 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1362 unless ($_[0]->{quote_char}) {
1363 $_[0]->_assert_pass_injection_guard($_[1]);
1367 my $qref = ref $_[0]->{quote_char};
1370 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1372 elsif ($qref eq 'ARRAY') {
1373 ($l, $r) = @{$_[0]->{quote_char}};
1376 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1378 my $esc = $_[0]->{escape_char} || $r;
1380 # parts containing * are naturally unquoted
1381 return join( $_[0]->{name_sep}||'', map
1382 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1383 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1388 # Conversion, if applicable
1390 #my ($self, $arg) = @_;
1391 if ($_[0]->{convert}) {
1392 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1399 #my ($self, $col, @vals) = @_;
1400 # called often - tighten code
1401 return $_[0]->{bindtype} eq 'columns'
1402 ? map {[$_[1], $_]} @_[2 .. $#_]
1407 # Dies if any element of @bind is not in [colname => value] format
1408 # if bindtype is 'columns'.
1409 sub _assert_bindval_matches_bindtype {
1410 # my ($self, @bind) = @_;
1412 if ($self->{bindtype} eq 'columns') {
1414 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1415 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1421 sub _join_sql_clauses {
1422 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1424 if (@$clauses_aref > 1) {
1425 my $join = " " . $self->_sqlcase($logic) . " ";
1426 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1427 return ($sql, @$bind_aref);
1429 elsif (@$clauses_aref) {
1430 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1433 return (); # if no SQL, ignore @$bind_aref
1438 # Fix SQL case, if so requested
1440 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1441 # don't touch the argument ... crooked logic, but let's not change it!
1442 return $_[0]->{case} ? $_[1] : uc($_[1]);
1446 #======================================================================
1447 # DISPATCHING FROM REFKIND
1448 #======================================================================
1451 my ($self, $data) = @_;
1453 return 'UNDEF' unless defined $data;
1455 # blessed objects are treated like scalars
1456 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1458 return 'SCALAR' unless $ref;
1461 while ($ref eq 'REF') {
1463 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1467 return ($ref||'SCALAR') . ('REF' x $n_steps);
1471 my ($self, $data) = @_;
1472 my @try = ($self->_refkind($data));
1473 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1474 push @try, 'FALLBACK';
1478 sub _METHOD_FOR_refkind {
1479 my ($self, $meth_prefix, $data) = @_;
1482 for (@{$self->_try_refkind($data)}) {
1483 $method = $self->can($meth_prefix."_".$_)
1487 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1491 sub _SWITCH_refkind {
1492 my ($self, $data, $dispatch_table) = @_;
1495 for (@{$self->_try_refkind($data)}) {
1496 $coderef = $dispatch_table->{$_}
1500 puke "no dispatch entry for ".$self->_refkind($data)
1509 #======================================================================
1510 # VALUES, GENERATE, AUTOLOAD
1511 #======================================================================
1513 # LDNOTE: original code from nwiger, didn't touch code in that section
1514 # I feel the AUTOLOAD stuff should not be the default, it should
1515 # only be activated on explicit demand by user.
1519 my $data = shift || return;
1520 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1521 unless ref $data eq 'HASH';
1524 foreach my $k ( sort keys %$data ) {
1525 my $v = $data->{$k};
1526 $self->_SWITCH_refkind($v, {
1528 if ($self->{array_datatypes}) { # array datatype
1529 push @all_bind, $self->_bindtype($k, $v);
1531 else { # literal SQL with bind
1532 my ($sql, @bind) = @$v;
1533 $self->_assert_bindval_matches_bindtype(@bind);
1534 push @all_bind, @bind;
1537 ARRAYREFREF => sub { # literal SQL with bind
1538 my ($sql, @bind) = @${$v};
1539 $self->_assert_bindval_matches_bindtype(@bind);
1540 push @all_bind, @bind;
1542 SCALARREF => sub { # literal SQL without bind
1544 SCALAR_or_UNDEF => sub {
1545 push @all_bind, $self->_bindtype($k, $v);
1556 my(@sql, @sqlq, @sqlv);
1560 if ($ref eq 'HASH') {
1561 for my $k (sort keys %$_) {
1564 my $label = $self->_quote($k);
1565 if ($r eq 'ARRAY') {
1566 # literal SQL with bind
1567 my ($sql, @bind) = @$v;
1568 $self->_assert_bindval_matches_bindtype(@bind);
1569 push @sqlq, "$label = $sql";
1571 } elsif ($r eq 'SCALAR') {
1572 # literal SQL without bind
1573 push @sqlq, "$label = $$v";
1575 push @sqlq, "$label = ?";
1576 push @sqlv, $self->_bindtype($k, $v);
1579 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1580 } elsif ($ref eq 'ARRAY') {
1581 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1584 if ($r eq 'ARRAY') { # literal SQL with bind
1585 my ($sql, @bind) = @$v;
1586 $self->_assert_bindval_matches_bindtype(@bind);
1589 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1590 # embedded literal SQL
1597 push @sql, '(' . join(', ', @sqlq) . ')';
1598 } elsif ($ref eq 'SCALAR') {
1602 # strings get case twiddled
1603 push @sql, $self->_sqlcase($_);
1607 my $sql = join ' ', @sql;
1609 # this is pretty tricky
1610 # if ask for an array, return ($stmt, @bind)
1611 # otherwise, s/?/shift @sqlv/ to put it inline
1613 return ($sql, @sqlv);
1615 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1616 ref $d ? $d->[1] : $d/e;
1625 # This allows us to check for a local, then _form, attr
1627 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1628 return $self->generate($name, @_);
1639 SQL::Abstract - Generate SQL from Perl data structures
1645 my $sql = SQL::Abstract->new;
1647 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1649 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1651 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1653 my($stmt, @bind) = $sql->delete($table, \%where);
1655 # Then, use these in your DBI statements
1656 my $sth = $dbh->prepare($stmt);
1657 $sth->execute(@bind);
1659 # Just generate the WHERE clause
1660 my($stmt, @bind) = $sql->where(\%where, \@order);
1662 # Return values in the same order, for hashed queries
1663 # See PERFORMANCE section for more details
1664 my @bind = $sql->values(\%fieldvals);
1668 This module was inspired by the excellent L<DBIx::Abstract>.
1669 However, in using that module I found that what I really wanted
1670 to do was generate SQL, but still retain complete control over my
1671 statement handles and use the DBI interface. So, I set out to
1672 create an abstract SQL generation module.
1674 While based on the concepts used by L<DBIx::Abstract>, there are
1675 several important differences, especially when it comes to WHERE
1676 clauses. I have modified the concepts used to make the SQL easier
1677 to generate from Perl data structures and, IMO, more intuitive.
1678 The underlying idea is for this module to do what you mean, based
1679 on the data structures you provide it. The big advantage is that
1680 you don't have to modify your code every time your data changes,
1681 as this module figures it out.
1683 To begin with, an SQL INSERT is as easy as just specifying a hash
1684 of C<key=value> pairs:
1687 name => 'Jimbo Bobson',
1688 phone => '123-456-7890',
1689 address => '42 Sister Lane',
1690 city => 'St. Louis',
1691 state => 'Louisiana',
1694 The SQL can then be generated with this:
1696 my($stmt, @bind) = $sql->insert('people', \%data);
1698 Which would give you something like this:
1700 $stmt = "INSERT INTO people
1701 (address, city, name, phone, state)
1702 VALUES (?, ?, ?, ?, ?)";
1703 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1704 '123-456-7890', 'Louisiana');
1706 These are then used directly in your DBI code:
1708 my $sth = $dbh->prepare($stmt);
1709 $sth->execute(@bind);
1711 =head2 Inserting and Updating Arrays
1713 If your database has array types (like for example Postgres),
1714 activate the special option C<< array_datatypes => 1 >>
1715 when creating the C<SQL::Abstract> object.
1716 Then you may use an arrayref to insert and update database array types:
1718 my $sql = SQL::Abstract->new(array_datatypes => 1);
1720 planets => [qw/Mercury Venus Earth Mars/]
1723 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1727 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1729 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1732 =head2 Inserting and Updating SQL
1734 In order to apply SQL functions to elements of your C<%data> you may
1735 specify a reference to an arrayref for the given hash value. For example,
1736 if you need to execute the Oracle C<to_date> function on a value, you can
1737 say something like this:
1741 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1744 The first value in the array is the actual SQL. Any other values are
1745 optional and would be included in the bind values array. This gives
1748 my($stmt, @bind) = $sql->insert('people', \%data);
1750 $stmt = "INSERT INTO people (name, date_entered)
1751 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1752 @bind = ('Bill', '03/02/2003');
1754 An UPDATE is just as easy, all you change is the name of the function:
1756 my($stmt, @bind) = $sql->update('people', \%data);
1758 Notice that your C<%data> isn't touched; the module will generate
1759 the appropriately quirky SQL for you automatically. Usually you'll
1760 want to specify a WHERE clause for your UPDATE, though, which is
1761 where handling C<%where> hashes comes in handy...
1763 =head2 Complex where statements
1765 This module can generate pretty complicated WHERE statements
1766 easily. For example, simple C<key=value> pairs are taken to mean
1767 equality, and if you want to see if a field is within a set
1768 of values, you can use an arrayref. Let's say we wanted to
1769 SELECT some data based on this criteria:
1772 requestor => 'inna',
1773 worker => ['nwiger', 'rcwe', 'sfz'],
1774 status => { '!=', 'completed' }
1777 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1779 The above would give you something like this:
1781 $stmt = "SELECT * FROM tickets WHERE
1782 ( requestor = ? ) AND ( status != ? )
1783 AND ( worker = ? OR worker = ? OR worker = ? )";
1784 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1786 Which you could then use in DBI code like so:
1788 my $sth = $dbh->prepare($stmt);
1789 $sth->execute(@bind);
1795 The methods are simple. There's one for every major SQL operation,
1796 and a constructor you use first. The arguments are specified in a
1797 similar order for each method (table, then fields, then a where
1798 clause) to try and simplify things.
1800 =head2 new(option => 'value')
1802 The C<new()> function takes a list of options and values, and returns
1803 a new B<SQL::Abstract> object which can then be used to generate SQL
1804 through the methods below. The options accepted are:
1810 If set to 'lower', then SQL will be generated in all lowercase. By
1811 default SQL is generated in "textbook" case meaning something like:
1813 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1815 Any setting other than 'lower' is ignored.
1819 This determines what the default comparison operator is. By default
1820 it is C<=>, meaning that a hash like this:
1822 %where = (name => 'nwiger', email => 'nate@wiger.org');
1824 Will generate SQL like this:
1826 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1828 However, you may want loose comparisons by default, so if you set
1829 C<cmp> to C<like> you would get SQL such as:
1831 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1833 You can also override the comparison on an individual basis - see
1834 the huge section on L</"WHERE CLAUSES"> at the bottom.
1836 =item sqltrue, sqlfalse
1838 Expressions for inserting boolean values within SQL statements.
1839 By default these are C<1=1> and C<1=0>. They are used
1840 by the special operators C<-in> and C<-not_in> for generating
1841 correct SQL even when the argument is an empty array (see below).
1845 This determines the default logical operator for multiple WHERE
1846 statements in arrays or hashes. If absent, the default logic is "or"
1847 for arrays, and "and" for hashes. This means that a WHERE
1851 event_date => {'>=', '2/13/99'},
1852 event_date => {'<=', '4/24/03'},
1855 will generate SQL like this:
1857 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1859 This is probably not what you want given this query, though (look
1860 at the dates). To change the "OR" to an "AND", simply specify:
1862 my $sql = SQL::Abstract->new(logic => 'and');
1864 Which will change the above C<WHERE> to:
1866 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1868 The logic can also be changed locally by inserting
1869 a modifier in front of an arrayref :
1871 @where = (-and => [event_date => {'>=', '2/13/99'},
1872 event_date => {'<=', '4/24/03'} ]);
1874 See the L</"WHERE CLAUSES"> section for explanations.
1878 This will automatically convert comparisons using the specified SQL
1879 function for both column and value. This is mostly used with an argument
1880 of C<upper> or C<lower>, so that the SQL will have the effect of
1881 case-insensitive "searches". For example, this:
1883 $sql = SQL::Abstract->new(convert => 'upper');
1884 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1886 Will turn out the following SQL:
1888 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1890 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1891 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1892 not validate this option; it will just pass through what you specify verbatim).
1896 This is a kludge because many databases suck. For example, you can't
1897 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1898 Instead, you have to use C<bind_param()>:
1900 $sth->bind_param(1, 'reg data');
1901 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1903 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1904 which loses track of which field each slot refers to. Fear not.
1906 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1907 Currently, you can specify either C<normal> (default) or C<columns>. If you
1908 specify C<columns>, you will get an array that looks like this:
1910 my $sql = SQL::Abstract->new(bindtype => 'columns');
1911 my($stmt, @bind) = $sql->insert(...);
1914 [ 'column1', 'value1' ],
1915 [ 'column2', 'value2' ],
1916 [ 'column3', 'value3' ],
1919 You can then iterate through this manually, using DBI's C<bind_param()>.
1921 $sth->prepare($stmt);
1924 my($col, $data) = @$_;
1925 if ($col eq 'details' || $col eq 'comments') {
1926 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1927 } elsif ($col eq 'image') {
1928 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1930 $sth->bind_param($i, $data);
1934 $sth->execute; # execute without @bind now
1936 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1937 Basically, the advantage is still that you don't have to care which fields
1938 are or are not included. You could wrap that above C<for> loop in a simple
1939 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1940 get a layer of abstraction over manual SQL specification.
1942 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
1943 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1944 will expect the bind values in this format.
1948 This is the character that a table or column name will be quoted
1949 with. By default this is an empty string, but you could set it to
1950 the character C<`>, to generate SQL like this:
1952 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1954 Alternatively, you can supply an array ref of two items, the first being the left
1955 hand quote character, and the second the right hand quote character. For
1956 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1957 that generates SQL like this:
1959 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1961 Quoting is useful if you have tables or columns names that are reserved
1962 words in your database's SQL dialect.
1966 This is the character that will be used to escape L</quote_char>s appearing
1967 in an identifier before it has been quoted.
1969 The paramter default in case of a single L</quote_char> character is the quote
1972 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1973 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
1974 of the B<opening (left)> L</quote_char> within the identifier are currently left
1975 untouched. The default for opening-closing-style quotes may change in future
1976 versions, thus you are B<strongly encouraged> to specify the escape character
1981 This is the character that separates a table and column name. It is
1982 necessary to specify this when the C<quote_char> option is selected,
1983 so that tables and column names can be individually quoted like this:
1985 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1987 =item injection_guard
1989 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1990 column name specified in a query structure. This is a safety mechanism to avoid
1991 injection attacks when mishandling user input e.g.:
1993 my %condition_as_column_value_pairs = get_values_from_user();
1994 $sqla->select( ... , \%condition_as_column_value_pairs );
1996 If the expression matches an exception is thrown. Note that literal SQL
1997 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1999 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2001 =item array_datatypes
2003 When this option is true, arrayrefs in INSERT or UPDATE are
2004 interpreted as array datatypes and are passed directly
2006 When this option is false, arrayrefs are interpreted
2007 as literal SQL, just like refs to arrayrefs
2008 (but this behavior is for backwards compatibility; when writing
2009 new queries, use the "reference to arrayref" syntax
2015 Takes a reference to a list of "special operators"
2016 to extend the syntax understood by L<SQL::Abstract>.
2017 See section L</"SPECIAL OPERATORS"> for details.
2021 Takes a reference to a list of "unary operators"
2022 to extend the syntax understood by L<SQL::Abstract>.
2023 See section L</"UNARY OPERATORS"> for details.
2029 =head2 insert($table, \@values || \%fieldvals, \%options)
2031 This is the simplest function. You simply give it a table name
2032 and either an arrayref of values or hashref of field/value pairs.
2033 It returns an SQL INSERT statement and a list of bind values.
2034 See the sections on L</"Inserting and Updating Arrays"> and
2035 L</"Inserting and Updating SQL"> for information on how to insert
2036 with those data types.
2038 The optional C<\%options> hash reference may contain additional
2039 options to generate the insert SQL. Currently supported options
2046 Takes either a scalar of raw SQL fields, or an array reference of
2047 field names, and adds on an SQL C<RETURNING> statement at the end.
2048 This allows you to return data generated by the insert statement
2049 (such as row IDs) without performing another C<SELECT> statement.
2050 Note, however, this is not part of the SQL standard and may not
2051 be supported by all database engines.
2055 =head2 update($table, \%fieldvals, \%where)
2057 This takes a table, hashref of field/value pairs, and an optional
2058 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2060 See the sections on L</"Inserting and Updating Arrays"> and
2061 L</"Inserting and Updating SQL"> for information on how to insert
2062 with those data types.
2064 =head2 select($source, $fields, $where, $order)
2066 This returns a SQL SELECT statement and associated list of bind values, as
2067 specified by the arguments :
2073 Specification of the 'FROM' part of the statement.
2074 The argument can be either a plain scalar (interpreted as a table
2075 name, will be quoted), or an arrayref (interpreted as a list
2076 of table names, joined by commas, quoted), or a scalarref
2077 (literal table name, not quoted), or a ref to an arrayref
2078 (list of literal table names, joined by commas, not quoted).
2082 Specification of the list of fields to retrieve from
2084 The argument can be either an arrayref (interpreted as a list
2085 of field names, will be joined by commas and quoted), or a
2086 plain scalar (literal SQL, not quoted).
2087 Please observe that this API is not as flexible as that of
2088 the first argument C<$source>, for backwards compatibility reasons.
2092 Optional argument to specify the WHERE part of the query.
2093 The argument is most often a hashref, but can also be
2094 an arrayref or plain scalar --
2095 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2099 Optional argument to specify the ORDER BY part of the query.
2100 The argument can be a scalar, a hashref or an arrayref
2101 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2107 =head2 delete($table, \%where)
2109 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2110 It returns an SQL DELETE statement and list of bind values.
2112 =head2 where(\%where, \@order)
2114 This is used to generate just the WHERE clause. For example,
2115 if you have an arbitrary data structure and know what the
2116 rest of your SQL is going to look like, but want an easy way
2117 to produce a WHERE clause, use this. It returns an SQL WHERE
2118 clause and list of bind values.
2121 =head2 values(\%data)
2123 This just returns the values from the hash C<%data>, in the same
2124 order that would be returned from any of the other above queries.
2125 Using this allows you to markedly speed up your queries if you
2126 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2128 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2130 Warning: This is an experimental method and subject to change.
2132 This returns arbitrarily generated SQL. It's a really basic shortcut.
2133 It will return two different things, depending on return context:
2135 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2136 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2138 These would return the following:
2140 # First calling form
2141 $stmt = "CREATE TABLE test (?, ?)";
2142 @bind = (field1, field2);
2144 # Second calling form
2145 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2147 Depending on what you're trying to do, it's up to you to choose the correct
2148 format. In this example, the second form is what you would want.
2152 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2156 ALTER SESSION SET nls_date_format = 'MM/YY'
2158 You get the idea. Strings get their case twiddled, but everything
2159 else remains verbatim.
2161 =head1 EXPORTABLE FUNCTIONS
2163 =head2 is_plain_value
2165 Determines if the supplied argument is a plain value as understood by this
2170 =item * The value is C<undef>
2172 =item * The value is a non-reference
2174 =item * The value is an object with stringification overloading
2176 =item * The value is of the form C<< { -value => $anything } >>
2180 On failure returns C<undef>, on sucess returns a B<scalar> reference
2181 to the original supplied argument.
2187 The stringification overloading detection is rather advanced: it takes
2188 into consideration not only the presence of a C<""> overload, but if that
2189 fails also checks for enabled
2190 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2191 on either C<0+> or C<bool>.
2193 Unfortunately testing in the field indicates that this
2194 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2195 but only when very large numbers of stringifying objects are involved.
2196 At the time of writing ( Sep 2014 ) there is no clear explanation of
2197 the direct cause, nor is there a manageably small test case that reliably
2198 reproduces the problem.
2200 If you encounter any of the following exceptions in B<random places within
2201 your application stack> - this module may be to blame:
2203 Operation "ne": no method found,
2204 left argument in overloaded package <something>,
2205 right argument in overloaded package <something>
2209 Stub found while resolving method "???" overloading """" in package <something>
2211 If you fall victim to the above - please attempt to reduce the problem
2212 to something that could be sent to the L<SQL::Abstract developers
2213 |DBIx::Class/GETTING HELP/SUPPORT>
2214 (either publicly or privately). As a workaround in the meantime you can
2215 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2216 value, which will most likely eliminate your problem (at the expense of
2217 not being able to properly detect exotic forms of stringification).
2219 This notice and environment variable will be removed in a future version,
2220 as soon as the underlying problem is found and a reliable workaround is
2225 =head2 is_literal_value
2227 Determines if the supplied argument is a literal value as understood by this
2232 =item * C<\$sql_string>
2234 =item * C<\[ $sql_string, @bind_values ]>
2236 =item * C<< { -ident => $plain_defined_string } >>
2240 On failure returns C<undef>, on sucess returns an B<array> reference
2241 containing the unpacked version of the supplied literal SQL and bind values.
2243 =head1 WHERE CLAUSES
2247 This module uses a variation on the idea from L<DBIx::Abstract>. It
2248 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2249 module is that things in arrays are OR'ed, and things in hashes
2252 The easiest way to explain is to show lots of examples. After
2253 each C<%where> hash shown, it is assumed you used:
2255 my($stmt, @bind) = $sql->where(\%where);
2257 However, note that the C<%where> hash can be used directly in any
2258 of the other functions as well, as described above.
2260 =head2 Key-value pairs
2262 So, let's get started. To begin, a simple hash:
2266 status => 'completed'
2269 Is converted to SQL C<key = val> statements:
2271 $stmt = "WHERE user = ? AND status = ?";
2272 @bind = ('nwiger', 'completed');
2274 One common thing I end up doing is having a list of values that
2275 a field can be in. To do this, simply specify a list inside of
2280 status => ['assigned', 'in-progress', 'pending'];
2283 This simple code will create the following:
2285 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2286 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2288 A field associated to an empty arrayref will be considered a
2289 logical false and will generate 0=1.
2291 =head2 Tests for NULL values
2293 If the value part is C<undef> then this is converted to SQL <IS NULL>
2302 $stmt = "WHERE user = ? AND status IS NULL";
2305 To test if a column IS NOT NULL:
2309 status => { '!=', undef },
2312 =head2 Specific comparison operators
2314 If you want to specify a different type of operator for your comparison,
2315 you can use a hashref for a given column:
2319 status => { '!=', 'completed' }
2322 Which would generate:
2324 $stmt = "WHERE user = ? AND status != ?";
2325 @bind = ('nwiger', 'completed');
2327 To test against multiple values, just enclose the values in an arrayref:
2329 status => { '=', ['assigned', 'in-progress', 'pending'] };
2331 Which would give you:
2333 "WHERE status = ? OR status = ? OR status = ?"
2336 The hashref can also contain multiple pairs, in which case it is expanded
2337 into an C<AND> of its elements:
2341 status => { '!=', 'completed', -not_like => 'pending%' }
2344 # Or more dynamically, like from a form
2345 $where{user} = 'nwiger';
2346 $where{status}{'!='} = 'completed';
2347 $where{status}{'-not_like'} = 'pending%';
2349 # Both generate this
2350 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2351 @bind = ('nwiger', 'completed', 'pending%');
2354 To get an OR instead, you can combine it with the arrayref idea:
2358 priority => [ { '=', 2 }, { '>', 5 } ]
2361 Which would generate:
2363 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2364 @bind = ('2', '5', 'nwiger');
2366 If you want to include literal SQL (with or without bind values), just use a
2367 scalar reference or reference to an arrayref as the value:
2370 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2371 date_expires => { '<' => \"now()" }
2374 Which would generate:
2376 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2377 @bind = ('11/26/2008');
2380 =head2 Logic and nesting operators
2382 In the example above,
2383 there is a subtle trap if you want to say something like
2384 this (notice the C<AND>):
2386 WHERE priority != ? AND priority != ?
2388 Because, in Perl you I<can't> do this:
2390 priority => { '!=' => 2, '!=' => 1 }
2392 As the second C<!=> key will obliterate the first. The solution
2393 is to use the special C<-modifier> form inside an arrayref:
2395 priority => [ -and => {'!=', 2},
2399 Normally, these would be joined by C<OR>, but the modifier tells it
2400 to use C<AND> instead. (Hint: You can use this in conjunction with the
2401 C<logic> option to C<new()> in order to change the way your queries
2402 work by default.) B<Important:> Note that the C<-modifier> goes
2403 B<INSIDE> the arrayref, as an extra first element. This will
2404 B<NOT> do what you think it might:
2406 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2408 Here is a quick list of equivalencies, since there is some overlap:
2411 status => {'!=', 'completed', 'not like', 'pending%' }
2412 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2415 status => {'=', ['assigned', 'in-progress']}
2416 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2417 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2421 =head2 Special operators : IN, BETWEEN, etc.
2423 You can also use the hashref format to compare a list of fields using the
2424 C<IN> comparison operator, by specifying the list as an arrayref:
2427 status => 'completed',
2428 reportid => { -in => [567, 2335, 2] }
2431 Which would generate:
2433 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2434 @bind = ('completed', '567', '2335', '2');
2436 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2439 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2440 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2441 'sqltrue' (by default : C<1=1>).
2443 In addition to the array you can supply a chunk of literal sql or
2444 literal sql with bind:
2447 customer => { -in => \[
2448 'SELECT cust_id FROM cust WHERE balance > ?',
2451 status => { -in => \'SELECT status_codes FROM states' },
2457 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2458 AND status IN ( SELECT status_codes FROM states )
2462 Finally, if the argument to C<-in> is not a reference, it will be
2463 treated as a single-element array.
2465 Another pair of operators is C<-between> and C<-not_between>,
2466 used with an arrayref of two values:
2470 completion_date => {
2471 -not_between => ['2002-10-01', '2003-02-06']
2477 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2479 Just like with C<-in> all plausible combinations of literal SQL
2483 start0 => { -between => [ 1, 2 ] },
2484 start1 => { -between => \["? AND ?", 1, 2] },
2485 start2 => { -between => \"lower(x) AND upper(y)" },
2486 start3 => { -between => [
2488 \["upper(?)", 'stuff' ],
2495 ( start0 BETWEEN ? AND ? )
2496 AND ( start1 BETWEEN ? AND ? )
2497 AND ( start2 BETWEEN lower(x) AND upper(y) )
2498 AND ( start3 BETWEEN lower(x) AND upper(?) )
2500 @bind = (1, 2, 1, 2, 'stuff');
2503 These are the two builtin "special operators"; but the
2504 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2506 =head2 Unary operators: bool
2508 If you wish to test against boolean columns or functions within your
2509 database you can use the C<-bool> and C<-not_bool> operators. For
2510 example to test the column C<is_user> being true and the column
2511 C<is_enabled> being false you would use:-
2515 -not_bool => 'is_enabled',
2520 WHERE is_user AND NOT is_enabled
2522 If a more complex combination is required, testing more conditions,
2523 then you should use the and/or operators:-
2528 -not_bool => { two=> { -rlike => 'bar' } },
2529 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2540 (NOT ( three = ? OR three > ? ))
2543 =head2 Nested conditions, -and/-or prefixes
2545 So far, we've seen how multiple conditions are joined with a top-level
2546 C<AND>. We can change this by putting the different conditions we want in
2547 hashes and then putting those hashes in an array. For example:
2552 status => { -like => ['pending%', 'dispatched'] },
2556 status => 'unassigned',
2560 This data structure would create the following:
2562 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2563 OR ( user = ? AND status = ? ) )";
2564 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2567 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2568 to change the logic inside :
2574 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2575 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2582 $stmt = "WHERE ( user = ?
2583 AND ( ( workhrs > ? AND geo = ? )
2584 OR ( workhrs < ? OR geo = ? ) ) )";
2585 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2587 =head3 Algebraic inconsistency, for historical reasons
2589 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2590 operator goes C<outside> of the nested structure; whereas when connecting
2591 several constraints on one column, the C<-and> operator goes
2592 C<inside> the arrayref. Here is an example combining both features :
2595 -and => [a => 1, b => 2],
2596 -or => [c => 3, d => 4],
2597 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2602 WHERE ( ( ( a = ? AND b = ? )
2603 OR ( c = ? OR d = ? )
2604 OR ( e LIKE ? AND e LIKE ? ) ) )
2606 This difference in syntax is unfortunate but must be preserved for
2607 historical reasons. So be careful : the two examples below would
2608 seem algebraically equivalent, but they are not
2610 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2611 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2613 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2614 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2617 =head2 Literal SQL and value type operators
2619 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2620 side" is a column name and the "right side" is a value (normally rendered as
2621 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2622 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2623 alter this behavior. There are several ways of doing so.
2627 This is a virtual operator that signals the string to its right side is an
2628 identifier (a column name) and not a value. For example to compare two
2629 columns you would write:
2632 priority => { '<', 2 },
2633 requestor => { -ident => 'submitter' },
2638 $stmt = "WHERE priority < ? AND requestor = submitter";
2641 If you are maintaining legacy code you may see a different construct as
2642 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2647 This is a virtual operator that signals that the construct to its right side
2648 is a value to be passed to DBI. This is for example necessary when you want
2649 to write a where clause against an array (for RDBMS that support such
2650 datatypes). For example:
2653 array => { -value => [1, 2, 3] }
2658 $stmt = 'WHERE array = ?';
2659 @bind = ([1, 2, 3]);
2661 Note that if you were to simply say:
2667 the result would probably not be what you wanted:
2669 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2674 Finally, sometimes only literal SQL will do. To include a random snippet
2675 of SQL verbatim, you specify it as a scalar reference. Consider this only
2676 as a last resort. Usually there is a better way. For example:
2679 priority => { '<', 2 },
2680 requestor => { -in => \'(SELECT name FROM hitmen)' },
2685 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2688 Note that in this example, you only get one bind parameter back, since
2689 the verbatim SQL is passed as part of the statement.
2693 Never use untrusted input as a literal SQL argument - this is a massive
2694 security risk (there is no way to check literal snippets for SQL
2695 injections and other nastyness). If you need to deal with untrusted input
2696 use literal SQL with placeholders as described next.
2698 =head3 Literal SQL with placeholders and bind values (subqueries)
2700 If the literal SQL to be inserted has placeholders and bind values,
2701 use a reference to an arrayref (yes this is a double reference --
2702 not so common, but perfectly legal Perl). For example, to find a date
2703 in Postgres you can use something like this:
2706 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2711 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2714 Note that you must pass the bind values in the same format as they are returned
2715 by L<where|/where(\%where, \@order)>. This means that if you set L</bindtype>
2716 to C<columns>, you must provide the bind values in the
2717 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2718 scalar value; most commonly the column name, but you can use any scalar value
2719 (including references and blessed references), L<SQL::Abstract> will simply
2720 pass it through intact. So if C<bindtype> is set to C<columns> the above
2721 example will look like:
2724 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2727 Literal SQL is especially useful for nesting parenthesized clauses in the
2728 main SQL query. Here is a first example :
2730 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2734 bar => \["IN ($sub_stmt)" => @sub_bind],
2739 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2740 WHERE c2 < ? AND c3 LIKE ?))";
2741 @bind = (1234, 100, "foo%");
2743 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2744 are expressed in the same way. Of course the C<$sub_stmt> and
2745 its associated bind values can be generated through a former call
2748 my ($sub_stmt, @sub_bind)
2749 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2750 c3 => {-like => "foo%"}});
2753 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2756 In the examples above, the subquery was used as an operator on a column;
2757 but the same principle also applies for a clause within the main C<%where>
2758 hash, like an EXISTS subquery :
2760 my ($sub_stmt, @sub_bind)
2761 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2762 my %where = ( -and => [
2764 \["EXISTS ($sub_stmt)" => @sub_bind],
2769 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2770 WHERE c1 = ? AND c2 > t0.c0))";
2774 Observe that the condition on C<c2> in the subquery refers to
2775 column C<t0.c0> of the main query : this is I<not> a bind
2776 value, so we have to express it through a scalar ref.
2777 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2778 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2779 what we wanted here.
2781 Finally, here is an example where a subquery is used
2782 for expressing unary negation:
2784 my ($sub_stmt, @sub_bind)
2785 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2786 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2788 lname => {like => '%son%'},
2789 \["NOT ($sub_stmt)" => @sub_bind],
2794 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2795 @bind = ('%son%', 10, 20)
2797 =head3 Deprecated usage of Literal SQL
2799 Below are some examples of archaic use of literal SQL. It is shown only as
2800 reference for those who deal with legacy code. Each example has a much
2801 better, cleaner and safer alternative that users should opt for in new code.
2807 my %where = ( requestor => \'IS NOT NULL' )
2809 $stmt = "WHERE requestor IS NOT NULL"
2811 This used to be the way of generating NULL comparisons, before the handling
2812 of C<undef> got formalized. For new code please use the superior syntax as
2813 described in L</Tests for NULL values>.
2817 my %where = ( requestor => \'= submitter' )
2819 $stmt = "WHERE requestor = submitter"
2821 This used to be the only way to compare columns. Use the superior L</-ident>
2822 method for all new code. For example an identifier declared in such a way
2823 will be properly quoted if L</quote_char> is properly set, while the legacy
2824 form will remain as supplied.
2828 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2830 $stmt = "WHERE completed > ? AND is_ready"
2831 @bind = ('2012-12-21')
2833 Using an empty string literal used to be the only way to express a boolean.
2834 For all new code please use the much more readable
2835 L<-bool|/Unary operators: bool> operator.
2841 These pages could go on for a while, since the nesting of the data
2842 structures this module can handle are pretty much unlimited (the
2843 module implements the C<WHERE> expansion as a recursive function
2844 internally). Your best bet is to "play around" with the module a
2845 little to see how the data structures behave, and choose the best
2846 format for your data based on that.
2848 And of course, all the values above will probably be replaced with
2849 variables gotten from forms or the command line. After all, if you
2850 knew everything ahead of time, you wouldn't have to worry about
2851 dynamically-generating SQL and could just hardwire it into your
2854 =head1 ORDER BY CLAUSES
2856 Some functions take an order by clause. This can either be a scalar (just a
2857 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2858 or an array of either of the two previous forms. Examples:
2860 Given | Will Generate
2861 ----------------------------------------------------------
2863 \'colA DESC' | ORDER BY colA DESC
2865 'colA' | ORDER BY colA
2867 [qw/colA colB/] | ORDER BY colA, colB
2869 {-asc => 'colA'} | ORDER BY colA ASC
2871 {-desc => 'colB'} | ORDER BY colB DESC
2873 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2875 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2878 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2879 { -desc => [qw/colB/], | colC ASC, colD ASC
2880 { -asc => [qw/colC colD/],|
2882 ===========================================================
2886 =head1 SPECIAL OPERATORS
2888 my $sqlmaker = SQL::Abstract->new(special_ops => [
2892 my ($self, $field, $op, $arg) = @_;
2898 handler => 'method_name',
2902 A "special operator" is a SQL syntactic clause that can be
2903 applied to a field, instead of a usual binary operator.
2906 WHERE field IN (?, ?, ?)
2907 WHERE field BETWEEN ? AND ?
2908 WHERE MATCH(field) AGAINST (?, ?)
2910 Special operators IN and BETWEEN are fairly standard and therefore
2911 are builtin within C<SQL::Abstract> (as the overridable methods
2912 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2913 like the MATCH .. AGAINST example above which is specific to MySQL,
2914 you can write your own operator handlers - supply a C<special_ops>
2915 argument to the C<new> method. That argument takes an arrayref of
2916 operator definitions; each operator definition is a hashref with two
2923 the regular expression to match the operator
2927 Either a coderef or a plain scalar method name. In both cases
2928 the expected return is C<< ($sql, @bind) >>.
2930 When supplied with a method name, it is simply called on the
2931 L<SQL::Abstract> object as:
2933 $self->$method_name ($field, $op, $arg)
2937 $field is the LHS of the operator
2938 $op is the part that matched the handler regex
2941 When supplied with a coderef, it is called as:
2943 $coderef->($self, $field, $op, $arg)
2948 For example, here is an implementation
2949 of the MATCH .. AGAINST syntax for MySQL
2951 my $sqlmaker = SQL::Abstract->new(special_ops => [
2953 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2954 {regex => qr/^match$/i,
2956 my ($self, $field, $op, $arg) = @_;
2957 $arg = [$arg] if not ref $arg;
2958 my $label = $self->_quote($field);
2959 my ($placeholder) = $self->_convert('?');
2960 my $placeholders = join ", ", (($placeholder) x @$arg);
2961 my $sql = $self->_sqlcase('match') . " ($label) "
2962 . $self->_sqlcase('against') . " ($placeholders) ";
2963 my @bind = $self->_bindtype($field, @$arg);
2964 return ($sql, @bind);
2971 =head1 UNARY OPERATORS
2973 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2977 my ($self, $op, $arg) = @_;
2983 handler => 'method_name',
2987 A "unary operator" is a SQL syntactic clause that can be
2988 applied to a field - the operator goes before the field
2990 You can write your own operator handlers - supply a C<unary_ops>
2991 argument to the C<new> method. That argument takes an arrayref of
2992 operator definitions; each operator definition is a hashref with two
2999 the regular expression to match the operator
3003 Either a coderef or a plain scalar method name. In both cases
3004 the expected return is C<< $sql >>.
3006 When supplied with a method name, it is simply called on the
3007 L<SQL::Abstract> object as:
3009 $self->$method_name ($op, $arg)
3013 $op is the part that matched the handler regex
3014 $arg is the RHS or argument of the operator
3016 When supplied with a coderef, it is called as:
3018 $coderef->($self, $op, $arg)
3026 Thanks to some benchmarking by Mark Stosberg, it turns out that
3027 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3028 I must admit this wasn't an intentional design issue, but it's a
3029 byproduct of the fact that you get to control your C<DBI> handles
3032 To maximize performance, use a code snippet like the following:
3034 # prepare a statement handle using the first row
3035 # and then reuse it for the rest of the rows
3037 for my $href (@array_of_hashrefs) {
3038 $stmt ||= $sql->insert('table', $href);
3039 $sth ||= $dbh->prepare($stmt);
3040 $sth->execute($sql->values($href));
3043 The reason this works is because the keys in your C<$href> are sorted
3044 internally by B<SQL::Abstract>. Thus, as long as your data retains
3045 the same structure, you only have to generate the SQL the first time
3046 around. On subsequent queries, simply use the C<values> function provided
3047 by this module to return your values in the correct order.
3049 However this depends on the values having the same type - if, for
3050 example, the values of a where clause may either have values
3051 (resulting in sql of the form C<column = ?> with a single bind
3052 value), or alternatively the values might be C<undef> (resulting in
3053 sql of the form C<column IS NULL> with no bind value) then the
3054 caching technique suggested will not work.
3058 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3059 really like this part (I do, at least). Building up a complex query
3060 can be as simple as the following:
3067 use CGI::FormBuilder;
3070 my $form = CGI::FormBuilder->new(...);
3071 my $sql = SQL::Abstract->new;
3073 if ($form->submitted) {
3074 my $field = $form->field;
3075 my $id = delete $field->{id};
3076 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3079 Of course, you would still have to connect using C<DBI> to run the
3080 query, but the point is that if you make your form look like your
3081 table, the actual query script can be extremely simplistic.
3083 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3084 a fast interface to returning and formatting data. I frequently
3085 use these three modules together to write complex database query
3086 apps in under 50 lines.
3088 =head1 HOW TO CONTRIBUTE
3090 Contributions are always welcome, in all usable forms (we especially
3091 welcome documentation improvements). The delivery methods include git-
3092 or unified-diff formatted patches, GitHub pull requests, or plain bug
3093 reports either via RT or the Mailing list. Contributors are generally
3094 granted full access to the official repository after their first several
3095 patches pass successful review.
3097 This project is maintained in a git repository. The code and related tools are
3098 accessible at the following locations:
3102 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3104 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3106 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3108 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3114 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3115 Great care has been taken to preserve the I<published> behavior
3116 documented in previous versions in the 1.* family; however,
3117 some features that were previously undocumented, or behaved
3118 differently from the documentation, had to be changed in order
3119 to clarify the semantics. Hence, client code that was relying
3120 on some dark areas of C<SQL::Abstract> v1.*
3121 B<might behave differently> in v1.50.
3123 The main changes are :
3129 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3133 support for the { operator => \"..." } construct (to embed literal SQL)
3137 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3141 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3145 defensive programming : check arguments
3149 fixed bug with global logic, which was previously implemented
3150 through global variables yielding side-effects. Prior versions would
3151 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3152 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3153 Now this is interpreted
3154 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3159 fixed semantics of _bindtype on array args
3163 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3164 we just avoid shifting arrays within that tree.
3168 dropped the C<_modlogic> function
3172 =head1 ACKNOWLEDGEMENTS
3174 There are a number of individuals that have really helped out with
3175 this module. Unfortunately, most of them submitted bugs via CPAN
3176 so I have no idea who they are! But the people I do know are:
3178 Ash Berlin (order_by hash term support)
3179 Matt Trout (DBIx::Class support)
3180 Mark Stosberg (benchmarking)
3181 Chas Owens (initial "IN" operator support)
3182 Philip Collins (per-field SQL functions)
3183 Eric Kolve (hashref "AND" support)
3184 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3185 Dan Kubb (support for "quote_char" and "name_sep")
3186 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3187 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3188 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3189 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3190 Oliver Charles (support for "RETURNING" after "INSERT")
3196 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3200 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3202 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3204 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3205 While not an official support venue, C<DBIx::Class> makes heavy use of
3206 C<SQL::Abstract>, and as such list members there are very familiar with
3207 how to create queries.
3211 This module is free software; you may copy this under the same
3212 terms as perl itself (either the GNU General Public License or
3213 the Artistic License)