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.86';
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 => sub { die "NOPE" }},
41 {regex => qr/^ (?: not \s )? in $/ix, handler => sub { die "NOPE" }},
42 {regex => qr/^ is (?: \s+ not )? $/ix, handler => sub { die "NOPE" }},
45 #======================================================================
46 # DEBUGGING AND ERROR REPORTING
47 #======================================================================
50 return unless $_[0]->{debug}; shift; # a little faster
51 my $func = (caller(1))[3];
52 warn "[$func] ", @_, "\n";
56 my($func) = (caller(1))[3];
57 Carp::carp "[$func] Warning: ", @_;
61 my($func) = (caller(1))[3];
62 Carp::croak "[$func] Fatal: ", @_;
65 sub is_literal_value ($) {
66 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
67 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
71 # FIXME XSify - this can be done so much more efficiently
72 sub is_plain_value ($) {
74 ! length ref $_[0] ? \($_[0])
76 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
78 exists $_[0]->{-value}
79 ) ? \($_[0]->{-value})
81 # reuse @_ for even moar speedz
82 defined ( $_[1] = Scalar::Util::blessed $_[0] )
84 # deliberately not using Devel::OverloadInfo - the checks we are
85 # intersted in are much more limited than the fullblown thing, and
86 # this is a very hot piece of code
88 # simply using ->can('(""') can leave behind stub methods that
89 # break actually using the overload later (see L<perldiag/Stub
90 # found while resolving method "%s" overloading "%s" in package
91 # "%s"> and the source of overload::mycan())
93 # either has stringification which DBI SHOULD prefer out of the box
94 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
96 # has nummification or boolification, AND fallback is *not* disabled
98 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
101 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
103 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
107 # no fallback specified at all
108 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
110 # fallback explicitly undef
111 ! defined ${"$_[3]::()"}
124 #======================================================================
126 #======================================================================
130 my $class = ref($self) || $self;
131 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
133 # choose our case by keeping an option around
134 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
136 # default logic for interpreting arrayrefs
137 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
139 # how to return bind vars
140 $opt{bindtype} ||= 'normal';
142 # default comparison is "=", but can be overridden
145 # try to recognize which are the 'equality' and 'inequality' ops
146 # (temporary quickfix (in 2007), should go through a more seasoned API)
147 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
148 $opt{inequality_op} = qr/^( != | <> )$/ix;
150 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
151 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
154 $opt{sqltrue} ||= '1=1';
155 $opt{sqlfalse} ||= '0=1';
158 $opt{special_ops} ||= [];
160 # regexes are applied in order, thus push after user-defines
161 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
163 if ($class->isa('DBIx::Class::SQLMaker')) {
164 push @{$opt{special_ops}}, our $DBIC_Compat_Op ||= {
165 regex => qr/^(?:ident|value)$/i, handler => sub { die "NOPE" }
167 $opt{is_dbic_sqlmaker} = 1;
171 $opt{unary_ops} ||= [];
173 # rudimentary sanity-check for user supplied bits treated as functions/operators
174 # If a purported function matches this regular expression, an exception is thrown.
175 # Literal SQL is *NOT* subject to this check, only functions (and column names
176 # when quoting is not in effect)
179 # need to guard against ()'s in column names too, but this will break tons of
180 # hacks... ideas anyone?
181 $opt{injection_guard} ||= qr/
187 $opt{expand_unary} = {};
190 -not => '_expand_not',
191 -bool => '_expand_bool',
192 -and => '_expand_op_andor',
193 -or => '_expand_op_andor',
194 -nest => '_expand_nest',
198 'between' => '_expand_between',
199 'not between' => '_expand_between',
200 'in' => '_expand_in',
201 'not in' => '_expand_in',
202 'nest' => '_expand_nest',
203 (map +($_ => '_expand_op_andor'),
207 # placeholder for _expand_unop system
209 my %unops = (-ident => '_expand_ident', -value => '_expand_value');
210 foreach my $name (keys %unops) {
211 $opt{expand}{$name} = $unops{$name};
212 my ($op) = $name =~ /^-(.*)$/;
213 $opt{expand_op}{$op} = sub {
214 my ($self, $op, $arg, $k) = @_;
217 $self->_expand_ident(-ident => $k),
218 $self->_expand_expr({ '-'.$op => $arg }),
225 (map +("-$_", "_render_$_"), qw(op func bind ident literal list)),
229 $opt{render_op} = our $RENDER_OP;
231 return bless \%opt, $class;
234 sub sqltrue { +{ -literal => [ $_[0]->{sqltrue} ] } }
235 sub sqlfalse { +{ -literal => [ $_[0]->{sqlfalse} ] } }
237 sub _assert_pass_injection_guard {
238 if ($_[1] =~ $_[0]->{injection_guard}) {
239 my $class = ref $_[0];
240 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
241 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
242 . "{injection_guard} attribute to ${class}->new()"
247 #======================================================================
249 #======================================================================
253 my $table = $self->_table(shift);
254 my $data = shift || return;
257 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
258 my ($sql, @bind) = $self->$method($data);
259 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
261 if ($options->{returning}) {
262 my ($s, @b) = $self->_insert_returning($options);
267 return wantarray ? ($sql, @bind) : $sql;
270 # So that subclasses can override INSERT ... RETURNING separately from
271 # UPDATE and DELETE (e.g. DBIx::Class::SQLMaker::Oracle does this)
272 sub _insert_returning { shift->_returning(@_) }
275 my ($self, $options) = @_;
277 my $f = $options->{returning};
279 my ($sql, @bind) = $self->render_aqt(
280 $self->_expand_maybe_list_expr($f, undef, -ident)
283 ? $self->_sqlcase(' returning ') . $sql
284 : ($self->_sqlcase(' returning ').$sql, @bind);
287 sub _insert_HASHREF { # explicit list of fields and then values
288 my ($self, $data) = @_;
290 my @fields = sort keys %$data;
292 my ($sql, @bind) = $self->_insert_values($data);
295 $_ = $self->_quote($_) foreach @fields;
296 $sql = "( ".join(", ", @fields).") ".$sql;
298 return ($sql, @bind);
301 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
302 my ($self, $data) = @_;
304 # no names (arrayref) so can't generate bindtype
305 $self->{bindtype} ne 'columns'
306 or belch "can't do 'columns' bindtype when called with arrayref";
308 my (@values, @all_bind);
309 foreach my $value (@$data) {
310 my ($values, @bind) = $self->_insert_value(undef, $value);
311 push @values, $values;
312 push @all_bind, @bind;
314 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
315 return ($sql, @all_bind);
318 sub _insert_ARRAYREFREF { # literal SQL with bind
319 my ($self, $data) = @_;
321 my ($sql, @bind) = @${$data};
322 $self->_assert_bindval_matches_bindtype(@bind);
324 return ($sql, @bind);
328 sub _insert_SCALARREF { # literal SQL without bind
329 my ($self, $data) = @_;
335 my ($self, $data) = @_;
337 my (@values, @all_bind);
338 foreach my $column (sort keys %$data) {
339 my ($values, @bind) = $self->_insert_value($column, $data->{$column});
340 push @values, $values;
341 push @all_bind, @bind;
343 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
344 return ($sql, @all_bind);
348 my ($self, $column, $v) = @_;
350 return $self->render_aqt(
351 $self->_expand_insert_value($column, $v)
355 sub _expand_insert_value {
356 my ($self, $column, $v) = @_;
358 if (ref($v) eq 'ARRAY') {
359 if ($self->{array_datatypes}) {
360 return +{ -bind => [ $column, $v ] };
362 my ($sql, @bind) = @$v;
363 $self->_assert_bindval_matches_bindtype(@bind);
364 return +{ -literal => $v };
366 if (ref($v) eq 'HASH') {
367 if (grep !/^-/, keys %$v) {
368 belch "HASH ref as bind value in insert is not supported";
369 return +{ -bind => [ $column, $v ] };
373 return +{ -bind => [ $column, undef ] };
375 local our $Cur_Col_Meta = $column;
376 return $self->expand_expr($v);
381 #======================================================================
383 #======================================================================
388 my $table = $self->_table(shift);
389 my $data = shift || return;
393 # first build the 'SET' part of the sql statement
394 puke "Unsupported data type specified to \$sql->update"
395 unless ref $data eq 'HASH';
397 my ($sql, @all_bind) = $self->_update_set_values($data);
398 $sql = $self->_sqlcase('update ') . $table . $self->_sqlcase(' set ')
402 my($where_sql, @where_bind) = $self->where($where);
404 push @all_bind, @where_bind;
407 if ($options->{returning}) {
408 my ($returning_sql, @returning_bind) = $self->_update_returning($options);
409 $sql .= $returning_sql;
410 push @all_bind, @returning_bind;
413 return wantarray ? ($sql, @all_bind) : $sql;
416 sub _update_set_values {
417 my ($self, $data) = @_;
419 return $self->render_aqt(
420 $self->_expand_update_set_values($data),
424 sub _expand_update_set_values {
425 my ($self, $data) = @_;
426 $self->_expand_maybe_list_expr( [
429 $set = { -bind => $_ } unless defined $set;
430 +{ -op => [ '=', $self->_expand_ident(-ident => $k), $set ] };
436 ? ($self->{array_datatypes}
437 ? [ $k, +{ -bind => [ $k, $v ] } ]
438 : [ $k, +{ -literal => $v } ])
440 local our $Cur_Col_Meta = $k;
441 [ $k, $self->_expand_expr($v) ]
448 # So that subclasses can override UPDATE ... RETURNING separately from
450 sub _update_returning { shift->_returning(@_) }
454 #======================================================================
456 #======================================================================
461 my $table = $self->_table(shift);
462 my $fields = shift || '*';
466 my ($fields_sql, @bind) = $self->_select_fields($fields);
468 my ($where_sql, @where_bind) = $self->where($where, $order);
469 push @bind, @where_bind;
471 my $sql = join(' ', $self->_sqlcase('select'), $fields_sql,
472 $self->_sqlcase('from'), $table)
475 return wantarray ? ($sql, @bind) : $sql;
479 my ($self, $fields) = @_;
480 return $fields unless ref($fields);
481 return $self->render_aqt(
482 $self->_expand_maybe_list_expr($fields, undef, '-ident')
486 #======================================================================
488 #======================================================================
493 my $table = $self->_table(shift);
497 my($where_sql, @bind) = $self->where($where);
498 my $sql = $self->_sqlcase('delete from ') . $table . $where_sql;
500 if ($options->{returning}) {
501 my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
502 $sql .= $returning_sql;
503 push @bind, @returning_bind;
506 return wantarray ? ($sql, @bind) : $sql;
509 # So that subclasses can override DELETE ... RETURNING separately from
511 sub _delete_returning { shift->_returning(@_) }
515 #======================================================================
517 #======================================================================
521 # Finally, a separate routine just to handle WHERE clauses
523 my ($self, $where, $order) = @_;
525 local $self->{convert_where} = $self->{convert};
528 my ($sql, @bind) = defined($where)
529 ? $self->_recurse_where($where)
531 $sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
535 my ($order_sql, @order_bind) = $self->_order_by($order);
537 push @bind, @order_bind;
540 return wantarray ? ($sql, @bind) : $sql;
544 my ($self, $expr, $default_scalar_to) = @_;
545 local our $Default_Scalar_To = $default_scalar_to if $default_scalar_to;
546 $self->_expand_expr($expr);
550 my ($self, $aqt) = @_;
551 my ($k, $v, @rest) = %$aqt;
553 if (my $meth = $self->{render}{$k}) {
554 return $self->$meth($v);
556 die "notreached: $k";
560 my ($self, $expr) = @_;
561 $self->render_aqt($self->expand_expr($expr));
565 my ($self, $expr) = @_;
566 our $Expand_Depth ||= 0; local $Expand_Depth = $Expand_Depth + 1;
567 return undef unless defined($expr);
568 if (ref($expr) eq 'HASH') {
569 return undef unless my $kc = keys %$expr;
571 return $self->_expand_op_andor(-and => $expr);
573 my ($key, $value) = %$expr;
574 if ($key =~ /^-/ and $key =~ s/ [_\s]? \d+ $//x ) {
575 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
576 . "You probably wanted ...-and => [ $key => COND1, $key => COND2 ... ]";
578 if (my $exp = $self->{expand}{$key}) {
579 return $self->$exp($key, $value);
581 return $self->_expand_expr_hashpair($key, $value);
583 if (ref($expr) eq 'ARRAY') {
584 my $logic = '-'.lc($self->{logic});
585 return $self->_expand_op_andor($logic, $expr);
587 if (my $literal = is_literal_value($expr)) {
588 return +{ -literal => $literal };
590 if (!ref($expr) or Scalar::Util::blessed($expr)) {
591 if (my $d = our $Default_Scalar_To) {
592 return $self->_expand_expr({ $d => $expr });
594 return $self->_expand_value(-value => $expr);
599 sub _expand_expr_hashpair {
600 my ($self, $k, $v) = @_;
601 unless (defined($k) and length($k)) {
602 if (defined($k) and my $literal = is_literal_value($v)) {
603 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
604 return { -literal => $literal };
606 puke "Supplying an empty left hand side argument is not supported";
609 return $self->_expand_expr_hashpair_op($k, $v);
611 return $self->_expand_expr_hashpair_ident($k, $v);
614 sub _expand_expr_hashpair_ident {
615 my ($self, $k, $v) = @_;
620 and exists $v->{-value}
621 and not defined $v->{-value}
624 return $self->_expand_expr({ $k => { $self->{cmp} => undef } });
626 if (!ref($v) or Scalar::Util::blessed($v)) {
627 my $d = our $Default_Scalar_To;
631 $self->_expand_ident(-ident => $k),
633 ? $self->_expand_expr($d => $v)
634 : { -bind => [ $k, $v ] }
639 if (ref($v) eq 'HASH') {
641 return $self->_expand_op_andor(-and => [
642 map +{ $k => { $_ => $v->{$_} } },
646 return undef unless keys %$v;
648 my $op = join ' ', split '_', (map lc, $vk =~ /^-?(.*)$/)[0];
649 $self->_assert_pass_injection_guard($op);
650 if ($op =~ s/ [_\s]? \d+ $//x ) {
651 return $self->_expand_expr($k, $v);
653 if (my $x = $self->{expand_op}{$op}) {
654 local our $Cur_Col_Meta = $k;
655 return $self->$x($op, $vv, $k);
657 if ($op =~ /^is(?: not)?$/) {
658 puke "$op can only take undef as argument"
662 and exists($vv->{-value})
663 and !defined($vv->{-value})
665 return +{ -op => [ $op.' null', $self->_expand_ident(-ident => $k) ] };
667 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
668 return { -op => [ $op, $self->_expand_ident(-ident => $k), $vv ] };
670 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
673 $self->_expand_ident(-ident => $k),
674 { -op => [ $op, $vv ] }
677 if (ref($vv) eq 'ARRAY') {
678 my ($logic, @values) = (
679 (defined($vv->[0]) and $vv->[0] =~ /^-(and|or)$/i)
684 $op =~ $self->{inequality_op}
685 or $op =~ $self->{not_like_op}
687 if (lc($logic) eq '-or' and @values > 1) {
688 belch "A multi-element arrayref as an argument to the inequality op '${\uc($op)}' "
689 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
690 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
695 # try to DWIM on equality operators
697 $op =~ $self->{equality_op} ? $self->sqlfalse
698 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqlfalse
699 : $op =~ $self->{inequality_op} ? $self->sqltrue
700 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqltrue
701 : puke "operator '$op' applied on an empty array (field '$k')";
703 return $self->_expand_op_andor($logic => [
704 map +{ $k => { $vk => $_ } },
712 and exists $vv->{-value}
713 and not defined $vv->{-value}
717 $op =~ /^not$/i ? 'is not' # legacy
718 : $op =~ $self->{equality_op} ? 'is'
719 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
720 : $op =~ $self->{inequality_op} ? 'is not'
721 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
722 : puke "unexpected operator '$op' with undef operand";
723 return +{ -op => [ $is.' null', $self->_expand_ident(-ident => $k) ] };
725 local our $Cur_Col_Meta = $k;
728 $self->_expand_ident(-ident => $k),
729 $self->_expand_expr($vv)
732 if (ref($v) eq 'ARRAY') {
733 return $self->sqlfalse unless @$v;
734 $self->_debug("ARRAY($k) means distribute over elements");
736 $v->[0] =~ /^-(and|or)$/i
737 ? shift(@{$v = [ @$v ]})
738 : '-'.lc($self->{logic} || 'OR')
740 return $self->_expand_op_andor(
741 $logic => [ map +{ $k => $_ }, @$v ]
744 if (my $literal = is_literal_value($v)) {
746 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
749 my ($sql, @bind) = @$literal;
750 if ($self->{bindtype} eq 'columns') {
752 $self->_assert_bindval_matches_bindtype($_);
755 return +{ -literal => [ $self->_quote($k).' '.$sql, @bind ] };
760 sub _expand_expr_hashpair_op {
761 my ($self, $k, $v) = @_;
763 $op =~ s/^-// if length($op) > 1;
764 $self->_assert_pass_injection_guard($op);
765 if (my ($rest) = $op =~/^not[_ ](.*)$/) {
768 $self->_expand_expr({ "-${rest}", $v })
771 # top level special ops are illegal in general
772 # note that, arguably, if it makes no sense at top level, it also
773 # makes no sense on the other side of an = sign or similar but DBIC
774 # gets disappointingly upset if I disallow it
776 (our $Expand_Depth) == 1
777 and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
779 puke "Illegal use of top-level '-$op'"
781 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
782 return { -op => [ $op, $v ] };
784 if ($self->{render}{$k}) {
790 and (keys %$v)[0] =~ /^-/
792 my ($func) = $k =~ /^-(.*)$/;
793 if (List::Util::first { $func =~ $_->{regex} } @{$self->{special_ops}}) {
794 return +{ -op => [ $func, $self->_expand_expr($v) ] };
796 return +{ -func => [ $func, $self->_expand_expr($v) ] };
798 if (!ref($v) or is_literal_value($v)) {
799 return +{ -op => [ $op, $self->_expand_expr($v) ] };
805 my ($self, $op, $body) = @_;
806 unless (defined($body) or (ref($body) and ref($body) eq 'ARRAY')) {
807 puke "$op requires a single plain scalar argument (a quotable identifier) or an arrayref of identifier parts";
809 my @parts = map split(/\Q${\($self->{name_sep}||'.')}\E/, $_),
810 ref($body) ? @$body : $body;
811 return { -ident => $parts[-1] } if $self->{_dequalify_idents};
812 unless ($self->{quote_char}) {
813 $self->_assert_pass_injection_guard($_) for @parts;
815 return +{ -ident => \@parts };
819 +{ -bind => [ our $Cur_Col_Meta, $_[2] ] };
823 +{ -op => [ 'not', $_[0]->_expand_expr($_[2]) ] };
827 my ($self, undef, $v) = @_;
829 return $self->_expand_expr($v);
831 puke "-bool => undef not supported" unless defined($v);
832 return $self->_expand_ident(-ident => $v);
835 sub _expand_op_andor {
836 my ($self, $logic, $v, $k) = @_;
838 $v = [ map +{ $k, { $_ => $v->{$_} } },
841 my ($logop) = $logic =~ /^-?(.*)$/;
842 if (ref($v) eq 'HASH') {
845 map $self->_expand_expr({ $_ => $v->{$_} }),
849 if (ref($v) eq 'ARRAY') {
850 $logop eq 'and' or $logop eq 'or' or puke "unknown logic: $logop";
853 (ref($_) eq 'ARRAY' and @$_)
854 or (ref($_) eq 'HASH' and %$_)
860 while (my ($el) = splice @expr, 0, 1) {
861 puke "Supplying an empty left hand side argument is not supported in array-pairs"
862 unless defined($el) and length($el);
863 my $elref = ref($el);
865 local our $Expand_Depth = 0;
866 push(@res, grep defined, $self->_expand_expr({ $el, shift(@expr) }));
867 } elsif ($elref eq 'ARRAY') {
868 push(@res, grep defined, $self->_expand_expr($el)) if @$el;
869 } elsif (my $l = is_literal_value($el)) {
870 push @res, { -literal => $l };
871 } elsif ($elref eq 'HASH') {
872 local our $Expand_Depth = 0;
873 push @res, grep defined, $self->_expand_expr($el) if %$el;
879 # return $res[0] if @res == 1;
880 return { -op => [ $logop, @res ] };
885 sub _expand_between {
886 my ($self, $op, $vv, $k) = @_;
887 local our $Cur_Col_Meta = $k;
888 my @rhs = map $self->_expand_expr($_),
889 ref($vv) eq 'ARRAY' ? @$vv : $vv;
891 (@rhs == 1 and ref($rhs[0]) eq 'HASH' and $rhs[0]->{-literal})
893 (@rhs == 2 and defined($rhs[0]) and defined($rhs[1]))
895 puke "Operator '${\uc($op)}' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
899 $self->_expand_ident(-ident => $k),
905 my ($self, $op, $vv, $k) = @_;
906 if (my $literal = is_literal_value($vv)) {
907 my ($sql, @bind) = @$literal;
908 my $opened_sql = $self->_open_outer_paren($sql);
910 $op, $self->_expand_ident(-ident => $k),
911 [ { -literal => [ $opened_sql, @bind ] } ]
915 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
916 . "-${\uc($op)} operator was given an undef-containing list: !!!AUDIT YOUR CODE "
917 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
918 . 'will emit the logically correct SQL instead of raising this exception)'
920 puke("Argument passed to the '${\uc($op)}' operator can not be undefined")
922 my @rhs = map $self->_expand_expr($_),
923 map { ref($_) ? $_ : { -bind => [ $k, $_ ] } }
924 map { defined($_) ? $_: puke($undef_err) }
925 (ref($vv) eq 'ARRAY' ? @$vv : $vv);
926 return $self->${\($op =~ /^not/ ? 'sqltrue' : 'sqlfalse')} unless @rhs;
930 $self->_expand_ident(-ident => $k),
936 my ($self, $op, $v) = @_;
937 # DBIx::Class requires a nest warning to be emitted once but the private
938 # method it overrode to do so no longer exists
939 if ($self->{is_dbic_sqlmaker}) {
940 unless (our $Nest_Warned) {
942 "-nest in search conditions is deprecated, you most probably wanted:\n"
943 .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
948 return $self->_expand_expr($v);
952 my ($self, $where, $logic) = @_;
954 # Special case: top level simple string treated as literal
956 my $where_exp = (ref($where)
957 ? $self->_expand_expr($where, $logic)
958 : { -literal => [ $where ] });
960 # dispatch expanded expression
962 my ($sql, @bind) = defined($where_exp) ? $self->render_aqt($where_exp) : (undef);
963 # DBIx::Class used to call _recurse_where in scalar context
964 # something else might too...
966 return ($sql, @bind);
969 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
975 my ($self, $ident) = @_;
977 return $self->_convert($self->_quote($ident));
981 my ($self, $list) = @_;
982 my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$list;
983 return join(', ', map $_->[0], @parts), map @{$_}[1..$#$_], @parts;
987 my ($self, $rest) = @_;
988 my ($func, @args) = @$rest;
992 push @arg_sql, shift @x;
994 } map [ $self->render_aqt($_) ], @args;
995 return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
999 my ($self, $bind) = @_;
1000 return ($self->_convert('?'), $self->_bindtype(@$bind));
1003 sub _render_literal {
1004 my ($self, $literal) = @_;
1005 $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
1011 my ($self, $op, $args) = @_;
1012 my ($left, $low, $high) = @$args;
1013 my ($rhsql, @rhbind) = do {
1015 puke "Single arg to between must be a literal"
1016 unless $low->{-literal};
1019 my ($l, $h) = map [ $self->render_aqt($_) ], $low, $high;
1020 (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
1021 @{$l}[1..$#$l], @{$h}[1..$#$h])
1024 my ($lhsql, @lhbind) = $self->render_aqt($left);
1026 join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
1029 }), 'between', 'not between'),
1031 my ($self, $op, $args) = @_;
1032 my ($lhs, $rhs) = @$args;
1035 my ($sql, @bind) = $self->render_aqt($_);
1036 push @in_bind, @bind;
1039 my ($lhsql, @lbind) = $self->render_aqt($lhs);
1041 $lhsql.' '.$self->_sqlcase($op).' ( '
1042 .join(', ', @in_sql)
1046 }), 'in', 'not in'),
1047 (map +($_ => '_render_unop_postfix'),
1048 'is null', 'is not null', 'asc', 'desc',
1050 (not => '_render_op_not'),
1052 my ($self, $op, $args) = @_;
1053 my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args;
1054 return '' unless @parts;
1055 return @{$parts[0]} if @parts == 1;
1056 my ($final_sql) = join(
1057 ' '.$self->_sqlcase($op).' ',
1062 map @{$_}[1..$#$_], @parts
1068 my ($self, $v) = @_;
1069 my ($op, @args) = @$v;
1070 if (my $r = $self->{render_op}{$op}) {
1071 return $self->$r($op, \@args);
1073 my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
1074 if ($us and @args > 1) {
1075 puke "Special op '${op}' requires first value to be identifier"
1076 unless my ($ident) = map $_->{-ident}, grep ref($_) eq 'HASH', $args[0];
1077 my $k = join(($self->{name_sep}||'.'), @$ident);
1078 local our $Expand_Depth = 1;
1079 return $self->${\($us->{handler})}($k, $op, $args[1]);
1081 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
1082 return $self->${\($us->{handler})}($op, $args[0]);
1085 return $self->_render_unop_prefix($op, \@args);
1087 my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @args;
1088 return '' unless @parts;
1089 my ($final_sql) = join(
1090 ' '.$self->_sqlcase($op).' ',
1095 map @{$_}[1..$#$_], @parts
1101 sub _render_op_not {
1102 my ($self, $op, $v) = @_;
1103 my ($sql, @bind) = $self->_render_unop_prefix($op, $v);
1104 return "(${sql})", @bind;
1107 sub _render_unop_prefix {
1108 my ($self, $op, $v) = @_;
1109 my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
1110 my $op_sql = $self->_sqlcase($op);
1111 return ("${op_sql} ${expr_sql}", @bind);
1114 sub _render_unop_postfix {
1115 my ($self, $op, $v) = @_;
1116 my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
1117 my $op_sql = $self->_sqlcase($op);
1118 return ($expr_sql.' '.$op_sql, @bind);
1121 # Some databases (SQLite) treat col IN (1, 2) different from
1122 # col IN ( (1, 2) ). Use this to strip all outer parens while
1123 # adding them back in the corresponding method
1124 sub _open_outer_paren {
1125 my ($self, $sql) = @_;
1127 while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
1129 # there are closing parens inside, need the heavy duty machinery
1130 # to reevaluate the extraction starting from $sql (full reevaluation)
1131 if ($inner =~ /\)/) {
1132 require Text::Balanced;
1134 my (undef, $remainder) = do {
1135 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1137 Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
1140 # the entire expression needs to be a balanced bracketed thing
1141 # (after an extract no remainder sans trailing space)
1142 last if defined $remainder and $remainder =~ /\S/;
1152 #======================================================================
1154 #======================================================================
1156 sub _expand_order_by {
1157 my ($self, $arg) = @_;
1159 return unless defined($arg) and not (ref($arg) eq 'ARRAY' and !@$arg);
1161 my $expander = sub {
1162 my ($self, $dir, $expr) = @_;
1163 my @to_expand = ref($expr) eq 'ARRAY' ? @$expr : $expr;
1164 foreach my $arg (@to_expand) {
1168 and grep /^-(asc|desc)$/, keys %$arg
1170 puke "ordering direction hash passed to order by must have exactly one key (-asc or -desc)";
1174 defined($dir) ? { -op => [ $dir =~ /^-?(.*)$/ ,=> $_ ] } : $_
1176 map $self->expand_expr($_, -ident),
1177 map ref($_) eq 'ARRAY' ? @$_ : $_, @to_expand;
1178 return (@exp > 1 ? { -list => \@exp } : $exp[0]);
1181 local @{$self->{expand}}{qw(-asc -desc)} = (($expander) x 2);
1183 return $self->$expander(undef, $arg);
1187 my ($self, $arg) = @_;
1189 return '' unless defined(my $expanded = $self->_expand_order_by($arg));
1191 my ($sql, @bind) = $self->render_aqt($expanded);
1193 return '' unless length($sql);
1195 my $final_sql = $self->_sqlcase(' order by ').$sql;
1197 return wantarray ? ($final_sql, @bind) : $final_sql;
1200 # _order_by no longer needs to call this so doesn't but DBIC uses it.
1202 sub _order_by_chunks {
1203 my ($self, $arg) = @_;
1205 return () unless defined(my $expanded = $self->_expand_order_by($arg));
1207 return $self->_chunkify_order_by($expanded);
1210 sub _chunkify_order_by {
1211 my ($self, $expanded) = @_;
1213 return grep length, $self->render_aqt($expanded)
1214 if $expanded->{-ident} or @{$expanded->{-literal}||[]} == 1;
1217 if (ref() eq 'HASH' and my $l = $_->{-list}) {
1218 return map $self->_chunkify_order_by($_), @$l;
1220 return [ $self->render_aqt($_) ];
1224 #======================================================================
1225 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1226 #======================================================================
1232 $self->_expand_maybe_list_expr($from, undef, -ident)
1237 #======================================================================
1239 #======================================================================
1241 sub _expand_maybe_list_expr {
1242 my ($self, $expr, $logic, $default) = @_;
1244 if (ref($expr) eq 'ARRAY') {
1246 map $self->expand_expr($_, $default), @$expr
1253 return $self->expand_expr($e, $default);
1256 # highly optimized, as it's called way too often
1258 # my ($self, $label) = @_;
1260 return '' unless defined $_[1];
1261 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1262 puke 'Identifier cannot be hashref' if ref($_[1]) eq 'HASH';
1264 unless ($_[0]->{quote_char}) {
1265 if (ref($_[1]) eq 'ARRAY') {
1266 return join($_[0]->{name_sep}||'.', @{$_[1]});
1268 $_[0]->_assert_pass_injection_guard($_[1]);
1273 my $qref = ref $_[0]->{quote_char};
1275 !$qref ? ($_[0]->{quote_char}, $_[0]->{quote_char})
1276 : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}}
1277 : puke "Unsupported quote_char format: $_[0]->{quote_char}";
1279 my $esc = $_[0]->{escape_char} || $r;
1281 # parts containing * are naturally unquoted
1283 $_[0]->{name_sep}||'',
1287 : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r }
1289 (ref($_[1]) eq 'ARRAY'
1293 ? split (/\Q$_[0]->{name_sep}\E/, $_[1] )
1301 # Conversion, if applicable
1303 #my ($self, $arg) = @_;
1304 if ($_[0]->{convert_where}) {
1305 return $_[0]->_sqlcase($_[0]->{convert_where}) .'(' . $_[1] . ')';
1312 #my ($self, $col, @vals) = @_;
1313 # called often - tighten code
1314 return $_[0]->{bindtype} eq 'columns'
1315 ? map {[$_[1], $_]} @_[2 .. $#_]
1320 # Dies if any element of @bind is not in [colname => value] format
1321 # if bindtype is 'columns'.
1322 sub _assert_bindval_matches_bindtype {
1323 # my ($self, @bind) = @_;
1325 if ($self->{bindtype} eq 'columns') {
1327 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1328 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1334 sub _join_sql_clauses {
1335 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1337 if (@$clauses_aref > 1) {
1338 my $join = " " . $self->_sqlcase($logic) . " ";
1339 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1340 return ($sql, @$bind_aref);
1342 elsif (@$clauses_aref) {
1343 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1346 return (); # if no SQL, ignore @$bind_aref
1351 # Fix SQL case, if so requested
1353 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1354 # don't touch the argument ... crooked logic, but let's not change it!
1355 return $_[0]->{case} ? $_[1] : uc($_[1]);
1359 #======================================================================
1360 # DISPATCHING FROM REFKIND
1361 #======================================================================
1364 my ($self, $data) = @_;
1366 return 'UNDEF' unless defined $data;
1368 # blessed objects are treated like scalars
1369 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1371 return 'SCALAR' unless $ref;
1374 while ($ref eq 'REF') {
1376 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1380 return ($ref||'SCALAR') . ('REF' x $n_steps);
1384 my ($self, $data) = @_;
1385 my @try = ($self->_refkind($data));
1386 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1387 push @try, 'FALLBACK';
1391 sub _METHOD_FOR_refkind {
1392 my ($self, $meth_prefix, $data) = @_;
1395 for (@{$self->_try_refkind($data)}) {
1396 $method = $self->can($meth_prefix."_".$_)
1400 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1404 sub _SWITCH_refkind {
1405 my ($self, $data, $dispatch_table) = @_;
1408 for (@{$self->_try_refkind($data)}) {
1409 $coderef = $dispatch_table->{$_}
1413 puke "no dispatch entry for ".$self->_refkind($data)
1422 #======================================================================
1423 # VALUES, GENERATE, AUTOLOAD
1424 #======================================================================
1426 # LDNOTE: original code from nwiger, didn't touch code in that section
1427 # I feel the AUTOLOAD stuff should not be the default, it should
1428 # only be activated on explicit demand by user.
1432 my $data = shift || return;
1433 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1434 unless ref $data eq 'HASH';
1437 foreach my $k (sort keys %$data) {
1438 my $v = $data->{$k};
1439 $self->_SWITCH_refkind($v, {
1441 if ($self->{array_datatypes}) { # array datatype
1442 push @all_bind, $self->_bindtype($k, $v);
1444 else { # literal SQL with bind
1445 my ($sql, @bind) = @$v;
1446 $self->_assert_bindval_matches_bindtype(@bind);
1447 push @all_bind, @bind;
1450 ARRAYREFREF => sub { # literal SQL with bind
1451 my ($sql, @bind) = @${$v};
1452 $self->_assert_bindval_matches_bindtype(@bind);
1453 push @all_bind, @bind;
1455 SCALARREF => sub { # literal SQL without bind
1457 SCALAR_or_UNDEF => sub {
1458 push @all_bind, $self->_bindtype($k, $v);
1469 my(@sql, @sqlq, @sqlv);
1473 if ($ref eq 'HASH') {
1474 for my $k (sort keys %$_) {
1477 my $label = $self->_quote($k);
1478 if ($r eq 'ARRAY') {
1479 # literal SQL with bind
1480 my ($sql, @bind) = @$v;
1481 $self->_assert_bindval_matches_bindtype(@bind);
1482 push @sqlq, "$label = $sql";
1484 } elsif ($r eq 'SCALAR') {
1485 # literal SQL without bind
1486 push @sqlq, "$label = $$v";
1488 push @sqlq, "$label = ?";
1489 push @sqlv, $self->_bindtype($k, $v);
1492 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1493 } elsif ($ref eq 'ARRAY') {
1494 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1497 if ($r eq 'ARRAY') { # literal SQL with bind
1498 my ($sql, @bind) = @$v;
1499 $self->_assert_bindval_matches_bindtype(@bind);
1502 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1503 # embedded literal SQL
1510 push @sql, '(' . join(', ', @sqlq) . ')';
1511 } elsif ($ref eq 'SCALAR') {
1515 # strings get case twiddled
1516 push @sql, $self->_sqlcase($_);
1520 my $sql = join ' ', @sql;
1522 # this is pretty tricky
1523 # if ask for an array, return ($stmt, @bind)
1524 # otherwise, s/?/shift @sqlv/ to put it inline
1526 return ($sql, @sqlv);
1528 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1529 ref $d ? $d->[1] : $d/e;
1538 # This allows us to check for a local, then _form, attr
1540 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1541 return $self->generate($name, @_);
1552 SQL::Abstract - Generate SQL from Perl data structures
1558 my $sql = SQL::Abstract->new;
1560 my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order);
1562 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1564 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1566 my($stmt, @bind) = $sql->delete($table, \%where);
1568 # Then, use these in your DBI statements
1569 my $sth = $dbh->prepare($stmt);
1570 $sth->execute(@bind);
1572 # Just generate the WHERE clause
1573 my($stmt, @bind) = $sql->where(\%where, $order);
1575 # Return values in the same order, for hashed queries
1576 # See PERFORMANCE section for more details
1577 my @bind = $sql->values(\%fieldvals);
1581 This module was inspired by the excellent L<DBIx::Abstract>.
1582 However, in using that module I found that what I really wanted
1583 to do was generate SQL, but still retain complete control over my
1584 statement handles and use the DBI interface. So, I set out to
1585 create an abstract SQL generation module.
1587 While based on the concepts used by L<DBIx::Abstract>, there are
1588 several important differences, especially when it comes to WHERE
1589 clauses. I have modified the concepts used to make the SQL easier
1590 to generate from Perl data structures and, IMO, more intuitive.
1591 The underlying idea is for this module to do what you mean, based
1592 on the data structures you provide it. The big advantage is that
1593 you don't have to modify your code every time your data changes,
1594 as this module figures it out.
1596 To begin with, an SQL INSERT is as easy as just specifying a hash
1597 of C<key=value> pairs:
1600 name => 'Jimbo Bobson',
1601 phone => '123-456-7890',
1602 address => '42 Sister Lane',
1603 city => 'St. Louis',
1604 state => 'Louisiana',
1607 The SQL can then be generated with this:
1609 my($stmt, @bind) = $sql->insert('people', \%data);
1611 Which would give you something like this:
1613 $stmt = "INSERT INTO people
1614 (address, city, name, phone, state)
1615 VALUES (?, ?, ?, ?, ?)";
1616 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1617 '123-456-7890', 'Louisiana');
1619 These are then used directly in your DBI code:
1621 my $sth = $dbh->prepare($stmt);
1622 $sth->execute(@bind);
1624 =head2 Inserting and Updating Arrays
1626 If your database has array types (like for example Postgres),
1627 activate the special option C<< array_datatypes => 1 >>
1628 when creating the C<SQL::Abstract> object.
1629 Then you may use an arrayref to insert and update database array types:
1631 my $sql = SQL::Abstract->new(array_datatypes => 1);
1633 planets => [qw/Mercury Venus Earth Mars/]
1636 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1640 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1642 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1645 =head2 Inserting and Updating SQL
1647 In order to apply SQL functions to elements of your C<%data> you may
1648 specify a reference to an arrayref for the given hash value. For example,
1649 if you need to execute the Oracle C<to_date> function on a value, you can
1650 say something like this:
1654 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1657 The first value in the array is the actual SQL. Any other values are
1658 optional and would be included in the bind values array. This gives
1661 my($stmt, @bind) = $sql->insert('people', \%data);
1663 $stmt = "INSERT INTO people (name, date_entered)
1664 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1665 @bind = ('Bill', '03/02/2003');
1667 An UPDATE is just as easy, all you change is the name of the function:
1669 my($stmt, @bind) = $sql->update('people', \%data);
1671 Notice that your C<%data> isn't touched; the module will generate
1672 the appropriately quirky SQL for you automatically. Usually you'll
1673 want to specify a WHERE clause for your UPDATE, though, which is
1674 where handling C<%where> hashes comes in handy...
1676 =head2 Complex where statements
1678 This module can generate pretty complicated WHERE statements
1679 easily. For example, simple C<key=value> pairs are taken to mean
1680 equality, and if you want to see if a field is within a set
1681 of values, you can use an arrayref. Let's say we wanted to
1682 SELECT some data based on this criteria:
1685 requestor => 'inna',
1686 worker => ['nwiger', 'rcwe', 'sfz'],
1687 status => { '!=', 'completed' }
1690 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1692 The above would give you something like this:
1694 $stmt = "SELECT * FROM tickets WHERE
1695 ( requestor = ? ) AND ( status != ? )
1696 AND ( worker = ? OR worker = ? OR worker = ? )";
1697 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1699 Which you could then use in DBI code like so:
1701 my $sth = $dbh->prepare($stmt);
1702 $sth->execute(@bind);
1708 The methods are simple. There's one for every major SQL operation,
1709 and a constructor you use first. The arguments are specified in a
1710 similar order for each method (table, then fields, then a where
1711 clause) to try and simplify things.
1713 =head2 new(option => 'value')
1715 The C<new()> function takes a list of options and values, and returns
1716 a new B<SQL::Abstract> object which can then be used to generate SQL
1717 through the methods below. The options accepted are:
1723 If set to 'lower', then SQL will be generated in all lowercase. By
1724 default SQL is generated in "textbook" case meaning something like:
1726 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1728 Any setting other than 'lower' is ignored.
1732 This determines what the default comparison operator is. By default
1733 it is C<=>, meaning that a hash like this:
1735 %where = (name => 'nwiger', email => 'nate@wiger.org');
1737 Will generate SQL like this:
1739 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1741 However, you may want loose comparisons by default, so if you set
1742 C<cmp> to C<like> you would get SQL such as:
1744 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1746 You can also override the comparison on an individual basis - see
1747 the huge section on L</"WHERE CLAUSES"> at the bottom.
1749 =item sqltrue, sqlfalse
1751 Expressions for inserting boolean values within SQL statements.
1752 By default these are C<1=1> and C<1=0>. They are used
1753 by the special operators C<-in> and C<-not_in> for generating
1754 correct SQL even when the argument is an empty array (see below).
1758 This determines the default logical operator for multiple WHERE
1759 statements in arrays or hashes. If absent, the default logic is "or"
1760 for arrays, and "and" for hashes. This means that a WHERE
1764 event_date => {'>=', '2/13/99'},
1765 event_date => {'<=', '4/24/03'},
1768 will generate SQL like this:
1770 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1772 This is probably not what you want given this query, though (look
1773 at the dates). To change the "OR" to an "AND", simply specify:
1775 my $sql = SQL::Abstract->new(logic => 'and');
1777 Which will change the above C<WHERE> to:
1779 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1781 The logic can also be changed locally by inserting
1782 a modifier in front of an arrayref:
1784 @where = (-and => [event_date => {'>=', '2/13/99'},
1785 event_date => {'<=', '4/24/03'} ]);
1787 See the L</"WHERE CLAUSES"> section for explanations.
1791 This will automatically convert comparisons using the specified SQL
1792 function for both column and value. This is mostly used with an argument
1793 of C<upper> or C<lower>, so that the SQL will have the effect of
1794 case-insensitive "searches". For example, this:
1796 $sql = SQL::Abstract->new(convert => 'upper');
1797 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1799 Will turn out the following SQL:
1801 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1803 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1804 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1805 not validate this option; it will just pass through what you specify verbatim).
1809 This is a kludge because many databases suck. For example, you can't
1810 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1811 Instead, you have to use C<bind_param()>:
1813 $sth->bind_param(1, 'reg data');
1814 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1816 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1817 which loses track of which field each slot refers to. Fear not.
1819 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1820 Currently, you can specify either C<normal> (default) or C<columns>. If you
1821 specify C<columns>, you will get an array that looks like this:
1823 my $sql = SQL::Abstract->new(bindtype => 'columns');
1824 my($stmt, @bind) = $sql->insert(...);
1827 [ 'column1', 'value1' ],
1828 [ 'column2', 'value2' ],
1829 [ 'column3', 'value3' ],
1832 You can then iterate through this manually, using DBI's C<bind_param()>.
1834 $sth->prepare($stmt);
1837 my($col, $data) = @$_;
1838 if ($col eq 'details' || $col eq 'comments') {
1839 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1840 } elsif ($col eq 'image') {
1841 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1843 $sth->bind_param($i, $data);
1847 $sth->execute; # execute without @bind now
1849 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1850 Basically, the advantage is still that you don't have to care which fields
1851 are or are not included. You could wrap that above C<for> loop in a simple
1852 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1853 get a layer of abstraction over manual SQL specification.
1855 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
1856 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1857 will expect the bind values in this format.
1861 This is the character that a table or column name will be quoted
1862 with. By default this is an empty string, but you could set it to
1863 the character C<`>, to generate SQL like this:
1865 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1867 Alternatively, you can supply an array ref of two items, the first being the left
1868 hand quote character, and the second the right hand quote character. For
1869 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1870 that generates SQL like this:
1872 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1874 Quoting is useful if you have tables or columns names that are reserved
1875 words in your database's SQL dialect.
1879 This is the character that will be used to escape L</quote_char>s appearing
1880 in an identifier before it has been quoted.
1882 The parameter default in case of a single L</quote_char> character is the quote
1885 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1886 this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences
1887 of the B<opening (left)> L</quote_char> within the identifier are currently left
1888 untouched. The default for opening-closing-style quotes may change in future
1889 versions, thus you are B<strongly encouraged> to specify the escape character
1894 This is the character that separates a table and column name. It is
1895 necessary to specify this when the C<quote_char> option is selected,
1896 so that tables and column names can be individually quoted like this:
1898 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1900 =item injection_guard
1902 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1903 column name specified in a query structure. This is a safety mechanism to avoid
1904 injection attacks when mishandling user input e.g.:
1906 my %condition_as_column_value_pairs = get_values_from_user();
1907 $sqla->select( ... , \%condition_as_column_value_pairs );
1909 If the expression matches an exception is thrown. Note that literal SQL
1910 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1912 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1914 =item array_datatypes
1916 When this option is true, arrayrefs in INSERT or UPDATE are
1917 interpreted as array datatypes and are passed directly
1919 When this option is false, arrayrefs are interpreted
1920 as literal SQL, just like refs to arrayrefs
1921 (but this behavior is for backwards compatibility; when writing
1922 new queries, use the "reference to arrayref" syntax
1928 Takes a reference to a list of "special operators"
1929 to extend the syntax understood by L<SQL::Abstract>.
1930 See section L</"SPECIAL OPERATORS"> for details.
1934 Takes a reference to a list of "unary operators"
1935 to extend the syntax understood by L<SQL::Abstract>.
1936 See section L</"UNARY OPERATORS"> for details.
1942 =head2 insert($table, \@values || \%fieldvals, \%options)
1944 This is the simplest function. You simply give it a table name
1945 and either an arrayref of values or hashref of field/value pairs.
1946 It returns an SQL INSERT statement and a list of bind values.
1947 See the sections on L</"Inserting and Updating Arrays"> and
1948 L</"Inserting and Updating SQL"> for information on how to insert
1949 with those data types.
1951 The optional C<\%options> hash reference may contain additional
1952 options to generate the insert SQL. Currently supported options
1959 Takes either a scalar of raw SQL fields, or an array reference of
1960 field names, and adds on an SQL C<RETURNING> statement at the end.
1961 This allows you to return data generated by the insert statement
1962 (such as row IDs) without performing another C<SELECT> statement.
1963 Note, however, this is not part of the SQL standard and may not
1964 be supported by all database engines.
1968 =head2 update($table, \%fieldvals, \%where, \%options)
1970 This takes a table, hashref of field/value pairs, and an optional
1971 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1973 See the sections on L</"Inserting and Updating Arrays"> and
1974 L</"Inserting and Updating SQL"> for information on how to insert
1975 with those data types.
1977 The optional C<\%options> hash reference may contain additional
1978 options to generate the update SQL. Currently supported options
1985 See the C<returning> option to
1986 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
1990 =head2 select($source, $fields, $where, $order)
1992 This returns a SQL SELECT statement and associated list of bind values, as
1993 specified by the arguments:
1999 Specification of the 'FROM' part of the statement.
2000 The argument can be either a plain scalar (interpreted as a table
2001 name, will be quoted), or an arrayref (interpreted as a list
2002 of table names, joined by commas, quoted), or a scalarref
2003 (literal SQL, not quoted).
2007 Specification of the list of fields to retrieve from
2009 The argument can be either an arrayref (interpreted as a list
2010 of field names, will be joined by commas and quoted), or a
2011 plain scalar (literal SQL, not quoted).
2012 Please observe that this API is not as flexible as that of
2013 the first argument C<$source>, for backwards compatibility reasons.
2017 Optional argument to specify the WHERE part of the query.
2018 The argument is most often a hashref, but can also be
2019 an arrayref or plain scalar --
2020 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2024 Optional argument to specify the ORDER BY part of the query.
2025 The argument can be a scalar, a hashref or an arrayref
2026 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2032 =head2 delete($table, \%where, \%options)
2034 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2035 It returns an SQL DELETE statement and list of bind values.
2037 The optional C<\%options> hash reference may contain additional
2038 options to generate the delete SQL. Currently supported options
2045 See the C<returning> option to
2046 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2050 =head2 where(\%where, $order)
2052 This is used to generate just the WHERE clause. For example,
2053 if you have an arbitrary data structure and know what the
2054 rest of your SQL is going to look like, but want an easy way
2055 to produce a WHERE clause, use this. It returns an SQL WHERE
2056 clause and list of bind values.
2059 =head2 values(\%data)
2061 This just returns the values from the hash C<%data>, in the same
2062 order that would be returned from any of the other above queries.
2063 Using this allows you to markedly speed up your queries if you
2064 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2066 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2068 Warning: This is an experimental method and subject to change.
2070 This returns arbitrarily generated SQL. It's a really basic shortcut.
2071 It will return two different things, depending on return context:
2073 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2074 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2076 These would return the following:
2078 # First calling form
2079 $stmt = "CREATE TABLE test (?, ?)";
2080 @bind = (field1, field2);
2082 # Second calling form
2083 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2085 Depending on what you're trying to do, it's up to you to choose the correct
2086 format. In this example, the second form is what you would want.
2090 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2094 ALTER SESSION SET nls_date_format = 'MM/YY'
2096 You get the idea. Strings get their case twiddled, but everything
2097 else remains verbatim.
2099 =head1 EXPORTABLE FUNCTIONS
2101 =head2 is_plain_value
2103 Determines if the supplied argument is a plain value as understood by this
2108 =item * The value is C<undef>
2110 =item * The value is a non-reference
2112 =item * The value is an object with stringification overloading
2114 =item * The value is of the form C<< { -value => $anything } >>
2118 On failure returns C<undef>, on success returns a B<scalar> reference
2119 to the original supplied argument.
2125 The stringification overloading detection is rather advanced: it takes
2126 into consideration not only the presence of a C<""> overload, but if that
2127 fails also checks for enabled
2128 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2129 on either C<0+> or C<bool>.
2131 Unfortunately testing in the field indicates that this
2132 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2133 but only when very large numbers of stringifying objects are involved.
2134 At the time of writing ( Sep 2014 ) there is no clear explanation of
2135 the direct cause, nor is there a manageably small test case that reliably
2136 reproduces the problem.
2138 If you encounter any of the following exceptions in B<random places within
2139 your application stack> - this module may be to blame:
2141 Operation "ne": no method found,
2142 left argument in overloaded package <something>,
2143 right argument in overloaded package <something>
2147 Stub found while resolving method "???" overloading """" in package <something>
2149 If you fall victim to the above - please attempt to reduce the problem
2150 to something that could be sent to the L<SQL::Abstract developers
2151 |DBIx::Class/GETTING HELP/SUPPORT>
2152 (either publicly or privately). As a workaround in the meantime you can
2153 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2154 value, which will most likely eliminate your problem (at the expense of
2155 not being able to properly detect exotic forms of stringification).
2157 This notice and environment variable will be removed in a future version,
2158 as soon as the underlying problem is found and a reliable workaround is
2163 =head2 is_literal_value
2165 Determines if the supplied argument is a literal value as understood by this
2170 =item * C<\$sql_string>
2172 =item * C<\[ $sql_string, @bind_values ]>
2176 On failure returns C<undef>, on success returns an B<array> reference
2177 containing the unpacked version of the supplied literal SQL and bind values.
2179 =head1 WHERE CLAUSES
2183 This module uses a variation on the idea from L<DBIx::Abstract>. It
2184 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2185 module is that things in arrays are OR'ed, and things in hashes
2188 The easiest way to explain is to show lots of examples. After
2189 each C<%where> hash shown, it is assumed you used:
2191 my($stmt, @bind) = $sql->where(\%where);
2193 However, note that the C<%where> hash can be used directly in any
2194 of the other functions as well, as described above.
2196 =head2 Key-value pairs
2198 So, let's get started. To begin, a simple hash:
2202 status => 'completed'
2205 Is converted to SQL C<key = val> statements:
2207 $stmt = "WHERE user = ? AND status = ?";
2208 @bind = ('nwiger', 'completed');
2210 One common thing I end up doing is having a list of values that
2211 a field can be in. To do this, simply specify a list inside of
2216 status => ['assigned', 'in-progress', 'pending'];
2219 This simple code will create the following:
2221 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2222 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2224 A field associated to an empty arrayref will be considered a
2225 logical false and will generate 0=1.
2227 =head2 Tests for NULL values
2229 If the value part is C<undef> then this is converted to SQL <IS NULL>
2238 $stmt = "WHERE user = ? AND status IS NULL";
2241 To test if a column IS NOT NULL:
2245 status => { '!=', undef },
2248 =head2 Specific comparison operators
2250 If you want to specify a different type of operator for your comparison,
2251 you can use a hashref for a given column:
2255 status => { '!=', 'completed' }
2258 Which would generate:
2260 $stmt = "WHERE user = ? AND status != ?";
2261 @bind = ('nwiger', 'completed');
2263 To test against multiple values, just enclose the values in an arrayref:
2265 status => { '=', ['assigned', 'in-progress', 'pending'] };
2267 Which would give you:
2269 "WHERE status = ? OR status = ? OR status = ?"
2272 The hashref can also contain multiple pairs, in which case it is expanded
2273 into an C<AND> of its elements:
2277 status => { '!=', 'completed', -not_like => 'pending%' }
2280 # Or more dynamically, like from a form
2281 $where{user} = 'nwiger';
2282 $where{status}{'!='} = 'completed';
2283 $where{status}{'-not_like'} = 'pending%';
2285 # Both generate this
2286 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2287 @bind = ('nwiger', 'completed', 'pending%');
2290 To get an OR instead, you can combine it with the arrayref idea:
2294 priority => [ { '=', 2 }, { '>', 5 } ]
2297 Which would generate:
2299 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2300 @bind = ('2', '5', 'nwiger');
2302 If you want to include literal SQL (with or without bind values), just use a
2303 scalar reference or reference to an arrayref as the value:
2306 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2307 date_expires => { '<' => \"now()" }
2310 Which would generate:
2312 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2313 @bind = ('11/26/2008');
2316 =head2 Logic and nesting operators
2318 In the example above,
2319 there is a subtle trap if you want to say something like
2320 this (notice the C<AND>):
2322 WHERE priority != ? AND priority != ?
2324 Because, in Perl you I<can't> do this:
2326 priority => { '!=' => 2, '!=' => 1 }
2328 As the second C<!=> key will obliterate the first. The solution
2329 is to use the special C<-modifier> form inside an arrayref:
2331 priority => [ -and => {'!=', 2},
2335 Normally, these would be joined by C<OR>, but the modifier tells it
2336 to use C<AND> instead. (Hint: You can use this in conjunction with the
2337 C<logic> option to C<new()> in order to change the way your queries
2338 work by default.) B<Important:> Note that the C<-modifier> goes
2339 B<INSIDE> the arrayref, as an extra first element. This will
2340 B<NOT> do what you think it might:
2342 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2344 Here is a quick list of equivalencies, since there is some overlap:
2347 status => {'!=', 'completed', 'not like', 'pending%' }
2348 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2351 status => {'=', ['assigned', 'in-progress']}
2352 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2353 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2357 =head2 Special operators: IN, BETWEEN, etc.
2359 You can also use the hashref format to compare a list of fields using the
2360 C<IN> comparison operator, by specifying the list as an arrayref:
2363 status => 'completed',
2364 reportid => { -in => [567, 2335, 2] }
2367 Which would generate:
2369 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2370 @bind = ('completed', '567', '2335', '2');
2372 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2375 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2376 (by default: C<1=0>). Similarly, C<< -not_in => [] >> generates
2377 'sqltrue' (by default: C<1=1>).
2379 In addition to the array you can supply a chunk of literal sql or
2380 literal sql with bind:
2383 customer => { -in => \[
2384 'SELECT cust_id FROM cust WHERE balance > ?',
2387 status => { -in => \'SELECT status_codes FROM states' },
2393 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2394 AND status IN ( SELECT status_codes FROM states )
2398 Finally, if the argument to C<-in> is not a reference, it will be
2399 treated as a single-element array.
2401 Another pair of operators is C<-between> and C<-not_between>,
2402 used with an arrayref of two values:
2406 completion_date => {
2407 -not_between => ['2002-10-01', '2003-02-06']
2413 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2415 Just like with C<-in> all plausible combinations of literal SQL
2419 start0 => { -between => [ 1, 2 ] },
2420 start1 => { -between => \["? AND ?", 1, 2] },
2421 start2 => { -between => \"lower(x) AND upper(y)" },
2422 start3 => { -between => [
2424 \["upper(?)", 'stuff' ],
2431 ( start0 BETWEEN ? AND ? )
2432 AND ( start1 BETWEEN ? AND ? )
2433 AND ( start2 BETWEEN lower(x) AND upper(y) )
2434 AND ( start3 BETWEEN lower(x) AND upper(?) )
2436 @bind = (1, 2, 1, 2, 'stuff');
2439 These are the two builtin "special operators"; but the
2440 list can be expanded: see section L</"SPECIAL OPERATORS"> below.
2442 =head2 Unary operators: bool
2444 If you wish to test against boolean columns or functions within your
2445 database you can use the C<-bool> and C<-not_bool> operators. For
2446 example to test the column C<is_user> being true and the column
2447 C<is_enabled> being false you would use:-
2451 -not_bool => 'is_enabled',
2456 WHERE is_user AND NOT is_enabled
2458 If a more complex combination is required, testing more conditions,
2459 then you should use the and/or operators:-
2464 -not_bool => { two=> { -rlike => 'bar' } },
2465 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2476 (NOT ( three = ? OR three > ? ))
2479 =head2 Nested conditions, -and/-or prefixes
2481 So far, we've seen how multiple conditions are joined with a top-level
2482 C<AND>. We can change this by putting the different conditions we want in
2483 hashes and then putting those hashes in an array. For example:
2488 status => { -like => ['pending%', 'dispatched'] },
2492 status => 'unassigned',
2496 This data structure would create the following:
2498 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2499 OR ( user = ? AND status = ? ) )";
2500 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2503 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2504 to change the logic inside:
2510 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2511 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2518 $stmt = "WHERE ( user = ?
2519 AND ( ( workhrs > ? AND geo = ? )
2520 OR ( workhrs < ? OR geo = ? ) ) )";
2521 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2523 =head3 Algebraic inconsistency, for historical reasons
2525 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2526 operator goes C<outside> of the nested structure; whereas when connecting
2527 several constraints on one column, the C<-and> operator goes
2528 C<inside> the arrayref. Here is an example combining both features:
2531 -and => [a => 1, b => 2],
2532 -or => [c => 3, d => 4],
2533 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2538 WHERE ( ( ( a = ? AND b = ? )
2539 OR ( c = ? OR d = ? )
2540 OR ( e LIKE ? AND e LIKE ? ) ) )
2542 This difference in syntax is unfortunate but must be preserved for
2543 historical reasons. So be careful: the two examples below would
2544 seem algebraically equivalent, but they are not
2547 { -like => 'foo%' },
2548 { -like => '%bar' },
2550 # yields: WHERE ( ( col LIKE ? AND col LIKE ? ) )
2553 { col => { -like => 'foo%' } },
2554 { col => { -like => '%bar' } },
2556 # yields: WHERE ( ( col LIKE ? OR col LIKE ? ) )
2559 =head2 Literal SQL and value type operators
2561 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2562 side" is a column name and the "right side" is a value (normally rendered as
2563 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2564 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2565 alter this behavior. There are several ways of doing so.
2569 This is a virtual operator that signals the string to its right side is an
2570 identifier (a column name) and not a value. For example to compare two
2571 columns you would write:
2574 priority => { '<', 2 },
2575 requestor => { -ident => 'submitter' },
2580 $stmt = "WHERE priority < ? AND requestor = submitter";
2583 If you are maintaining legacy code you may see a different construct as
2584 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2589 This is a virtual operator that signals that the construct to its right side
2590 is a value to be passed to DBI. This is for example necessary when you want
2591 to write a where clause against an array (for RDBMS that support such
2592 datatypes). For example:
2595 array => { -value => [1, 2, 3] }
2600 $stmt = 'WHERE array = ?';
2601 @bind = ([1, 2, 3]);
2603 Note that if you were to simply say:
2609 the result would probably not be what you wanted:
2611 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2616 Finally, sometimes only literal SQL will do. To include a random snippet
2617 of SQL verbatim, you specify it as a scalar reference. Consider this only
2618 as a last resort. Usually there is a better way. For example:
2621 priority => { '<', 2 },
2622 requestor => { -in => \'(SELECT name FROM hitmen)' },
2627 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2630 Note that in this example, you only get one bind parameter back, since
2631 the verbatim SQL is passed as part of the statement.
2635 Never use untrusted input as a literal SQL argument - this is a massive
2636 security risk (there is no way to check literal snippets for SQL
2637 injections and other nastyness). If you need to deal with untrusted input
2638 use literal SQL with placeholders as described next.
2640 =head3 Literal SQL with placeholders and bind values (subqueries)
2642 If the literal SQL to be inserted has placeholders and bind values,
2643 use a reference to an arrayref (yes this is a double reference --
2644 not so common, but perfectly legal Perl). For example, to find a date
2645 in Postgres you can use something like this:
2648 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2653 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2656 Note that you must pass the bind values in the same format as they are returned
2657 by L<where|/where(\%where, $order)>. This means that if you set L</bindtype>
2658 to C<columns>, you must provide the bind values in the
2659 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2660 scalar value; most commonly the column name, but you can use any scalar value
2661 (including references and blessed references), L<SQL::Abstract> will simply
2662 pass it through intact. So if C<bindtype> is set to C<columns> the above
2663 example will look like:
2666 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2669 Literal SQL is especially useful for nesting parenthesized clauses in the
2670 main SQL query. Here is a first example:
2672 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2676 bar => \["IN ($sub_stmt)" => @sub_bind],
2681 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2682 WHERE c2 < ? AND c3 LIKE ?))";
2683 @bind = (1234, 100, "foo%");
2685 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2686 are expressed in the same way. Of course the C<$sub_stmt> and
2687 its associated bind values can be generated through a former call
2690 my ($sub_stmt, @sub_bind)
2691 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2692 c3 => {-like => "foo%"}});
2695 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2698 In the examples above, the subquery was used as an operator on a column;
2699 but the same principle also applies for a clause within the main C<%where>
2700 hash, like an EXISTS subquery:
2702 my ($sub_stmt, @sub_bind)
2703 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2704 my %where = ( -and => [
2706 \["EXISTS ($sub_stmt)" => @sub_bind],
2711 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2712 WHERE c1 = ? AND c2 > t0.c0))";
2716 Observe that the condition on C<c2> in the subquery refers to
2717 column C<t0.c0> of the main query: this is I<not> a bind
2718 value, so we have to express it through a scalar ref.
2719 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2720 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2721 what we wanted here.
2723 Finally, here is an example where a subquery is used
2724 for expressing unary negation:
2726 my ($sub_stmt, @sub_bind)
2727 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2728 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2730 lname => {like => '%son%'},
2731 \["NOT ($sub_stmt)" => @sub_bind],
2736 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2737 @bind = ('%son%', 10, 20)
2739 =head3 Deprecated usage of Literal SQL
2741 Below are some examples of archaic use of literal SQL. It is shown only as
2742 reference for those who deal with legacy code. Each example has a much
2743 better, cleaner and safer alternative that users should opt for in new code.
2749 my %where = ( requestor => \'IS NOT NULL' )
2751 $stmt = "WHERE requestor IS NOT NULL"
2753 This used to be the way of generating NULL comparisons, before the handling
2754 of C<undef> got formalized. For new code please use the superior syntax as
2755 described in L</Tests for NULL values>.
2759 my %where = ( requestor => \'= submitter' )
2761 $stmt = "WHERE requestor = submitter"
2763 This used to be the only way to compare columns. Use the superior L</-ident>
2764 method for all new code. For example an identifier declared in such a way
2765 will be properly quoted if L</quote_char> is properly set, while the legacy
2766 form will remain as supplied.
2770 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2772 $stmt = "WHERE completed > ? AND is_ready"
2773 @bind = ('2012-12-21')
2775 Using an empty string literal used to be the only way to express a boolean.
2776 For all new code please use the much more readable
2777 L<-bool|/Unary operators: bool> operator.
2783 These pages could go on for a while, since the nesting of the data
2784 structures this module can handle are pretty much unlimited (the
2785 module implements the C<WHERE> expansion as a recursive function
2786 internally). Your best bet is to "play around" with the module a
2787 little to see how the data structures behave, and choose the best
2788 format for your data based on that.
2790 And of course, all the values above will probably be replaced with
2791 variables gotten from forms or the command line. After all, if you
2792 knew everything ahead of time, you wouldn't have to worry about
2793 dynamically-generating SQL and could just hardwire it into your
2796 =head1 ORDER BY CLAUSES
2798 Some functions take an order by clause. This can either be a scalar (just a
2799 column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' }
2800 >>, a scalarref, an arrayref-ref, or an arrayref of any of the previous
2803 Given | Will Generate
2804 ---------------------------------------------------------------
2806 'colA' | ORDER BY colA
2808 [qw/colA colB/] | ORDER BY colA, colB
2810 {-asc => 'colA'} | ORDER BY colA ASC
2812 {-desc => 'colB'} | ORDER BY colB DESC
2814 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2816 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2818 \'colA DESC' | ORDER BY colA DESC
2820 \[ 'FUNC(colA, ?)', $x ] | ORDER BY FUNC(colA, ?)
2821 | /* ...with $x bound to ? */
2824 { -asc => 'colA' }, | colA ASC,
2825 { -desc => [qw/colB/] }, | colB DESC,
2826 { -asc => [qw/colC colD/] },| colC ASC, colD ASC,
2827 \'colE DESC', | colE DESC,
2828 \[ 'FUNC(colF, ?)', $x ], | FUNC(colF, ?)
2829 ] | /* ...with $x bound to ? */
2830 ===============================================================
2834 =head1 SPECIAL OPERATORS
2836 my $sqlmaker = SQL::Abstract->new(special_ops => [
2840 my ($self, $field, $op, $arg) = @_;
2846 handler => 'method_name',
2850 A "special operator" is a SQL syntactic clause that can be
2851 applied to a field, instead of a usual binary operator.
2854 WHERE field IN (?, ?, ?)
2855 WHERE field BETWEEN ? AND ?
2856 WHERE MATCH(field) AGAINST (?, ?)
2858 Special operators IN and BETWEEN are fairly standard and therefore
2859 are builtin within C<SQL::Abstract> (as the overridable methods
2860 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2861 like the MATCH .. AGAINST example above which is specific to MySQL,
2862 you can write your own operator handlers - supply a C<special_ops>
2863 argument to the C<new> method. That argument takes an arrayref of
2864 operator definitions; each operator definition is a hashref with two
2871 the regular expression to match the operator
2875 Either a coderef or a plain scalar method name. In both cases
2876 the expected return is C<< ($sql, @bind) >>.
2878 When supplied with a method name, it is simply called on the
2879 L<SQL::Abstract> object as:
2881 $self->$method_name($field, $op, $arg)
2885 $field is the LHS of the operator
2886 $op is the part that matched the handler regex
2889 When supplied with a coderef, it is called as:
2891 $coderef->($self, $field, $op, $arg)
2896 For example, here is an implementation
2897 of the MATCH .. AGAINST syntax for MySQL
2899 my $sqlmaker = SQL::Abstract->new(special_ops => [
2901 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2902 {regex => qr/^match$/i,
2904 my ($self, $field, $op, $arg) = @_;
2905 $arg = [$arg] if not ref $arg;
2906 my $label = $self->_quote($field);
2907 my ($placeholder) = $self->_convert('?');
2908 my $placeholders = join ", ", (($placeholder) x @$arg);
2909 my $sql = $self->_sqlcase('match') . " ($label) "
2910 . $self->_sqlcase('against') . " ($placeholders) ";
2911 my @bind = $self->_bindtype($field, @$arg);
2912 return ($sql, @bind);
2919 =head1 UNARY OPERATORS
2921 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2925 my ($self, $op, $arg) = @_;
2931 handler => 'method_name',
2935 A "unary operator" is a SQL syntactic clause that can be
2936 applied to a field - the operator goes before the field
2938 You can write your own operator handlers - supply a C<unary_ops>
2939 argument to the C<new> method. That argument takes an arrayref of
2940 operator definitions; each operator definition is a hashref with two
2947 the regular expression to match the operator
2951 Either a coderef or a plain scalar method name. In both cases
2952 the expected return is C<< $sql >>.
2954 When supplied with a method name, it is simply called on the
2955 L<SQL::Abstract> object as:
2957 $self->$method_name($op, $arg)
2961 $op is the part that matched the handler regex
2962 $arg is the RHS or argument of the operator
2964 When supplied with a coderef, it is called as:
2966 $coderef->($self, $op, $arg)
2974 Thanks to some benchmarking by Mark Stosberg, it turns out that
2975 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2976 I must admit this wasn't an intentional design issue, but it's a
2977 byproduct of the fact that you get to control your C<DBI> handles
2980 To maximize performance, use a code snippet like the following:
2982 # prepare a statement handle using the first row
2983 # and then reuse it for the rest of the rows
2985 for my $href (@array_of_hashrefs) {
2986 $stmt ||= $sql->insert('table', $href);
2987 $sth ||= $dbh->prepare($stmt);
2988 $sth->execute($sql->values($href));
2991 The reason this works is because the keys in your C<$href> are sorted
2992 internally by B<SQL::Abstract>. Thus, as long as your data retains
2993 the same structure, you only have to generate the SQL the first time
2994 around. On subsequent queries, simply use the C<values> function provided
2995 by this module to return your values in the correct order.
2997 However this depends on the values having the same type - if, for
2998 example, the values of a where clause may either have values
2999 (resulting in sql of the form C<column = ?> with a single bind
3000 value), or alternatively the values might be C<undef> (resulting in
3001 sql of the form C<column IS NULL> with no bind value) then the
3002 caching technique suggested will not work.
3006 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3007 really like this part (I do, at least). Building up a complex query
3008 can be as simple as the following:
3015 use CGI::FormBuilder;
3018 my $form = CGI::FormBuilder->new(...);
3019 my $sql = SQL::Abstract->new;
3021 if ($form->submitted) {
3022 my $field = $form->field;
3023 my $id = delete $field->{id};
3024 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3027 Of course, you would still have to connect using C<DBI> to run the
3028 query, but the point is that if you make your form look like your
3029 table, the actual query script can be extremely simplistic.
3031 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3032 a fast interface to returning and formatting data. I frequently
3033 use these three modules together to write complex database query
3034 apps in under 50 lines.
3036 =head1 HOW TO CONTRIBUTE
3038 Contributions are always welcome, in all usable forms (we especially
3039 welcome documentation improvements). The delivery methods include git-
3040 or unified-diff formatted patches, GitHub pull requests, or plain bug
3041 reports either via RT or the Mailing list. Contributors are generally
3042 granted full access to the official repository after their first several
3043 patches pass successful review.
3045 This project is maintained in a git repository. The code and related tools are
3046 accessible at the following locations:
3050 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3052 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3054 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3056 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3062 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3063 Great care has been taken to preserve the I<published> behavior
3064 documented in previous versions in the 1.* family; however,
3065 some features that were previously undocumented, or behaved
3066 differently from the documentation, had to be changed in order
3067 to clarify the semantics. Hence, client code that was relying
3068 on some dark areas of C<SQL::Abstract> v1.*
3069 B<might behave differently> in v1.50.
3071 The main changes are:
3077 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3081 support for the { operator => \"..." } construct (to embed literal SQL)
3085 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3089 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3093 defensive programming: check arguments
3097 fixed bug with global logic, which was previously implemented
3098 through global variables yielding side-effects. Prior versions would
3099 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3100 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3101 Now this is interpreted
3102 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3107 fixed semantics of _bindtype on array args
3111 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3112 we just avoid shifting arrays within that tree.
3116 dropped the C<_modlogic> function
3120 =head1 ACKNOWLEDGEMENTS
3122 There are a number of individuals that have really helped out with
3123 this module. Unfortunately, most of them submitted bugs via CPAN
3124 so I have no idea who they are! But the people I do know are:
3126 Ash Berlin (order_by hash term support)
3127 Matt Trout (DBIx::Class support)
3128 Mark Stosberg (benchmarking)
3129 Chas Owens (initial "IN" operator support)
3130 Philip Collins (per-field SQL functions)
3131 Eric Kolve (hashref "AND" support)
3132 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3133 Dan Kubb (support for "quote_char" and "name_sep")
3134 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3135 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3136 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3137 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3138 Oliver Charles (support for "RETURNING" after "INSERT")
3144 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3148 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3150 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3152 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3153 While not an official support venue, C<DBIx::Class> makes heavy use of
3154 C<SQL::Abstract>, and as such list members there are very familiar with
3155 how to create queries.
3159 This module is free software; you may copy this under the same
3160 terms as perl itself (either the GNU General Public License or
3161 the Artistic License)