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.81';
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 # Used by DBIx::Class::SQLMaker->insert
231 sub _insert_returning { shift->_returning(@_) }
234 my ($self, $options) = @_;
236 my $f = $options->{returning};
238 my $fieldlist = $self->_SWITCH_refkind($f, {
239 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
240 SCALAR => sub {$self->_quote($f)},
241 SCALARREF => sub {$$f},
243 return $self->_sqlcase(' returning ') . $fieldlist;
246 sub _insert_HASHREF { # explicit list of fields and then values
247 my ($self, $data) = @_;
249 my @fields = sort keys %$data;
251 my ($sql, @bind) = $self->_insert_values($data);
254 $_ = $self->_quote($_) foreach @fields;
255 $sql = "( ".join(", ", @fields).") ".$sql;
257 return ($sql, @bind);
260 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
261 my ($self, $data) = @_;
263 # no names (arrayref) so can't generate bindtype
264 $self->{bindtype} ne 'columns'
265 or belch "can't do 'columns' bindtype when called with arrayref";
267 # fold the list of values into a hash of column name - value pairs
268 # (where the column names are artificially generated, and their
269 # lexicographical ordering keep the ordering of the original list)
270 my $i = "a"; # incremented values will be in lexicographical order
271 my $data_in_hash = { map { ($i++ => $_) } @$data };
273 return $self->_insert_values($data_in_hash);
276 sub _insert_ARRAYREFREF { # literal SQL with bind
277 my ($self, $data) = @_;
279 my ($sql, @bind) = @${$data};
280 $self->_assert_bindval_matches_bindtype(@bind);
282 return ($sql, @bind);
286 sub _insert_SCALARREF { # literal SQL without bind
287 my ($self, $data) = @_;
293 my ($self, $data) = @_;
295 my (@values, @all_bind);
296 foreach my $column (sort keys %$data) {
297 my $v = $data->{$column};
299 $self->_SWITCH_refkind($v, {
302 if ($self->{array_datatypes}) { # if array datatype are activated
304 push @all_bind, $self->_bindtype($column, $v);
306 else { # else literal SQL with bind
307 my ($sql, @bind) = @$v;
308 $self->_assert_bindval_matches_bindtype(@bind);
310 push @all_bind, @bind;
314 ARRAYREFREF => sub { # literal SQL with bind
315 my ($sql, @bind) = @${$v};
316 $self->_assert_bindval_matches_bindtype(@bind);
318 push @all_bind, @bind;
321 # THINK : anything useful to do with a HASHREF ?
322 HASHREF => sub { # (nothing, but old SQLA passed it through)
323 #TODO in SQLA >= 2.0 it will die instead
324 belch "HASH ref as bind value in insert is not supported";
326 push @all_bind, $self->_bindtype($column, $v);
329 SCALARREF => sub { # literal SQL without bind
333 SCALAR_or_UNDEF => sub {
335 push @all_bind, $self->_bindtype($column, $v);
342 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
343 return ($sql, @all_bind);
348 #======================================================================
350 #======================================================================
355 my $table = $self->_table(shift);
356 my $data = shift || return;
360 # first build the 'SET' part of the sql statement
361 my (@set, @all_bind);
362 puke "Unsupported data type specified to \$sql->update"
363 unless ref $data eq 'HASH';
365 for my $k (sort keys %$data) {
368 my $label = $self->_quote($k);
370 $self->_SWITCH_refkind($v, {
372 if ($self->{array_datatypes}) { # array datatype
373 push @set, "$label = ?";
374 push @all_bind, $self->_bindtype($k, $v);
376 else { # literal SQL with bind
377 my ($sql, @bind) = @$v;
378 $self->_assert_bindval_matches_bindtype(@bind);
379 push @set, "$label = $sql";
380 push @all_bind, @bind;
383 ARRAYREFREF => sub { # literal SQL with bind
384 my ($sql, @bind) = @${$v};
385 $self->_assert_bindval_matches_bindtype(@bind);
386 push @set, "$label = $sql";
387 push @all_bind, @bind;
389 SCALARREF => sub { # literal SQL without bind
390 push @set, "$label = $$v";
393 my ($op, $arg, @rest) = %$v;
395 puke 'Operator calls in update must be in the form { -op => $arg }'
396 if (@rest or not $op =~ /^\-(.+)/);
398 local $self->{_nested_func_lhs} = $k;
399 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
401 push @set, "$label = $sql";
402 push @all_bind, @bind;
404 SCALAR_or_UNDEF => sub {
405 push @set, "$label = ?";
406 push @all_bind, $self->_bindtype($k, $v);
412 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
416 my($where_sql, @where_bind) = $self->where($where);
418 push @all_bind, @where_bind;
421 if ($options->{returning}) {
422 my ($returning_sql, @returning_bind) = $self->_update_returning ($options);
423 $sql .= $returning_sql;
424 push @all_bind, @returning_bind;
427 return wantarray ? ($sql, @all_bind) : $sql;
430 sub _update_returning { shift->_returning(@_) }
434 #======================================================================
436 #======================================================================
441 my $table = $self->_table(shift);
442 my $fields = shift || '*';
446 my($where_sql, @bind) = $self->where($where, $order);
448 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
450 my $sql = join(' ', $self->_sqlcase('select'), $f,
451 $self->_sqlcase('from'), $table)
454 return wantarray ? ($sql, @bind) : $sql;
457 #======================================================================
459 #======================================================================
464 my $table = $self->_table(shift);
468 my($where_sql, @bind) = $self->where($where);
469 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
471 return wantarray ? ($sql, @bind) : $sql;
475 #======================================================================
477 #======================================================================
481 # Finally, a separate routine just to handle WHERE clauses
483 my ($self, $where, $order) = @_;
486 my ($sql, @bind) = $self->_recurse_where($where);
487 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
491 $sql .= $self->_order_by($order);
494 return wantarray ? ($sql, @bind) : $sql;
499 my ($self, $where, $logic) = @_;
501 # dispatch on appropriate method according to refkind of $where
502 my $method = $self->_METHOD_FOR_refkind("_where", $where);
504 my ($sql, @bind) = $self->$method($where, $logic);
506 # DBIx::Class used to call _recurse_where in scalar context
507 # something else might too...
509 return ($sql, @bind);
512 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
519 #======================================================================
520 # WHERE: top-level ARRAYREF
521 #======================================================================
524 sub _where_ARRAYREF {
525 my ($self, $where, $logic) = @_;
527 $logic = uc($logic || $self->{logic});
528 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
530 my @clauses = @$where;
532 my (@sql_clauses, @all_bind);
533 # need to use while() so can shift() for pairs
535 my $el = shift @clauses;
537 $el = undef if (defined $el and ! length $el);
539 # switch according to kind of $el and get corresponding ($sql, @bind)
540 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
542 # skip empty elements, otherwise get invalid trailing AND stuff
543 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
547 $self->_assert_bindval_matches_bindtype(@b);
551 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
553 SCALARREF => sub { ($$el); },
556 # top-level arrayref with scalars, recurse in pairs
557 $self->_recurse_where({$el => shift(@clauses)})
560 UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
564 push @sql_clauses, $sql;
565 push @all_bind, @bind;
569 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
572 #======================================================================
573 # WHERE: top-level ARRAYREFREF
574 #======================================================================
576 sub _where_ARRAYREFREF {
577 my ($self, $where) = @_;
578 my ($sql, @bind) = @$$where;
579 $self->_assert_bindval_matches_bindtype(@bind);
580 return ($sql, @bind);
583 #======================================================================
584 # WHERE: top-level HASHREF
585 #======================================================================
588 my ($self, $where) = @_;
589 my (@sql_clauses, @all_bind);
591 for my $k (sort keys %$where) {
592 my $v = $where->{$k};
594 # ($k => $v) is either a special unary op or a regular hashpair
595 my ($sql, @bind) = do {
597 # put the operator in canonical form
599 $op = substr $op, 1; # remove initial dash
600 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
601 $op =~ s/\s+/ /g; # compress whitespace
603 # so that -not_foo works correctly
604 $op =~ s/^not_/NOT /i;
606 $self->_debug("Unary OP(-$op) within hashref, recursing...");
607 my ($s, @b) = $self->_where_unary_op ($op, $v);
609 # top level vs nested
610 # we assume that handled unary ops will take care of their ()s
612 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
614 ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
620 if (is_literal_value ($v) ) {
621 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
624 puke "Supplying an empty left hand side argument is not supported in hash-pairs";
628 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
629 $self->$method($k, $v);
633 push @sql_clauses, $sql;
634 push @all_bind, @bind;
637 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
640 sub _where_unary_op {
641 my ($self, $op, $rhs) = @_;
643 # top level special ops are illegal in general
644 # this includes the -ident/-value ops (dual purpose unary and special)
645 puke "Illegal use of top-level '-$op'"
646 if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}};
648 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
649 my $handler = $op_entry->{handler};
651 if (not ref $handler) {
652 if ($op =~ s/ [_\s]? \d+ $//x ) {
653 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
654 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
656 return $self->$handler ($op, $rhs);
658 elsif (ref $handler eq 'CODE') {
659 return $handler->($self, $op, $rhs);
662 puke "Illegal handler for operator $op - expecting a method name or a coderef";
666 $self->_debug("Generic unary OP: $op - recursing as function");
668 $self->_assert_pass_injection_guard($op);
670 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
672 puke "Illegal use of top-level '-$op'"
673 unless defined $self->{_nested_func_lhs};
676 $self->_convert('?'),
677 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
681 $self->_recurse_where ($rhs)
685 $sql = sprintf ('%s %s',
686 $self->_sqlcase($op),
690 return ($sql, @bind);
693 sub _where_op_ANDOR {
694 my ($self, $op, $v) = @_;
696 $self->_SWITCH_refkind($v, {
698 return $self->_where_ARRAYREF($v, $op);
702 return ( $op =~ /^or/i )
703 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
704 : $self->_where_HASHREF($v);
708 puke "-$op => \\\$scalar makes little sense, use " .
710 ? '[ \$scalar, \%rest_of_conditions ] instead'
711 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
716 puke "-$op => \\[...] makes little sense, use " .
718 ? '[ \[...], \%rest_of_conditions ] instead'
719 : '-and => [ \[...], \%rest_of_conditions ] instead'
723 SCALAR => sub { # permissively interpreted as SQL
724 puke "-$op => \$value makes little sense, use -bool => \$value instead";
728 puke "-$op => undef not supported";
734 my ($self, $op, $v) = @_;
736 $self->_SWITCH_refkind($v, {
738 SCALAR => sub { # permissively interpreted as SQL
739 belch "literal SQL should be -nest => \\'scalar' "
740 . "instead of -nest => 'scalar' ";
745 puke "-$op => undef not supported";
749 $self->_recurse_where ($v);
757 my ($self, $op, $v) = @_;
759 my ($s, @b) = $self->_SWITCH_refkind($v, {
760 SCALAR => sub { # interpreted as SQL column
761 $self->_convert($self->_quote($v));
765 puke "-$op => undef not supported";
769 $self->_recurse_where ($v);
773 $s = "(NOT $s)" if $op =~ /^not/i;
778 sub _where_op_IDENT {
780 my ($op, $rhs) = splice @_, -2;
781 if (! defined $rhs or length ref $rhs) {
782 puke "-$op requires a single plain scalar argument (a quotable identifier)";
785 # in case we are called as a top level special op (no '=')
788 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
796 sub _where_op_VALUE {
798 my ($op, $rhs) = splice @_, -2;
800 # in case we are called as a top level special op (no '=')
804 if (! defined $rhs) {
806 ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
813 ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ),
820 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
824 $self->_convert('?'),
830 sub _where_hashpair_ARRAYREF {
831 my ($self, $k, $v) = @_;
834 my @v = @$v; # need copy because of shift below
835 $self->_debug("ARRAY($k) means distribute over elements");
837 # put apart first element if it is an operator (-and, -or)
839 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
843 my @distributed = map { {$k => $_} } @v;
846 $self->_debug("OP($op) reinjected into the distributed array");
847 unshift @distributed, $op;
850 my $logic = $op ? substr($op, 1) : '';
852 return $self->_recurse_where(\@distributed, $logic);
855 $self->_debug("empty ARRAY($k) means 0=1");
856 return ($self->{sqlfalse});
860 sub _where_hashpair_HASHREF {
861 my ($self, $k, $v, $logic) = @_;
864 local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
865 ? $self->{_nested_func_lhs}
869 my ($all_sql, @all_bind);
871 for my $orig_op (sort keys %$v) {
872 my $val = $v->{$orig_op};
874 # put the operator in canonical form
877 # FIXME - we need to phase out dash-less ops
878 $op =~ s/^-//; # remove possible initial dash
879 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
880 $op =~ s/\s+/ /g; # compress whitespace
882 $self->_assert_pass_injection_guard($op);
885 $op =~ s/^is_not/IS NOT/i;
887 # so that -not_foo works correctly
888 $op =~ s/^not_/NOT /i;
890 # another retarded special case: foo => { $op => { -value => undef } }
891 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
897 # CASE: col-value logic modifiers
898 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
899 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
901 # CASE: special operators like -in or -between
902 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
903 my $handler = $special_op->{handler};
905 puke "No handler supplied for special operator $orig_op";
907 elsif (not ref $handler) {
908 ($sql, @bind) = $self->$handler ($k, $op, $val);
910 elsif (ref $handler eq 'CODE') {
911 ($sql, @bind) = $handler->($self, $k, $op, $val);
914 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
918 $self->_SWITCH_refkind($val, {
920 ARRAYREF => sub { # CASE: col => {op => \@vals}
921 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
924 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
925 my ($sub_sql, @sub_bind) = @$$val;
926 $self->_assert_bindval_matches_bindtype(@sub_bind);
927 $sql = join ' ', $self->_convert($self->_quote($k)),
928 $self->_sqlcase($op),
933 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
935 $op =~ /^not$/i ? 'is not' # legacy
936 : $op =~ $self->{equality_op} ? 'is'
937 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
938 : $op =~ $self->{inequality_op} ? 'is not'
939 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
940 : puke "unexpected operator '$orig_op' with undef operand";
942 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
945 FALLBACK => sub { # CASE: col => {op/func => $stuff}
946 ($sql, @bind) = $self->_where_unary_op ($op, $val);
949 $self->_convert($self->_quote($k)),
950 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
956 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
957 push @all_bind, @bind;
959 return ($all_sql, @all_bind);
962 sub _where_field_IS {
963 my ($self, $k, $op, $v) = @_;
965 my ($s) = $self->_SWITCH_refkind($v, {
968 $self->_convert($self->_quote($k)),
969 map { $self->_sqlcase($_)} ($op, 'null')
972 puke "$op can only take undef as argument";
979 sub _where_field_op_ARRAYREF {
980 my ($self, $k, $op, $vals) = @_;
982 my @vals = @$vals; #always work on a copy
985 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
987 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
990 # see if the first element is an -and/-or op
992 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
997 # a long standing API wart - an attempt to change this behavior during
998 # the 1.50 series failed *spectacularly*. Warn instead and leave the
1003 (!$logic or $logic eq 'OR')
1005 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
1008 belch "A multi-element arrayref as an argument to the inequality op '$o' "
1009 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
1010 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1014 # distribute $op over each remaining member of @vals, append logic if exists
1015 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1019 # try to DWIM on equality operators
1021 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1022 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1023 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1024 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1025 : puke "operator '$op' applied on an empty array (field '$k')";
1030 sub _where_hashpair_SCALARREF {
1031 my ($self, $k, $v) = @_;
1032 $self->_debug("SCALAR($k) means literal SQL: $$v");
1033 my $sql = $self->_quote($k) . " " . $$v;
1037 # literal SQL with bind
1038 sub _where_hashpair_ARRAYREFREF {
1039 my ($self, $k, $v) = @_;
1040 $self->_debug("REF($k) means literal SQL: @${$v}");
1041 my ($sql, @bind) = @$$v;
1042 $self->_assert_bindval_matches_bindtype(@bind);
1043 $sql = $self->_quote($k) . " " . $sql;
1044 return ($sql, @bind );
1047 # literal SQL without bind
1048 sub _where_hashpair_SCALAR {
1049 my ($self, $k, $v) = @_;
1050 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1051 my $sql = join ' ', $self->_convert($self->_quote($k)),
1052 $self->_sqlcase($self->{cmp}),
1053 $self->_convert('?');
1054 my @bind = $self->_bindtype($k, $v);
1055 return ( $sql, @bind);
1059 sub _where_hashpair_UNDEF {
1060 my ($self, $k, $v) = @_;
1061 $self->_debug("UNDEF($k) means IS NULL");
1062 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
1066 #======================================================================
1067 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1068 #======================================================================
1071 sub _where_SCALARREF {
1072 my ($self, $where) = @_;
1075 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1081 my ($self, $where) = @_;
1084 $self->_debug("NOREF(*top) means literal SQL: $where");
1095 #======================================================================
1096 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1097 #======================================================================
1100 sub _where_field_BETWEEN {
1101 my ($self, $k, $op, $vals) = @_;
1103 my ($label, $and, $placeholder);
1104 $label = $self->_convert($self->_quote($k));
1105 $and = ' ' . $self->_sqlcase('and') . ' ';
1106 $placeholder = $self->_convert('?');
1107 $op = $self->_sqlcase($op);
1109 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1111 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1112 ARRAYREFREF => sub {
1113 my ($s, @b) = @$$vals;
1114 $self->_assert_bindval_matches_bindtype(@b);
1121 puke $invalid_args if @$vals != 2;
1123 my (@all_sql, @all_bind);
1124 foreach my $val (@$vals) {
1125 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1127 return ($placeholder, $self->_bindtype($k, $val) );
1132 ARRAYREFREF => sub {
1133 my ($sql, @bind) = @$$val;
1134 $self->_assert_bindval_matches_bindtype(@bind);
1135 return ($sql, @bind);
1138 my ($func, $arg, @rest) = %$val;
1139 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1140 if (@rest or $func !~ /^ \- (.+)/x);
1141 $self->_where_unary_op ($1 => $arg);
1147 push @all_sql, $sql;
1148 push @all_bind, @bind;
1152 (join $and, @all_sql),
1161 my $sql = "( $label $op $clause )";
1162 return ($sql, @bind)
1166 sub _where_field_IN {
1167 my ($self, $k, $op, $vals) = @_;
1169 # backwards compatibility : if scalar, force into an arrayref
1170 $vals = [$vals] if defined $vals && ! ref $vals;
1172 my ($label) = $self->_convert($self->_quote($k));
1173 my ($placeholder) = $self->_convert('?');
1174 $op = $self->_sqlcase($op);
1176 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1177 ARRAYREF => sub { # list of choices
1178 if (@$vals) { # nonempty list
1179 my (@all_sql, @all_bind);
1181 for my $val (@$vals) {
1182 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1184 return ($placeholder, $val);
1189 ARRAYREFREF => sub {
1190 my ($sql, @bind) = @$$val;
1191 $self->_assert_bindval_matches_bindtype(@bind);
1192 return ($sql, @bind);
1195 my ($func, $arg, @rest) = %$val;
1196 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1197 if (@rest or $func !~ /^ \- (.+)/x);
1198 $self->_where_unary_op ($1 => $arg);
1202 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1203 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1204 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1205 . 'will emit the logically correct SQL instead of raising this exception)'
1209 push @all_sql, $sql;
1210 push @all_bind, @bind;
1214 sprintf ('%s %s ( %s )',
1217 join (', ', @all_sql)
1219 $self->_bindtype($k, @all_bind),
1222 else { # empty list : some databases won't understand "IN ()", so DWIM
1223 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1228 SCALARREF => sub { # literal SQL
1229 my $sql = $self->_open_outer_paren ($$vals);
1230 return ("$label $op ( $sql )");
1232 ARRAYREFREF => sub { # literal SQL with bind
1233 my ($sql, @bind) = @$$vals;
1234 $self->_assert_bindval_matches_bindtype(@bind);
1235 $sql = $self->_open_outer_paren ($sql);
1236 return ("$label $op ( $sql )", @bind);
1240 puke "Argument passed to the '$op' operator can not be undefined";
1244 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1248 return ($sql, @bind);
1251 # Some databases (SQLite) treat col IN (1, 2) different from
1252 # col IN ( (1, 2) ). Use this to strip all outer parens while
1253 # adding them back in the corresponding method
1254 sub _open_outer_paren {
1255 my ($self, $sql) = @_;
1257 while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
1259 # there are closing parens inside, need the heavy duty machinery
1260 # to reevaluate the extraction starting from $sql (full reevaluation)
1261 if ( $inner =~ /\)/ ) {
1262 require Text::Balanced;
1264 my (undef, $remainder) = do {
1265 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1267 Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
1270 # the entire expression needs to be a balanced bracketed thing
1271 # (after an extract no remainder sans trailing space)
1272 last if defined $remainder and $remainder =~ /\S/;
1282 #======================================================================
1284 #======================================================================
1287 my ($self, $arg) = @_;
1290 for my $c ($self->_order_by_chunks ($arg) ) {
1291 $self->_SWITCH_refkind ($c, {
1292 SCALAR => sub { push @sql, $c },
1293 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1299 $self->_sqlcase(' order by'),
1305 return wantarray ? ($sql, @bind) : $sql;
1308 sub _order_by_chunks {
1309 my ($self, $arg) = @_;
1311 return $self->_SWITCH_refkind($arg, {
1314 map { $self->_order_by_chunks ($_ ) } @$arg;
1317 ARRAYREFREF => sub {
1318 my ($s, @b) = @$$arg;
1319 $self->_assert_bindval_matches_bindtype(@b);
1323 SCALAR => sub {$self->_quote($arg)},
1325 UNDEF => sub {return () },
1327 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1330 # get first pair in hash
1331 my ($key, $val, @rest) = %$arg;
1333 return () unless $key;
1335 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1336 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1342 for my $c ($self->_order_by_chunks ($val)) {
1345 $self->_SWITCH_refkind ($c, {
1350 ($sql, @bind) = @$c;
1354 $sql = $sql . ' ' . $self->_sqlcase($direction);
1356 push @ret, [ $sql, @bind];
1365 #======================================================================
1366 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1367 #======================================================================
1372 $self->_SWITCH_refkind($from, {
1373 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1374 SCALAR => sub {$self->_quote($from)},
1375 SCALARREF => sub {$$from},
1380 #======================================================================
1382 #======================================================================
1384 # highly optimized, as it's called way too often
1386 # my ($self, $label) = @_;
1388 return '' unless defined $_[1];
1389 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1391 unless ($_[0]->{quote_char}) {
1392 $_[0]->_assert_pass_injection_guard($_[1]);
1396 my $qref = ref $_[0]->{quote_char};
1399 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1401 elsif ($qref eq 'ARRAY') {
1402 ($l, $r) = @{$_[0]->{quote_char}};
1405 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1407 my $esc = $_[0]->{escape_char} || $r;
1409 # parts containing * are naturally unquoted
1410 return join( $_[0]->{name_sep}||'', map
1411 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1412 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1417 # Conversion, if applicable
1419 #my ($self, $arg) = @_;
1420 if ($_[0]->{convert}) {
1421 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1428 #my ($self, $col, @vals) = @_;
1429 # called often - tighten code
1430 return $_[0]->{bindtype} eq 'columns'
1431 ? map {[$_[1], $_]} @_[2 .. $#_]
1436 # Dies if any element of @bind is not in [colname => value] format
1437 # if bindtype is 'columns'.
1438 sub _assert_bindval_matches_bindtype {
1439 # my ($self, @bind) = @_;
1441 if ($self->{bindtype} eq 'columns') {
1443 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1444 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1450 sub _join_sql_clauses {
1451 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1453 if (@$clauses_aref > 1) {
1454 my $join = " " . $self->_sqlcase($logic) . " ";
1455 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1456 return ($sql, @$bind_aref);
1458 elsif (@$clauses_aref) {
1459 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1462 return (); # if no SQL, ignore @$bind_aref
1467 # Fix SQL case, if so requested
1469 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1470 # don't touch the argument ... crooked logic, but let's not change it!
1471 return $_[0]->{case} ? $_[1] : uc($_[1]);
1475 #======================================================================
1476 # DISPATCHING FROM REFKIND
1477 #======================================================================
1480 my ($self, $data) = @_;
1482 return 'UNDEF' unless defined $data;
1484 # blessed objects are treated like scalars
1485 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1487 return 'SCALAR' unless $ref;
1490 while ($ref eq 'REF') {
1492 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1496 return ($ref||'SCALAR') . ('REF' x $n_steps);
1500 my ($self, $data) = @_;
1501 my @try = ($self->_refkind($data));
1502 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1503 push @try, 'FALLBACK';
1507 sub _METHOD_FOR_refkind {
1508 my ($self, $meth_prefix, $data) = @_;
1511 for (@{$self->_try_refkind($data)}) {
1512 $method = $self->can($meth_prefix."_".$_)
1516 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1520 sub _SWITCH_refkind {
1521 my ($self, $data, $dispatch_table) = @_;
1524 for (@{$self->_try_refkind($data)}) {
1525 $coderef = $dispatch_table->{$_}
1529 puke "no dispatch entry for ".$self->_refkind($data)
1538 #======================================================================
1539 # VALUES, GENERATE, AUTOLOAD
1540 #======================================================================
1542 # LDNOTE: original code from nwiger, didn't touch code in that section
1543 # I feel the AUTOLOAD stuff should not be the default, it should
1544 # only be activated on explicit demand by user.
1548 my $data = shift || return;
1549 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1550 unless ref $data eq 'HASH';
1553 foreach my $k ( sort keys %$data ) {
1554 my $v = $data->{$k};
1555 $self->_SWITCH_refkind($v, {
1557 if ($self->{array_datatypes}) { # array datatype
1558 push @all_bind, $self->_bindtype($k, $v);
1560 else { # literal SQL with bind
1561 my ($sql, @bind) = @$v;
1562 $self->_assert_bindval_matches_bindtype(@bind);
1563 push @all_bind, @bind;
1566 ARRAYREFREF => sub { # literal SQL with bind
1567 my ($sql, @bind) = @${$v};
1568 $self->_assert_bindval_matches_bindtype(@bind);
1569 push @all_bind, @bind;
1571 SCALARREF => sub { # literal SQL without bind
1573 SCALAR_or_UNDEF => sub {
1574 push @all_bind, $self->_bindtype($k, $v);
1585 my(@sql, @sqlq, @sqlv);
1589 if ($ref eq 'HASH') {
1590 for my $k (sort keys %$_) {
1593 my $label = $self->_quote($k);
1594 if ($r eq 'ARRAY') {
1595 # literal SQL with bind
1596 my ($sql, @bind) = @$v;
1597 $self->_assert_bindval_matches_bindtype(@bind);
1598 push @sqlq, "$label = $sql";
1600 } elsif ($r eq 'SCALAR') {
1601 # literal SQL without bind
1602 push @sqlq, "$label = $$v";
1604 push @sqlq, "$label = ?";
1605 push @sqlv, $self->_bindtype($k, $v);
1608 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1609 } elsif ($ref eq 'ARRAY') {
1610 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1613 if ($r eq 'ARRAY') { # literal SQL with bind
1614 my ($sql, @bind) = @$v;
1615 $self->_assert_bindval_matches_bindtype(@bind);
1618 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1619 # embedded literal SQL
1626 push @sql, '(' . join(', ', @sqlq) . ')';
1627 } elsif ($ref eq 'SCALAR') {
1631 # strings get case twiddled
1632 push @sql, $self->_sqlcase($_);
1636 my $sql = join ' ', @sql;
1638 # this is pretty tricky
1639 # if ask for an array, return ($stmt, @bind)
1640 # otherwise, s/?/shift @sqlv/ to put it inline
1642 return ($sql, @sqlv);
1644 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1645 ref $d ? $d->[1] : $d/e;
1654 # This allows us to check for a local, then _form, attr
1656 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1657 return $self->generate($name, @_);
1668 SQL::Abstract - Generate SQL from Perl data structures
1674 my $sql = SQL::Abstract->new;
1676 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1678 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1680 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1682 my($stmt, @bind) = $sql->delete($table, \%where);
1684 # Then, use these in your DBI statements
1685 my $sth = $dbh->prepare($stmt);
1686 $sth->execute(@bind);
1688 # Just generate the WHERE clause
1689 my($stmt, @bind) = $sql->where(\%where, \@order);
1691 # Return values in the same order, for hashed queries
1692 # See PERFORMANCE section for more details
1693 my @bind = $sql->values(\%fieldvals);
1697 This module was inspired by the excellent L<DBIx::Abstract>.
1698 However, in using that module I found that what I really wanted
1699 to do was generate SQL, but still retain complete control over my
1700 statement handles and use the DBI interface. So, I set out to
1701 create an abstract SQL generation module.
1703 While based on the concepts used by L<DBIx::Abstract>, there are
1704 several important differences, especially when it comes to WHERE
1705 clauses. I have modified the concepts used to make the SQL easier
1706 to generate from Perl data structures and, IMO, more intuitive.
1707 The underlying idea is for this module to do what you mean, based
1708 on the data structures you provide it. The big advantage is that
1709 you don't have to modify your code every time your data changes,
1710 as this module figures it out.
1712 To begin with, an SQL INSERT is as easy as just specifying a hash
1713 of C<key=value> pairs:
1716 name => 'Jimbo Bobson',
1717 phone => '123-456-7890',
1718 address => '42 Sister Lane',
1719 city => 'St. Louis',
1720 state => 'Louisiana',
1723 The SQL can then be generated with this:
1725 my($stmt, @bind) = $sql->insert('people', \%data);
1727 Which would give you something like this:
1729 $stmt = "INSERT INTO people
1730 (address, city, name, phone, state)
1731 VALUES (?, ?, ?, ?, ?)";
1732 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1733 '123-456-7890', 'Louisiana');
1735 These are then used directly in your DBI code:
1737 my $sth = $dbh->prepare($stmt);
1738 $sth->execute(@bind);
1740 =head2 Inserting and Updating Arrays
1742 If your database has array types (like for example Postgres),
1743 activate the special option C<< array_datatypes => 1 >>
1744 when creating the C<SQL::Abstract> object.
1745 Then you may use an arrayref to insert and update database array types:
1747 my $sql = SQL::Abstract->new(array_datatypes => 1);
1749 planets => [qw/Mercury Venus Earth Mars/]
1752 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1756 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1758 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1761 =head2 Inserting and Updating SQL
1763 In order to apply SQL functions to elements of your C<%data> you may
1764 specify a reference to an arrayref for the given hash value. For example,
1765 if you need to execute the Oracle C<to_date> function on a value, you can
1766 say something like this:
1770 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1773 The first value in the array is the actual SQL. Any other values are
1774 optional and would be included in the bind values array. This gives
1777 my($stmt, @bind) = $sql->insert('people', \%data);
1779 $stmt = "INSERT INTO people (name, date_entered)
1780 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1781 @bind = ('Bill', '03/02/2003');
1783 An UPDATE is just as easy, all you change is the name of the function:
1785 my($stmt, @bind) = $sql->update('people', \%data);
1787 Notice that your C<%data> isn't touched; the module will generate
1788 the appropriately quirky SQL for you automatically. Usually you'll
1789 want to specify a WHERE clause for your UPDATE, though, which is
1790 where handling C<%where> hashes comes in handy...
1792 =head2 Complex where statements
1794 This module can generate pretty complicated WHERE statements
1795 easily. For example, simple C<key=value> pairs are taken to mean
1796 equality, and if you want to see if a field is within a set
1797 of values, you can use an arrayref. Let's say we wanted to
1798 SELECT some data based on this criteria:
1801 requestor => 'inna',
1802 worker => ['nwiger', 'rcwe', 'sfz'],
1803 status => { '!=', 'completed' }
1806 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1808 The above would give you something like this:
1810 $stmt = "SELECT * FROM tickets WHERE
1811 ( requestor = ? ) AND ( status != ? )
1812 AND ( worker = ? OR worker = ? OR worker = ? )";
1813 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1815 Which you could then use in DBI code like so:
1817 my $sth = $dbh->prepare($stmt);
1818 $sth->execute(@bind);
1824 The methods are simple. There's one for every major SQL operation,
1825 and a constructor you use first. The arguments are specified in a
1826 similar order for each method (table, then fields, then a where
1827 clause) to try and simplify things.
1829 =head2 new(option => 'value')
1831 The C<new()> function takes a list of options and values, and returns
1832 a new B<SQL::Abstract> object which can then be used to generate SQL
1833 through the methods below. The options accepted are:
1839 If set to 'lower', then SQL will be generated in all lowercase. By
1840 default SQL is generated in "textbook" case meaning something like:
1842 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1844 Any setting other than 'lower' is ignored.
1848 This determines what the default comparison operator is. By default
1849 it is C<=>, meaning that a hash like this:
1851 %where = (name => 'nwiger', email => 'nate@wiger.org');
1853 Will generate SQL like this:
1855 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1857 However, you may want loose comparisons by default, so if you set
1858 C<cmp> to C<like> you would get SQL such as:
1860 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1862 You can also override the comparison on an individual basis - see
1863 the huge section on L</"WHERE CLAUSES"> at the bottom.
1865 =item sqltrue, sqlfalse
1867 Expressions for inserting boolean values within SQL statements.
1868 By default these are C<1=1> and C<1=0>. They are used
1869 by the special operators C<-in> and C<-not_in> for generating
1870 correct SQL even when the argument is an empty array (see below).
1874 This determines the default logical operator for multiple WHERE
1875 statements in arrays or hashes. If absent, the default logic is "or"
1876 for arrays, and "and" for hashes. This means that a WHERE
1880 event_date => {'>=', '2/13/99'},
1881 event_date => {'<=', '4/24/03'},
1884 will generate SQL like this:
1886 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1888 This is probably not what you want given this query, though (look
1889 at the dates). To change the "OR" to an "AND", simply specify:
1891 my $sql = SQL::Abstract->new(logic => 'and');
1893 Which will change the above C<WHERE> to:
1895 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1897 The logic can also be changed locally by inserting
1898 a modifier in front of an arrayref :
1900 @where = (-and => [event_date => {'>=', '2/13/99'},
1901 event_date => {'<=', '4/24/03'} ]);
1903 See the L</"WHERE CLAUSES"> section for explanations.
1907 This will automatically convert comparisons using the specified SQL
1908 function for both column and value. This is mostly used with an argument
1909 of C<upper> or C<lower>, so that the SQL will have the effect of
1910 case-insensitive "searches". For example, this:
1912 $sql = SQL::Abstract->new(convert => 'upper');
1913 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1915 Will turn out the following SQL:
1917 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1919 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1920 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1921 not validate this option; it will just pass through what you specify verbatim).
1925 This is a kludge because many databases suck. For example, you can't
1926 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1927 Instead, you have to use C<bind_param()>:
1929 $sth->bind_param(1, 'reg data');
1930 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1932 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1933 which loses track of which field each slot refers to. Fear not.
1935 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1936 Currently, you can specify either C<normal> (default) or C<columns>. If you
1937 specify C<columns>, you will get an array that looks like this:
1939 my $sql = SQL::Abstract->new(bindtype => 'columns');
1940 my($stmt, @bind) = $sql->insert(...);
1943 [ 'column1', 'value1' ],
1944 [ 'column2', 'value2' ],
1945 [ 'column3', 'value3' ],
1948 You can then iterate through this manually, using DBI's C<bind_param()>.
1950 $sth->prepare($stmt);
1953 my($col, $data) = @$_;
1954 if ($col eq 'details' || $col eq 'comments') {
1955 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1956 } elsif ($col eq 'image') {
1957 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1959 $sth->bind_param($i, $data);
1963 $sth->execute; # execute without @bind now
1965 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1966 Basically, the advantage is still that you don't have to care which fields
1967 are or are not included. You could wrap that above C<for> loop in a simple
1968 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1969 get a layer of abstraction over manual SQL specification.
1971 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
1972 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1973 will expect the bind values in this format.
1977 This is the character that a table or column name will be quoted
1978 with. By default this is an empty string, but you could set it to
1979 the character C<`>, to generate SQL like this:
1981 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1983 Alternatively, you can supply an array ref of two items, the first being the left
1984 hand quote character, and the second the right hand quote character. For
1985 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1986 that generates SQL like this:
1988 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1990 Quoting is useful if you have tables or columns names that are reserved
1991 words in your database's SQL dialect.
1995 This is the character that will be used to escape L</quote_char>s appearing
1996 in an identifier before it has been quoted.
1998 The parameter default in case of a single L</quote_char> character is the quote
2001 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
2002 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
2003 of the B<opening (left)> L</quote_char> within the identifier are currently left
2004 untouched. The default for opening-closing-style quotes may change in future
2005 versions, thus you are B<strongly encouraged> to specify the escape character
2010 This is the character that separates a table and column name. It is
2011 necessary to specify this when the C<quote_char> option is selected,
2012 so that tables and column names can be individually quoted like this:
2014 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2016 =item injection_guard
2018 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2019 column name specified in a query structure. This is a safety mechanism to avoid
2020 injection attacks when mishandling user input e.g.:
2022 my %condition_as_column_value_pairs = get_values_from_user();
2023 $sqla->select( ... , \%condition_as_column_value_pairs );
2025 If the expression matches an exception is thrown. Note that literal SQL
2026 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2028 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2030 =item array_datatypes
2032 When this option is true, arrayrefs in INSERT or UPDATE are
2033 interpreted as array datatypes and are passed directly
2035 When this option is false, arrayrefs are interpreted
2036 as literal SQL, just like refs to arrayrefs
2037 (but this behavior is for backwards compatibility; when writing
2038 new queries, use the "reference to arrayref" syntax
2044 Takes a reference to a list of "special operators"
2045 to extend the syntax understood by L<SQL::Abstract>.
2046 See section L</"SPECIAL OPERATORS"> for details.
2050 Takes a reference to a list of "unary operators"
2051 to extend the syntax understood by L<SQL::Abstract>.
2052 See section L</"UNARY OPERATORS"> for details.
2058 =head2 insert($table, \@values || \%fieldvals, \%options)
2060 This is the simplest function. You simply give it a table name
2061 and either an arrayref of values or hashref of field/value pairs.
2062 It returns an SQL INSERT statement and a list of bind values.
2063 See the sections on L</"Inserting and Updating Arrays"> and
2064 L</"Inserting and Updating SQL"> for information on how to insert
2065 with those data types.
2067 The optional C<\%options> hash reference may contain additional
2068 options to generate the insert SQL. Currently supported options
2075 Takes either a scalar of raw SQL fields, or an array reference of
2076 field names, and adds on an SQL C<RETURNING> statement at the end.
2077 This allows you to return data generated by the insert statement
2078 (such as row IDs) without performing another C<SELECT> statement.
2079 Note, however, this is not part of the SQL standard and may not
2080 be supported by all database engines.
2084 =head2 update($table, \%fieldvals, \%where, \%options)
2086 This takes a table, hashref of field/value pairs, and an optional
2087 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2089 See the sections on L</"Inserting and Updating Arrays"> and
2090 L</"Inserting and Updating SQL"> for information on how to insert
2091 with those data types.
2093 The optional C<\%options> hash reference may contain additional
2094 options to generate the update SQL. Currently supported options
2101 See the C<returning> option to
2102 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2106 =head2 select($source, $fields, $where, $order)
2108 This returns a SQL SELECT statement and associated list of bind values, as
2109 specified by the arguments :
2115 Specification of the 'FROM' part of the statement.
2116 The argument can be either a plain scalar (interpreted as a table
2117 name, will be quoted), or an arrayref (interpreted as a list
2118 of table names, joined by commas, quoted), or a scalarref
2119 (literal table name, not quoted), or a ref to an arrayref
2120 (list of literal table names, joined by commas, not quoted).
2124 Specification of the list of fields to retrieve from
2126 The argument can be either an arrayref (interpreted as a list
2127 of field names, will be joined by commas and quoted), or a
2128 plain scalar (literal SQL, not quoted).
2129 Please observe that this API is not as flexible as that of
2130 the first argument C<$source>, for backwards compatibility reasons.
2134 Optional argument to specify the WHERE part of the query.
2135 The argument is most often a hashref, but can also be
2136 an arrayref or plain scalar --
2137 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2141 Optional argument to specify the ORDER BY part of the query.
2142 The argument can be a scalar, a hashref or an arrayref
2143 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2149 =head2 delete($table, \%where)
2151 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2152 It returns an SQL DELETE statement and list of bind values.
2154 =head2 where(\%where, \@order)
2156 This is used to generate just the WHERE clause. For example,
2157 if you have an arbitrary data structure and know what the
2158 rest of your SQL is going to look like, but want an easy way
2159 to produce a WHERE clause, use this. It returns an SQL WHERE
2160 clause and list of bind values.
2163 =head2 values(\%data)
2165 This just returns the values from the hash C<%data>, in the same
2166 order that would be returned from any of the other above queries.
2167 Using this allows you to markedly speed up your queries if you
2168 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2170 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2172 Warning: This is an experimental method and subject to change.
2174 This returns arbitrarily generated SQL. It's a really basic shortcut.
2175 It will return two different things, depending on return context:
2177 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2178 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2180 These would return the following:
2182 # First calling form
2183 $stmt = "CREATE TABLE test (?, ?)";
2184 @bind = (field1, field2);
2186 # Second calling form
2187 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2189 Depending on what you're trying to do, it's up to you to choose the correct
2190 format. In this example, the second form is what you would want.
2194 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2198 ALTER SESSION SET nls_date_format = 'MM/YY'
2200 You get the idea. Strings get their case twiddled, but everything
2201 else remains verbatim.
2203 =head1 EXPORTABLE FUNCTIONS
2205 =head2 is_plain_value
2207 Determines if the supplied argument is a plain value as understood by this
2212 =item * The value is C<undef>
2214 =item * The value is a non-reference
2216 =item * The value is an object with stringification overloading
2218 =item * The value is of the form C<< { -value => $anything } >>
2222 On failure returns C<undef>, on sucess returns a B<scalar> reference
2223 to the original supplied argument.
2229 The stringification overloading detection is rather advanced: it takes
2230 into consideration not only the presence of a C<""> overload, but if that
2231 fails also checks for enabled
2232 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2233 on either C<0+> or C<bool>.
2235 Unfortunately testing in the field indicates that this
2236 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2237 but only when very large numbers of stringifying objects are involved.
2238 At the time of writing ( Sep 2014 ) there is no clear explanation of
2239 the direct cause, nor is there a manageably small test case that reliably
2240 reproduces the problem.
2242 If you encounter any of the following exceptions in B<random places within
2243 your application stack> - this module may be to blame:
2245 Operation "ne": no method found,
2246 left argument in overloaded package <something>,
2247 right argument in overloaded package <something>
2251 Stub found while resolving method "???" overloading """" in package <something>
2253 If you fall victim to the above - please attempt to reduce the problem
2254 to something that could be sent to the L<SQL::Abstract developers
2255 |DBIx::Class/GETTING HELP/SUPPORT>
2256 (either publicly or privately). As a workaround in the meantime you can
2257 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2258 value, which will most likely eliminate your problem (at the expense of
2259 not being able to properly detect exotic forms of stringification).
2261 This notice and environment variable will be removed in a future version,
2262 as soon as the underlying problem is found and a reliable workaround is
2267 =head2 is_literal_value
2269 Determines if the supplied argument is a literal value as understood by this
2274 =item * C<\$sql_string>
2276 =item * C<\[ $sql_string, @bind_values ]>
2280 On failure returns C<undef>, on sucess returns an B<array> reference
2281 containing the unpacked version of the supplied literal SQL and bind values.
2283 =head1 WHERE CLAUSES
2287 This module uses a variation on the idea from L<DBIx::Abstract>. It
2288 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2289 module is that things in arrays are OR'ed, and things in hashes
2292 The easiest way to explain is to show lots of examples. After
2293 each C<%where> hash shown, it is assumed you used:
2295 my($stmt, @bind) = $sql->where(\%where);
2297 However, note that the C<%where> hash can be used directly in any
2298 of the other functions as well, as described above.
2300 =head2 Key-value pairs
2302 So, let's get started. To begin, a simple hash:
2306 status => 'completed'
2309 Is converted to SQL C<key = val> statements:
2311 $stmt = "WHERE user = ? AND status = ?";
2312 @bind = ('nwiger', 'completed');
2314 One common thing I end up doing is having a list of values that
2315 a field can be in. To do this, simply specify a list inside of
2320 status => ['assigned', 'in-progress', 'pending'];
2323 This simple code will create the following:
2325 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2326 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2328 A field associated to an empty arrayref will be considered a
2329 logical false and will generate 0=1.
2331 =head2 Tests for NULL values
2333 If the value part is C<undef> then this is converted to SQL <IS NULL>
2342 $stmt = "WHERE user = ? AND status IS NULL";
2345 To test if a column IS NOT NULL:
2349 status => { '!=', undef },
2352 =head2 Specific comparison operators
2354 If you want to specify a different type of operator for your comparison,
2355 you can use a hashref for a given column:
2359 status => { '!=', 'completed' }
2362 Which would generate:
2364 $stmt = "WHERE user = ? AND status != ?";
2365 @bind = ('nwiger', 'completed');
2367 To test against multiple values, just enclose the values in an arrayref:
2369 status => { '=', ['assigned', 'in-progress', 'pending'] };
2371 Which would give you:
2373 "WHERE status = ? OR status = ? OR status = ?"
2376 The hashref can also contain multiple pairs, in which case it is expanded
2377 into an C<AND> of its elements:
2381 status => { '!=', 'completed', -not_like => 'pending%' }
2384 # Or more dynamically, like from a form
2385 $where{user} = 'nwiger';
2386 $where{status}{'!='} = 'completed';
2387 $where{status}{'-not_like'} = 'pending%';
2389 # Both generate this
2390 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2391 @bind = ('nwiger', 'completed', 'pending%');
2394 To get an OR instead, you can combine it with the arrayref idea:
2398 priority => [ { '=', 2 }, { '>', 5 } ]
2401 Which would generate:
2403 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2404 @bind = ('2', '5', 'nwiger');
2406 If you want to include literal SQL (with or without bind values), just use a
2407 scalar reference or reference to an arrayref as the value:
2410 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2411 date_expires => { '<' => \"now()" }
2414 Which would generate:
2416 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2417 @bind = ('11/26/2008');
2420 =head2 Logic and nesting operators
2422 In the example above,
2423 there is a subtle trap if you want to say something like
2424 this (notice the C<AND>):
2426 WHERE priority != ? AND priority != ?
2428 Because, in Perl you I<can't> do this:
2430 priority => { '!=' => 2, '!=' => 1 }
2432 As the second C<!=> key will obliterate the first. The solution
2433 is to use the special C<-modifier> form inside an arrayref:
2435 priority => [ -and => {'!=', 2},
2439 Normally, these would be joined by C<OR>, but the modifier tells it
2440 to use C<AND> instead. (Hint: You can use this in conjunction with the
2441 C<logic> option to C<new()> in order to change the way your queries
2442 work by default.) B<Important:> Note that the C<-modifier> goes
2443 B<INSIDE> the arrayref, as an extra first element. This will
2444 B<NOT> do what you think it might:
2446 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2448 Here is a quick list of equivalencies, since there is some overlap:
2451 status => {'!=', 'completed', 'not like', 'pending%' }
2452 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2455 status => {'=', ['assigned', 'in-progress']}
2456 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2457 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2461 =head2 Special operators : IN, BETWEEN, etc.
2463 You can also use the hashref format to compare a list of fields using the
2464 C<IN> comparison operator, by specifying the list as an arrayref:
2467 status => 'completed',
2468 reportid => { -in => [567, 2335, 2] }
2471 Which would generate:
2473 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2474 @bind = ('completed', '567', '2335', '2');
2476 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2479 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2480 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2481 'sqltrue' (by default : C<1=1>).
2483 In addition to the array you can supply a chunk of literal sql or
2484 literal sql with bind:
2487 customer => { -in => \[
2488 'SELECT cust_id FROM cust WHERE balance > ?',
2491 status => { -in => \'SELECT status_codes FROM states' },
2497 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2498 AND status IN ( SELECT status_codes FROM states )
2502 Finally, if the argument to C<-in> is not a reference, it will be
2503 treated as a single-element array.
2505 Another pair of operators is C<-between> and C<-not_between>,
2506 used with an arrayref of two values:
2510 completion_date => {
2511 -not_between => ['2002-10-01', '2003-02-06']
2517 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2519 Just like with C<-in> all plausible combinations of literal SQL
2523 start0 => { -between => [ 1, 2 ] },
2524 start1 => { -between => \["? AND ?", 1, 2] },
2525 start2 => { -between => \"lower(x) AND upper(y)" },
2526 start3 => { -between => [
2528 \["upper(?)", 'stuff' ],
2535 ( start0 BETWEEN ? AND ? )
2536 AND ( start1 BETWEEN ? AND ? )
2537 AND ( start2 BETWEEN lower(x) AND upper(y) )
2538 AND ( start3 BETWEEN lower(x) AND upper(?) )
2540 @bind = (1, 2, 1, 2, 'stuff');
2543 These are the two builtin "special operators"; but the
2544 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2546 =head2 Unary operators: bool
2548 If you wish to test against boolean columns or functions within your
2549 database you can use the C<-bool> and C<-not_bool> operators. For
2550 example to test the column C<is_user> being true and the column
2551 C<is_enabled> being false you would use:-
2555 -not_bool => 'is_enabled',
2560 WHERE is_user AND NOT is_enabled
2562 If a more complex combination is required, testing more conditions,
2563 then you should use the and/or operators:-
2568 -not_bool => { two=> { -rlike => 'bar' } },
2569 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2580 (NOT ( three = ? OR three > ? ))
2583 =head2 Nested conditions, -and/-or prefixes
2585 So far, we've seen how multiple conditions are joined with a top-level
2586 C<AND>. We can change this by putting the different conditions we want in
2587 hashes and then putting those hashes in an array. For example:
2592 status => { -like => ['pending%', 'dispatched'] },
2596 status => 'unassigned',
2600 This data structure would create the following:
2602 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2603 OR ( user = ? AND status = ? ) )";
2604 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2607 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2608 to change the logic inside :
2614 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2615 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2622 $stmt = "WHERE ( user = ?
2623 AND ( ( workhrs > ? AND geo = ? )
2624 OR ( workhrs < ? OR geo = ? ) ) )";
2625 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2627 =head3 Algebraic inconsistency, for historical reasons
2629 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2630 operator goes C<outside> of the nested structure; whereas when connecting
2631 several constraints on one column, the C<-and> operator goes
2632 C<inside> the arrayref. Here is an example combining both features :
2635 -and => [a => 1, b => 2],
2636 -or => [c => 3, d => 4],
2637 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2642 WHERE ( ( ( a = ? AND b = ? )
2643 OR ( c = ? OR d = ? )
2644 OR ( e LIKE ? AND e LIKE ? ) ) )
2646 This difference in syntax is unfortunate but must be preserved for
2647 historical reasons. So be careful : the two examples below would
2648 seem algebraically equivalent, but they are not
2651 { -like => 'foo%' },
2652 { -like => '%bar' },
2654 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2657 { col => { -like => 'foo%' } },
2658 { col => { -like => '%bar' } },
2660 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2663 =head2 Literal SQL and value type operators
2665 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2666 side" is a column name and the "right side" is a value (normally rendered as
2667 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2668 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2669 alter this behavior. There are several ways of doing so.
2673 This is a virtual operator that signals the string to its right side is an
2674 identifier (a column name) and not a value. For example to compare two
2675 columns you would write:
2678 priority => { '<', 2 },
2679 requestor => { -ident => 'submitter' },
2684 $stmt = "WHERE priority < ? AND requestor = submitter";
2687 If you are maintaining legacy code you may see a different construct as
2688 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2693 This is a virtual operator that signals that the construct to its right side
2694 is a value to be passed to DBI. This is for example necessary when you want
2695 to write a where clause against an array (for RDBMS that support such
2696 datatypes). For example:
2699 array => { -value => [1, 2, 3] }
2704 $stmt = 'WHERE array = ?';
2705 @bind = ([1, 2, 3]);
2707 Note that if you were to simply say:
2713 the result would probably not be what you wanted:
2715 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2720 Finally, sometimes only literal SQL will do. To include a random snippet
2721 of SQL verbatim, you specify it as a scalar reference. Consider this only
2722 as a last resort. Usually there is a better way. For example:
2725 priority => { '<', 2 },
2726 requestor => { -in => \'(SELECT name FROM hitmen)' },
2731 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2734 Note that in this example, you only get one bind parameter back, since
2735 the verbatim SQL is passed as part of the statement.
2739 Never use untrusted input as a literal SQL argument - this is a massive
2740 security risk (there is no way to check literal snippets for SQL
2741 injections and other nastyness). If you need to deal with untrusted input
2742 use literal SQL with placeholders as described next.
2744 =head3 Literal SQL with placeholders and bind values (subqueries)
2746 If the literal SQL to be inserted has placeholders and bind values,
2747 use a reference to an arrayref (yes this is a double reference --
2748 not so common, but perfectly legal Perl). For example, to find a date
2749 in Postgres you can use something like this:
2752 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2757 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2760 Note that you must pass the bind values in the same format as they are returned
2761 by L<where|/where(\%where, \@order)>. This means that if you set L</bindtype>
2762 to C<columns>, you must provide the bind values in the
2763 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2764 scalar value; most commonly the column name, but you can use any scalar value
2765 (including references and blessed references), L<SQL::Abstract> will simply
2766 pass it through intact. So if C<bindtype> is set to C<columns> the above
2767 example will look like:
2770 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2773 Literal SQL is especially useful for nesting parenthesized clauses in the
2774 main SQL query. Here is a first example :
2776 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2780 bar => \["IN ($sub_stmt)" => @sub_bind],
2785 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2786 WHERE c2 < ? AND c3 LIKE ?))";
2787 @bind = (1234, 100, "foo%");
2789 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2790 are expressed in the same way. Of course the C<$sub_stmt> and
2791 its associated bind values can be generated through a former call
2794 my ($sub_stmt, @sub_bind)
2795 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2796 c3 => {-like => "foo%"}});
2799 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2802 In the examples above, the subquery was used as an operator on a column;
2803 but the same principle also applies for a clause within the main C<%where>
2804 hash, like an EXISTS subquery :
2806 my ($sub_stmt, @sub_bind)
2807 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2808 my %where = ( -and => [
2810 \["EXISTS ($sub_stmt)" => @sub_bind],
2815 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2816 WHERE c1 = ? AND c2 > t0.c0))";
2820 Observe that the condition on C<c2> in the subquery refers to
2821 column C<t0.c0> of the main query : this is I<not> a bind
2822 value, so we have to express it through a scalar ref.
2823 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2824 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2825 what we wanted here.
2827 Finally, here is an example where a subquery is used
2828 for expressing unary negation:
2830 my ($sub_stmt, @sub_bind)
2831 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2832 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2834 lname => {like => '%son%'},
2835 \["NOT ($sub_stmt)" => @sub_bind],
2840 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2841 @bind = ('%son%', 10, 20)
2843 =head3 Deprecated usage of Literal SQL
2845 Below are some examples of archaic use of literal SQL. It is shown only as
2846 reference for those who deal with legacy code. Each example has a much
2847 better, cleaner and safer alternative that users should opt for in new code.
2853 my %where = ( requestor => \'IS NOT NULL' )
2855 $stmt = "WHERE requestor IS NOT NULL"
2857 This used to be the way of generating NULL comparisons, before the handling
2858 of C<undef> got formalized. For new code please use the superior syntax as
2859 described in L</Tests for NULL values>.
2863 my %where = ( requestor => \'= submitter' )
2865 $stmt = "WHERE requestor = submitter"
2867 This used to be the only way to compare columns. Use the superior L</-ident>
2868 method for all new code. For example an identifier declared in such a way
2869 will be properly quoted if L</quote_char> is properly set, while the legacy
2870 form will remain as supplied.
2874 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2876 $stmt = "WHERE completed > ? AND is_ready"
2877 @bind = ('2012-12-21')
2879 Using an empty string literal used to be the only way to express a boolean.
2880 For all new code please use the much more readable
2881 L<-bool|/Unary operators: bool> operator.
2887 These pages could go on for a while, since the nesting of the data
2888 structures this module can handle are pretty much unlimited (the
2889 module implements the C<WHERE> expansion as a recursive function
2890 internally). Your best bet is to "play around" with the module a
2891 little to see how the data structures behave, and choose the best
2892 format for your data based on that.
2894 And of course, all the values above will probably be replaced with
2895 variables gotten from forms or the command line. After all, if you
2896 knew everything ahead of time, you wouldn't have to worry about
2897 dynamically-generating SQL and could just hardwire it into your
2900 =head1 ORDER BY CLAUSES
2902 Some functions take an order by clause. This can either be a scalar (just a
2903 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2904 or an array of either of the two previous forms. Examples:
2906 Given | Will Generate
2907 ----------------------------------------------------------
2909 \'colA DESC' | ORDER BY colA DESC
2911 'colA' | ORDER BY colA
2913 [qw/colA colB/] | ORDER BY colA, colB
2915 {-asc => 'colA'} | ORDER BY colA ASC
2917 {-desc => 'colB'} | ORDER BY colB DESC
2919 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2921 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2924 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2925 { -desc => [qw/colB/], | colC ASC, colD ASC
2926 { -asc => [qw/colC colD/],|
2928 ===========================================================
2932 =head1 SPECIAL OPERATORS
2934 my $sqlmaker = SQL::Abstract->new(special_ops => [
2938 my ($self, $field, $op, $arg) = @_;
2944 handler => 'method_name',
2948 A "special operator" is a SQL syntactic clause that can be
2949 applied to a field, instead of a usual binary operator.
2952 WHERE field IN (?, ?, ?)
2953 WHERE field BETWEEN ? AND ?
2954 WHERE MATCH(field) AGAINST (?, ?)
2956 Special operators IN and BETWEEN are fairly standard and therefore
2957 are builtin within C<SQL::Abstract> (as the overridable methods
2958 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2959 like the MATCH .. AGAINST example above which is specific to MySQL,
2960 you can write your own operator handlers - supply a C<special_ops>
2961 argument to the C<new> method. That argument takes an arrayref of
2962 operator definitions; each operator definition is a hashref with two
2969 the regular expression to match the operator
2973 Either a coderef or a plain scalar method name. In both cases
2974 the expected return is C<< ($sql, @bind) >>.
2976 When supplied with a method name, it is simply called on the
2977 L<SQL::Abstract> object as:
2979 $self->$method_name ($field, $op, $arg)
2983 $field is the LHS of the operator
2984 $op is the part that matched the handler regex
2987 When supplied with a coderef, it is called as:
2989 $coderef->($self, $field, $op, $arg)
2994 For example, here is an implementation
2995 of the MATCH .. AGAINST syntax for MySQL
2997 my $sqlmaker = SQL::Abstract->new(special_ops => [
2999 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
3000 {regex => qr/^match$/i,
3002 my ($self, $field, $op, $arg) = @_;
3003 $arg = [$arg] if not ref $arg;
3004 my $label = $self->_quote($field);
3005 my ($placeholder) = $self->_convert('?');
3006 my $placeholders = join ", ", (($placeholder) x @$arg);
3007 my $sql = $self->_sqlcase('match') . " ($label) "
3008 . $self->_sqlcase('against') . " ($placeholders) ";
3009 my @bind = $self->_bindtype($field, @$arg);
3010 return ($sql, @bind);
3017 =head1 UNARY OPERATORS
3019 my $sqlmaker = SQL::Abstract->new(unary_ops => [
3023 my ($self, $op, $arg) = @_;
3029 handler => 'method_name',
3033 A "unary operator" is a SQL syntactic clause that can be
3034 applied to a field - the operator goes before the field
3036 You can write your own operator handlers - supply a C<unary_ops>
3037 argument to the C<new> method. That argument takes an arrayref of
3038 operator definitions; each operator definition is a hashref with two
3045 the regular expression to match the operator
3049 Either a coderef or a plain scalar method name. In both cases
3050 the expected return is C<< $sql >>.
3052 When supplied with a method name, it is simply called on the
3053 L<SQL::Abstract> object as:
3055 $self->$method_name ($op, $arg)
3059 $op is the part that matched the handler regex
3060 $arg is the RHS or argument of the operator
3062 When supplied with a coderef, it is called as:
3064 $coderef->($self, $op, $arg)
3072 Thanks to some benchmarking by Mark Stosberg, it turns out that
3073 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3074 I must admit this wasn't an intentional design issue, but it's a
3075 byproduct of the fact that you get to control your C<DBI> handles
3078 To maximize performance, use a code snippet like the following:
3080 # prepare a statement handle using the first row
3081 # and then reuse it for the rest of the rows
3083 for my $href (@array_of_hashrefs) {
3084 $stmt ||= $sql->insert('table', $href);
3085 $sth ||= $dbh->prepare($stmt);
3086 $sth->execute($sql->values($href));
3089 The reason this works is because the keys in your C<$href> are sorted
3090 internally by B<SQL::Abstract>. Thus, as long as your data retains
3091 the same structure, you only have to generate the SQL the first time
3092 around. On subsequent queries, simply use the C<values> function provided
3093 by this module to return your values in the correct order.
3095 However this depends on the values having the same type - if, for
3096 example, the values of a where clause may either have values
3097 (resulting in sql of the form C<column = ?> with a single bind
3098 value), or alternatively the values might be C<undef> (resulting in
3099 sql of the form C<column IS NULL> with no bind value) then the
3100 caching technique suggested will not work.
3104 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3105 really like this part (I do, at least). Building up a complex query
3106 can be as simple as the following:
3113 use CGI::FormBuilder;
3116 my $form = CGI::FormBuilder->new(...);
3117 my $sql = SQL::Abstract->new;
3119 if ($form->submitted) {
3120 my $field = $form->field;
3121 my $id = delete $field->{id};
3122 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3125 Of course, you would still have to connect using C<DBI> to run the
3126 query, but the point is that if you make your form look like your
3127 table, the actual query script can be extremely simplistic.
3129 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3130 a fast interface to returning and formatting data. I frequently
3131 use these three modules together to write complex database query
3132 apps in under 50 lines.
3134 =head1 HOW TO CONTRIBUTE
3136 Contributions are always welcome, in all usable forms (we especially
3137 welcome documentation improvements). The delivery methods include git-
3138 or unified-diff formatted patches, GitHub pull requests, or plain bug
3139 reports either via RT or the Mailing list. Contributors are generally
3140 granted full access to the official repository after their first several
3141 patches pass successful review.
3143 This project is maintained in a git repository. The code and related tools are
3144 accessible at the following locations:
3148 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3150 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3152 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3154 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3160 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3161 Great care has been taken to preserve the I<published> behavior
3162 documented in previous versions in the 1.* family; however,
3163 some features that were previously undocumented, or behaved
3164 differently from the documentation, had to be changed in order
3165 to clarify the semantics. Hence, client code that was relying
3166 on some dark areas of C<SQL::Abstract> v1.*
3167 B<might behave differently> in v1.50.
3169 The main changes are :
3175 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3179 support for the { operator => \"..." } construct (to embed literal SQL)
3183 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3187 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3191 defensive programming : check arguments
3195 fixed bug with global logic, which was previously implemented
3196 through global variables yielding side-effects. Prior versions would
3197 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3198 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3199 Now this is interpreted
3200 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3205 fixed semantics of _bindtype on array args
3209 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3210 we just avoid shifting arrays within that tree.
3214 dropped the C<_modlogic> function
3218 =head1 ACKNOWLEDGEMENTS
3220 There are a number of individuals that have really helped out with
3221 this module. Unfortunately, most of them submitted bugs via CPAN
3222 so I have no idea who they are! But the people I do know are:
3224 Ash Berlin (order_by hash term support)
3225 Matt Trout (DBIx::Class support)
3226 Mark Stosberg (benchmarking)
3227 Chas Owens (initial "IN" operator support)
3228 Philip Collins (per-field SQL functions)
3229 Eric Kolve (hashref "AND" support)
3230 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3231 Dan Kubb (support for "quote_char" and "name_sep")
3232 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3233 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3234 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3235 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3236 Oliver Charles (support for "RETURNING" after "INSERT")
3242 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3246 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3248 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3250 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3251 While not an official support venue, C<DBIx::Class> makes heavy use of
3252 C<SQL::Abstract>, and as such list members there are very familiar with
3253 how to create queries.
3257 This module is free software; you may copy this under the same
3258 terms as perl itself (either the GNU General Public License or
3259 the Artistic License)