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/^ ident $/ix, handler => sub { die "NOPE" }},
43 {regex => qr/^ value $/ix, handler => sub { die "NOPE" }},
44 {regex => qr/^ is (?: \s+ not )? $/ix, handler => sub { die "NOPE" }},
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' },
56 { regex => qr/^ op $/xi, handler => '_where_op_OP' },
57 { regex => qr/^ bind $/xi, handler => '_where_op_BIND' },
58 { regex => qr/^ literal $/xi, handler => '_where_op_LITERAL' },
59 { regex => qr/^ func $/xi, handler => '_where_op_FUNC' },
62 #======================================================================
63 # DEBUGGING AND ERROR REPORTING
64 #======================================================================
67 return unless $_[0]->{debug}; shift; # a little faster
68 my $func = (caller(1))[3];
69 warn "[$func] ", @_, "\n";
73 my($func) = (caller(1))[3];
74 Carp::carp "[$func] Warning: ", @_;
78 my($func) = (caller(1))[3];
79 Carp::croak "[$func] Fatal: ", @_;
82 sub is_literal_value ($) {
83 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
84 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
88 # FIXME XSify - this can be done so much more efficiently
89 sub is_plain_value ($) {
91 ! length ref $_[0] ? \($_[0])
93 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
95 exists $_[0]->{-value}
96 ) ? \($_[0]->{-value})
98 # reuse @_ for even moar speedz
99 defined ( $_[1] = Scalar::Util::blessed $_[0] )
101 # deliberately not using Devel::OverloadInfo - the checks we are
102 # intersted in are much more limited than the fullblown thing, and
103 # this is a very hot piece of code
105 # simply using ->can('(""') can leave behind stub methods that
106 # break actually using the overload later (see L<perldiag/Stub
107 # found while resolving method "%s" overloading "%s" in package
108 # "%s"> and the source of overload::mycan())
110 # either has stringification which DBI SHOULD prefer out of the box
111 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
113 # has nummification or boolification, AND fallback is *not* disabled
115 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
118 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
120 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
124 # no fallback specified at all
125 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
127 # fallback explicitly undef
128 ! defined ${"$_[3]::()"}
141 #======================================================================
143 #======================================================================
147 my $class = ref($self) || $self;
148 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
150 # choose our case by keeping an option around
151 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
153 # default logic for interpreting arrayrefs
154 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
156 # how to return bind vars
157 $opt{bindtype} ||= 'normal';
159 # default comparison is "=", but can be overridden
162 # try to recognize which are the 'equality' and 'inequality' ops
163 # (temporary quickfix (in 2007), should go through a more seasoned API)
164 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
165 $opt{inequality_op} = qr/^( != | <> )$/ix;
167 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
168 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
171 $opt{sqltrue} ||= '1=1';
172 $opt{sqlfalse} ||= '0=1';
175 $opt{user_special_ops} = [ @{$opt{special_ops} ||= []} ];
176 # regexes are applied in order, thus push after user-defines
177 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
180 $opt{unary_ops} ||= [];
181 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
183 # rudimentary sanity-check for user supplied bits treated as functions/operators
184 # If a purported function matches this regular expression, an exception is thrown.
185 # Literal SQL is *NOT* subject to this check, only functions (and column names
186 # when quoting is not in effect)
189 # need to guard against ()'s in column names too, but this will break tons of
190 # hacks... ideas anyone?
191 $opt{injection_guard} ||= qr/
197 return bless \%opt, $class;
200 sub sqltrue { +{ -literal => [ $_[0]->{sqltrue} ] } }
201 sub sqlfalse { +{ -literal => [ $_[0]->{sqlfalse} ] } }
203 sub _assert_pass_injection_guard {
204 if ($_[1] =~ $_[0]->{injection_guard}) {
205 my $class = ref $_[0];
206 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
207 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
208 . "{injection_guard} attribute to ${class}->new()"
213 #======================================================================
215 #======================================================================
219 my $table = $self->_table(shift);
220 my $data = shift || return;
223 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
224 my ($sql, @bind) = $self->$method($data);
225 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
227 if ($options->{returning}) {
228 my ($s, @b) = $self->_insert_returning($options);
233 return wantarray ? ($sql, @bind) : $sql;
236 # So that subclasses can override INSERT ... RETURNING separately from
237 # UPDATE and DELETE (e.g. DBIx::Class::SQLMaker::Oracle does this)
238 sub _insert_returning { shift->_returning(@_) }
241 my ($self, $options) = @_;
243 my $f = $options->{returning};
245 my $fieldlist = $self->_SWITCH_refkind($f, {
246 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
247 SCALAR => sub {$self->_quote($f)},
248 SCALARREF => sub {$$f},
250 return $self->_sqlcase(' returning ') . $fieldlist;
253 sub _insert_HASHREF { # explicit list of fields and then values
254 my ($self, $data) = @_;
256 my @fields = sort keys %$data;
258 my ($sql, @bind) = $self->_insert_values($data);
261 $_ = $self->_quote($_) foreach @fields;
262 $sql = "( ".join(", ", @fields).") ".$sql;
264 return ($sql, @bind);
267 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
268 my ($self, $data) = @_;
270 # no names (arrayref) so can't generate bindtype
271 $self->{bindtype} ne 'columns'
272 or belch "can't do 'columns' bindtype when called with arrayref";
274 my (@values, @all_bind);
275 foreach my $value (@$data) {
276 my ($values, @bind) = $self->_insert_value(undef, $value);
277 push @values, $values;
278 push @all_bind, @bind;
280 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
281 return ($sql, @all_bind);
284 sub _insert_ARRAYREFREF { # literal SQL with bind
285 my ($self, $data) = @_;
287 my ($sql, @bind) = @${$data};
288 $self->_assert_bindval_matches_bindtype(@bind);
290 return ($sql, @bind);
294 sub _insert_SCALARREF { # literal SQL without bind
295 my ($self, $data) = @_;
301 my ($self, $data) = @_;
303 my (@values, @all_bind);
304 foreach my $column (sort keys %$data) {
305 my ($values, @bind) = $self->_insert_value($column, $data->{$column});
306 push @values, $values;
307 push @all_bind, @bind;
309 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
310 return ($sql, @all_bind);
314 my ($self, $column, $v) = @_;
316 my (@values, @all_bind);
317 $self->_SWITCH_refkind($v, {
320 if ($self->{array_datatypes}) { # if array datatype are activated
322 push @all_bind, $self->_bindtype($column, $v);
324 else { # else literal SQL with bind
325 my ($sql, @bind) = @$v;
326 $self->_assert_bindval_matches_bindtype(@bind);
328 push @all_bind, @bind;
332 ARRAYREFREF => sub { # literal SQL with bind
333 my ($sql, @bind) = @${$v};
334 $self->_assert_bindval_matches_bindtype(@bind);
336 push @all_bind, @bind;
339 # THINK: anything useful to do with a HASHREF ?
340 HASHREF => sub { # (nothing, but old SQLA passed it through)
341 #TODO in SQLA >= 2.0 it will die instead
342 belch "HASH ref as bind value in insert is not supported";
344 push @all_bind, $self->_bindtype($column, $v);
347 SCALARREF => sub { # literal SQL without bind
351 SCALAR_or_UNDEF => sub {
353 push @all_bind, $self->_bindtype($column, $v);
358 my $sql = join(", ", @values);
359 return ($sql, @all_bind);
364 #======================================================================
366 #======================================================================
371 my $table = $self->_table(shift);
372 my $data = shift || return;
376 # first build the 'SET' part of the sql statement
377 puke "Unsupported data type specified to \$sql->update"
378 unless ref $data eq 'HASH';
380 my ($sql, @all_bind) = $self->_update_set_values($data);
381 $sql = $self->_sqlcase('update ') . $table . $self->_sqlcase(' set ')
385 my($where_sql, @where_bind) = $self->where($where);
387 push @all_bind, @where_bind;
390 if ($options->{returning}) {
391 my ($returning_sql, @returning_bind) = $self->_update_returning($options);
392 $sql .= $returning_sql;
393 push @all_bind, @returning_bind;
396 return wantarray ? ($sql, @all_bind) : $sql;
399 sub _update_set_values {
400 my ($self, $data) = @_;
402 my (@set, @all_bind);
403 for my $k (sort keys %$data) {
406 my $label = $self->_quote($k);
408 $self->_SWITCH_refkind($v, {
410 if ($self->{array_datatypes}) { # array datatype
411 push @set, "$label = ?";
412 push @all_bind, $self->_bindtype($k, $v);
414 else { # literal SQL with bind
415 my ($sql, @bind) = @$v;
416 $self->_assert_bindval_matches_bindtype(@bind);
417 push @set, "$label = $sql";
418 push @all_bind, @bind;
421 ARRAYREFREF => sub { # literal SQL with bind
422 my ($sql, @bind) = @${$v};
423 $self->_assert_bindval_matches_bindtype(@bind);
424 push @set, "$label = $sql";
425 push @all_bind, @bind;
427 SCALARREF => sub { # literal SQL without bind
428 push @set, "$label = $$v";
431 my ($op, $arg, @rest) = %$v;
433 puke 'Operator calls in update must be in the form { -op => $arg }'
434 if (@rest or not $op =~ /^\-(.+)/);
436 local $self->{_nested_func_lhs} = $k;
437 my ($sql, @bind) = $self->_where_unary_op($1, $arg);
439 push @set, "$label = $sql";
440 push @all_bind, @bind;
442 SCALAR_or_UNDEF => sub {
443 push @set, "$label = ?";
444 push @all_bind, $self->_bindtype($k, $v);
450 my $sql = join ', ', @set;
452 return ($sql, @all_bind);
455 # So that subclasses can override UPDATE ... RETURNING separately from
457 sub _update_returning { shift->_returning(@_) }
461 #======================================================================
463 #======================================================================
468 my $table = $self->_table(shift);
469 my $fields = shift || '*';
473 my ($fields_sql, @bind) = $self->_select_fields($fields);
475 my ($where_sql, @where_bind) = $self->where($where, $order);
476 push @bind, @where_bind;
478 my $sql = join(' ', $self->_sqlcase('select'), $fields_sql,
479 $self->_sqlcase('from'), $table)
482 return wantarray ? ($sql, @bind) : $sql;
486 my ($self, $fields) = @_;
487 return ref $fields eq 'ARRAY' ? join ', ', map { $self->_quote($_) } @$fields
491 #======================================================================
493 #======================================================================
498 my $table = $self->_table(shift);
502 my($where_sql, @bind) = $self->where($where);
503 my $sql = $self->_sqlcase('delete from ') . $table . $where_sql;
505 if ($options->{returning}) {
506 my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
507 $sql .= $returning_sql;
508 push @bind, @returning_bind;
511 return wantarray ? ($sql, @bind) : $sql;
514 # So that subclasses can override DELETE ... RETURNING separately from
516 sub _delete_returning { shift->_returning(@_) }
520 #======================================================================
522 #======================================================================
526 # Finally, a separate routine just to handle WHERE clauses
528 my ($self, $where, $order) = @_;
531 my ($sql, @bind) = defined($where)
532 ? $self->_recurse_where($where)
534 $sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
538 my ($order_sql, @order_bind) = $self->_order_by($order);
540 push @bind, @order_bind;
543 return wantarray ? ($sql, @bind) : $sql;
547 my ($self, $expr, $logic) = @_;
548 return undef unless defined($expr);
549 if (ref($expr) eq 'HASH') {
550 if (keys %$expr > 1) {
554 map $self->_expand_expr_hashpair($_ => $expr->{$_}, $logic),
558 return unless %$expr;
559 return $self->_expand_expr_hashpair(%$expr, $logic);
561 if (ref($expr) eq 'ARRAY') {
562 my $logic = lc($logic || $self->{logic});
563 $logic eq 'and' or $logic eq 'or' or puke "unknown logic: $logic";
569 while (my ($el) = splice @expr, 0, 1) {
570 puke "Supplying an empty left hand side argument is not supported in array-pairs"
571 unless defined($el) and length($el);
572 my $elref = ref($el);
574 push(@res, $self->_expand_expr({ $el, shift(@expr) }));
575 } elsif ($elref eq 'ARRAY') {
576 push(@res, $self->_expand_expr($el)) if @$el;
577 } elsif (my $l = is_literal_value($el)) {
578 push @res, { -literal => $l };
579 } elsif ($elref eq 'HASH') {
580 push @res, $self->_expand_expr($el);
585 return { -op => [ $logic, @res ] };
587 if (my $literal = is_literal_value($expr)) {
588 return +{ -literal => $literal };
590 if (!ref($expr) or Scalar::Util::blessed($expr)) {
591 if (my $m = our $Cur_Col_Meta) {
592 return +{ -bind => [ $m, $expr ] };
594 return +{ -value => $expr };
599 sub _expand_expr_hashpair {
600 my ($self, $k, $v, $logic) = @_;
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 $self->_assert_pass_injection_guard($k =~ /^-(.*)$/s);
610 if ($k =~ s/ [_\s]? \d+ $//x ) {
611 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
612 . "You probably wanted ...-and => [ $k => COND1, $k => COND2 ... ]";
615 return $self->_expand_expr($v);
619 return $self->_expand_expr($v);
621 puke "-bool => undef not supported" unless defined($v);
622 return { -ident => $v };
625 return { -op => [ 'not', $self->_expand_expr($v) ] };
627 if (my ($rest) = $k =~/^-not[_ ](.*)$/) {
630 $self->_expand_expr_hashpair("-${rest}", $v, $logic)
633 if (my ($logic) = $k =~ /^-(and|or)$/i) {
634 if (ref($v) eq 'HASH') {
635 return $self->_expand_expr($v, $logic);
637 if (ref($v) eq 'ARRAY') {
638 return $self->_expand_expr($v, $logic);
643 $op =~ s/^-// if length($op) > 1;
645 # top level special ops are illegal in general
646 puke "Illegal use of top-level '-$op'"
647 if !(defined $self->{_nested_func_lhs})
648 and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
649 and not List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}};
651 if ($k eq '-value' and my $m = our $Cur_Col_Meta) {
652 return +{ -bind => [ $m, $v ] };
654 if ($k eq '-op' or $k eq '-ident' or $k eq '-value' or $k eq '-bind' or $k eq '-literal' or $k eq '-func') {
660 and (keys %$v)[0] =~ /^-/
662 my ($func) = $k =~ /^-(.*)$/;
663 return +{ -func => [ $func, $self->_expand_expr($v) ] };
665 if (!ref($v) or is_literal_value($v)) {
666 return +{ -op => [ $k =~ /^-(.*)$/, $self->_expand_expr($v) ] };
673 and exists $v->{-value}
674 and not defined $v->{-value}
677 return $self->_expand_expr_hashpair($k => { $self->{cmp} => undef });
679 if (!ref($v) or Scalar::Util::blessed($v)) {
684 { -bind => [ $k, $v ] }
688 if (ref($v) eq 'HASH') {
692 map $self->_expand_expr_hashpair($k => { $_ => $v->{$_} }),
699 $self->_assert_pass_injection_guard($vk);
700 if ($vk =~ s/ [_\s]? \d+ $//x ) {
701 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
702 . "You probably wanted ...-and => [ -$vk => COND1, -$vk => COND2 ... ]";
704 if ($vk =~ /^(?:not[ _])?between$/) {
705 local our $Cur_Col_Meta = $k;
706 my @rhs = map $self->_expand_expr($_),
707 ref($vv) eq 'ARRAY' ? @$vv : $vv;
709 (@rhs == 1 and ref($rhs[0]) eq 'HASH' and $rhs[0]->{-literal})
711 (@rhs == 2 and defined($rhs[0]) and defined($rhs[1]))
713 puke "Operator '${\uc($vk)}' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
716 join(' ', split '_', $vk),
721 if ($vk =~ /^(?:not[ _])?in$/) {
722 if (my $literal = is_literal_value($vv)) {
723 my ($sql, @bind) = @$literal;
724 my $opened_sql = $self->_open_outer_paren($sql);
726 $vk, { -ident => $k },
727 [ { -literal => [ $opened_sql, @bind ] } ]
731 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
732 . "-${\uc($vk)} operator was given an undef-containing list: !!!AUDIT YOUR CODE "
733 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
734 . 'will emit the logically correct SQL instead of raising this exception)'
736 puke("Argument passed to the '${\uc($vk)}' operator can not be undefined")
738 my @rhs = map $self->_expand_expr($_),
739 map { ref($_) ? $_ : { -bind => [ $k, $_ ] } }
740 map { defined($_) ? $_: puke($undef_err) }
741 (ref($vv) eq 'ARRAY' ? @$vv : $vv);
742 return $self->${\($vk =~ /^not/ ? 'sqltrue' : 'sqlfalse')} unless @rhs;
745 join(' ', split '_', $vk),
750 if ($vk eq 'ident') {
751 if (! defined $vv or ref $vv) {
752 puke "-$vk requires a single plain scalar argument (a quotable identifier)";
760 if ($vk eq 'value') {
761 return $self->_expand_expr_hashpair($k, undef) unless defined($vv);
765 { -bind => [ $k, $vv ] }
768 if ($vk =~ /^is(?:[ _]not)?$/) {
769 puke "$vk can only take undef as argument"
773 and exists($vv->{-value})
774 and !defined($vv->{-value})
777 return +{ -op => [ $vk.' null', { -ident => $k } ] };
779 if ($vk =~ /^(and|or)$/) {
780 if (ref($vv) eq 'HASH') {
783 map $self->_expand_expr_hashpair($k, { $_ => $vv->{$_} }),
788 if (my $us = List::Util::first { $vk =~ $_->{regex} } @{$self->{user_special_ops}}) {
789 return { -op => [ $vk, { -ident => $k }, $vv ] };
791 if (ref($vv) eq 'ARRAY') {
792 my ($logic, @values) = (
793 (defined($vv->[0]) and $vv->[0] =~ /^-(and|or)$/i)
798 $vk =~ $self->{inequality_op}
799 or join(' ', split '_', $vk) =~ $self->{not_like_op}
801 if (lc($logic) eq '-or' and @values > 1) {
802 my $op = uc join ' ', split '_', $vk;
803 belch "A multi-element arrayref as an argument to the inequality op '$op' "
804 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
805 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
810 # try to DWIM on equality operators
811 my $op = join ' ', split '_', $vk;
813 $op =~ $self->{equality_op} ? $self->sqlfalse
814 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqlfalse
815 : $op =~ $self->{inequality_op} ? $self->sqltrue
816 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqltrue
817 : puke "operator '$op' applied on an empty array (field '$k')";
821 map $self->_expand_expr_hashpair($k => { $vk => $_ }),
829 and exists $vv->{-value}
830 and not defined $vv->{-value}
833 my $op = join ' ', split '_', $vk;
835 $op =~ /^not$/i ? 'is not' # legacy
836 : $op =~ $self->{equality_op} ? 'is'
837 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
838 : $op =~ $self->{inequality_op} ? 'is not'
839 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
840 : puke "unexpected operator '$op' with undef operand";
841 return +{ -op => [ $is.' null', { -ident => $k } ] };
843 local our $Cur_Col_Meta = $k;
847 $self->_expand_expr($vv)
850 if (ref($v) eq 'ARRAY') {
851 return $self->sqlfalse unless @$v;
852 $self->_debug("ARRAY($k) means distribute over elements");
854 $v->[0] =~ /^-((?:and|or))$/i
855 ? ($v = [ @{$v}[1..$#$v] ], $1)
856 : ($self->{logic} || 'or')
860 map $self->_expand_expr({ $k => $_ }, $this_logic), @$v
863 if (my $literal = is_literal_value($v)) {
865 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
868 my ($sql, @bind) = @$literal;
869 if ($self->{bindtype} eq 'columns') {
871 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
872 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
876 return +{ -literal => [ $self->_quote($k).' '.$sql, @bind ] };
882 my ($self, $expr) = @_;
883 my ($k, $v, @rest) = %$expr;
885 my %op = map +("-$_" => '_where_op_'.uc($_)),
886 qw(op func value bind ident literal);
887 if (my $meth = $op{$k}) {
888 return $self->$meth(undef, $v);
890 die "notreached: $k";
894 my ($self, $where, $logic) = @_;
896 #print STDERR Data::Dumper::Concise::Dumper([ $where, $logic ]);
898 my $where_exp = $self->_expand_expr($where, $logic);
900 #print STDERR Data::Dumper::Concise::Dumper([ EXP => $where_exp ]);
902 # dispatch on appropriate method according to refkind of $where
903 # my $method = $self->_METHOD_FOR_refkind("_where", $where_exp);
905 # my ($sql, @bind) = $self->$method($where_exp, $logic);
907 my ($sql, @bind) = defined($where_exp) ? $self->_render_expr($where_exp) : (undef);
909 # DBIx::Class used to call _recurse_where in scalar context
910 # something else might too...
912 return ($sql, @bind);
915 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
922 #======================================================================
923 # WHERE: top-level ARRAYREF
924 #======================================================================
927 sub _where_ARRAYREF {
928 my ($self, $where, $logic) = @_;
930 $logic = uc($logic || $self->{logic});
931 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
933 my @clauses = @$where;
935 my (@sql_clauses, @all_bind);
936 # need to use while() so can shift() for pairs
938 my $el = shift @clauses;
940 $el = undef if (defined $el and ! length $el);
942 # switch according to kind of $el and get corresponding ($sql, @bind)
943 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
945 # skip empty elements, otherwise get invalid trailing AND stuff
946 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
950 $self->_assert_bindval_matches_bindtype(@b);
954 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
956 SCALARREF => sub { ($$el); },
959 # top-level arrayref with scalars, recurse in pairs
960 $self->_recurse_where({$el => shift(@clauses)})
963 UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
967 push @sql_clauses, $sql;
968 push @all_bind, @bind;
972 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
975 #======================================================================
976 # WHERE: top-level ARRAYREFREF
977 #======================================================================
979 sub _where_ARRAYREFREF {
980 my ($self, $where) = @_;
981 my ($sql, @bind) = @$$where;
982 $self->_assert_bindval_matches_bindtype(@bind);
983 return ($sql, @bind);
986 #======================================================================
987 # WHERE: top-level HASHREF
988 #======================================================================
991 my ($self, $where) = @_;
992 my (@sql_clauses, @all_bind);
994 for my $k (sort keys %$where) {
995 my $v = $where->{$k};
997 # ($k => $v) is either a special unary op or a regular hashpair
998 my ($sql, @bind) = do {
1000 # put the operator in canonical form
1002 $op = substr $op, 1; # remove initial dash
1003 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
1004 $op =~ s/\s+/ /g; # compress whitespace
1006 # so that -not_foo works correctly
1007 $op =~ s/^not_/NOT /i;
1009 $self->_debug("Unary OP(-$op) within hashref, recursing...");
1010 my ($s, @b) = $self->_where_unary_op($op, $v);
1012 # top level vs nested
1013 # we assume that handled unary ops will take care of their ()s
1014 $s = "($s)" unless (
1015 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
1017 ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
1023 if (is_literal_value ($v) ) {
1024 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
1027 puke "Supplying an empty left hand side argument is not supported in hash-pairs";
1031 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
1032 $self->$method($k, $v);
1036 push @sql_clauses, $sql;
1037 push @all_bind, @bind;
1040 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
1043 sub _where_unary_op {
1044 my ($self, $op, $rhs) = @_;
1046 $op =~ s/^-// if length($op) > 1;
1048 # top level special ops are illegal in general
1049 puke "Illegal use of top-level '-$op'"
1050 if !(defined $self->{_nested_func_lhs})
1051 and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
1052 and not List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}};
1054 if (my $op_entry = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
1055 my $handler = $op_entry->{handler};
1057 if (not ref $handler) {
1058 if ($op =~ s/ [_\s]? \d+ $//x ) {
1059 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
1060 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
1062 return $self->$handler($op, $rhs);
1064 elsif (ref $handler eq 'CODE') {
1065 return $handler->($self, $op, $rhs);
1068 puke "Illegal handler for operator $op - expecting a method name or a coderef";
1072 $self->_debug("Generic unary OP: $op - recursing as function");
1074 $self->_assert_pass_injection_guard($op);
1076 my ($sql, @bind) = $self->_SWITCH_refkind($rhs, {
1078 puke "Illegal use of top-level '-$op'"
1079 unless defined $self->{_nested_func_lhs};
1082 $self->_convert('?'),
1083 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
1087 $self->_recurse_where($rhs)
1091 $sql = sprintf('%s %s',
1092 $self->_sqlcase($op),
1096 return ($sql, @bind);
1099 sub _where_op_ANDOR {
1100 my ($self, $op, $v) = @_;
1102 $self->_SWITCH_refkind($v, {
1104 return $self->_where_ARRAYREF($v, $op);
1108 return ($op =~ /^or/i)
1109 ? $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], $op)
1110 : $self->_where_HASHREF($v);
1114 puke "-$op => \\\$scalar makes little sense, use " .
1116 ? '[ \$scalar, \%rest_of_conditions ] instead'
1117 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
1121 ARRAYREFREF => sub {
1122 puke "-$op => \\[...] makes little sense, use " .
1124 ? '[ \[...], \%rest_of_conditions ] instead'
1125 : '-and => [ \[...], \%rest_of_conditions ] instead'
1129 SCALAR => sub { # permissively interpreted as SQL
1130 puke "-$op => \$value makes little sense, use -bool => \$value instead";
1134 puke "-$op => undef not supported";
1139 sub _where_op_NEST {
1140 my ($self, $op, $v) = @_;
1142 $self->_SWITCH_refkind($v, {
1144 SCALAR => sub { # permissively interpreted as SQL
1145 belch "literal SQL should be -nest => \\'scalar' "
1146 . "instead of -nest => 'scalar' ";
1151 puke "-$op => undef not supported";
1155 $self->_recurse_where($v);
1162 sub _where_op_BOOL {
1163 my ($self, $op, $v) = @_;
1165 my ($s, @b) = $self->_SWITCH_refkind($v, {
1166 SCALAR => sub { # interpreted as SQL column
1167 $self->_convert($self->_quote($v));
1171 puke "-$op => undef not supported";
1175 $self->_recurse_where($v);
1179 $s = "(NOT $s)" if $op =~ /^not/i;
1184 sub _where_op_IDENT {
1186 my ($op, $rhs) = splice @_, -2;
1187 if (! defined $rhs or length ref $rhs) {
1188 puke "-$op requires a single plain scalar argument (a quotable identifier)";
1191 # in case we are called as a top level special op (no '=')
1192 my $has_lhs = my $lhs = shift;
1194 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
1202 sub _where_op_VALUE {
1204 my ($op, $rhs) = splice @_, -2;
1206 # in case we are called as a top level special op (no '=')
1210 if (! defined $rhs) {
1212 ? $self->_where_hashpair_HASHREF($lhs, { -is => undef })
1219 (defined $lhs ? $lhs : $self->{_nested_func_lhs}),
1226 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
1230 $self->_convert('?'),
1237 my %unop_postfix = map +($_ => 1), 'is null', 'is not null';
1243 my ($self, $args) = @_;
1244 my ($left, $low, $high) = @$args;
1245 my ($rhsql, @rhbind) = do {
1247 puke "Single arg to between must be a literal"
1248 unless $low->{-literal};
1251 local $self->{_nested_func_lhs} = $left->{-ident}
1252 if ref($left) eq 'HASH' and $left->{-ident};
1253 my ($l, $h) = map [ $self->_where_unary_op(%$_) ], $low, $high;
1254 (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
1255 @{$l}[1..$#$l], @{$h}[1..$#$h])
1258 my ($lhsql, @lhbind) = $self->_recurse_where($left);
1260 join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
1264 }), 'between', 'not between'),
1268 my ($self, $args) = @_;
1269 my ($lhs, $rhs) = @$args;
1272 local $self->{_nested_func_lhs} = $lhs->{-ident}
1273 if ref($lhs) eq 'HASH' and $lhs->{-ident};
1274 my ($sql, @bind) = $self->_where_unary_op(%$_);
1275 push @in_bind, @bind;
1278 my ($lhsql, @lbind) = $self->_recurse_where($lhs);
1280 $lhsql.' '.$self->_sqlcase($op).' ( '
1281 .join(', ', @in_sql)
1286 }), 'in', 'not in'),
1290 my ($self, undef, $v) = @_;
1291 my ($op, @args) = @$v;
1292 $op =~ s/^-// if length($op) > 1;
1294 local $self->{_nested_func_lhs};
1295 if (my $h = $special{$op}) {
1296 return $self->$h(\@args);
1298 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{user_special_ops}}) {
1299 puke "Special op '${op}' requires first value to be identifier"
1300 unless my ($k) = map $_->{-ident}, grep ref($_) eq 'HASH', $args[0];
1301 return $self->${\($us->{handler})}($k, $op, $args[1]);
1303 my $final_op = $op =~ /^(?:is|not)_/ ? join(' ', split '_', $op) : $op;
1304 if (@args == 1 and $op !~ /^(and|or)$/) {
1305 my ($expr_sql, @bind) = $self->_render_expr($args[0]);
1306 my $op_sql = $self->_sqlcase($final_op);
1308 $unop_postfix{lc($final_op)}
1309 ? "${expr_sql} ${op_sql}"
1310 : "${op_sql} ${expr_sql}"
1312 return (($op eq 'not' ? '('.$final_sql.')' : $final_sql), @bind);
1314 my @parts = map [ $self->_render_expr($_) ], @args;
1315 my ($final_sql) = map +($op =~ /^(and|or)$/ ? "(${_})" : $_), join(
1316 ' '.$self->_sqlcase($final_op).' ',
1321 map @{$_}[1..$#$_], @parts
1327 sub _where_op_FUNC {
1328 my ($self, undef, $rest) = @_;
1329 my ($func, @args) = @$rest;
1333 push @arg_sql, shift @x;
1335 } map [ $self->_recurse_where($_) ], @args;
1336 return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
1339 sub _where_op_BIND {
1340 my ($self, undef, $bind) = @_;
1341 return ($self->_convert('?'), $self->_bindtype(@$bind));
1344 sub _where_op_LITERAL {
1345 my ($self, undef, $literal) = @_;
1346 $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
1350 sub _where_hashpair_ARRAYREF {
1351 my ($self, $k, $v) = @_;
1354 my @v = @$v; # need copy because of shift below
1355 $self->_debug("ARRAY($k) means distribute over elements");
1357 # put apart first element if it is an operator (-and, -or)
1359 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
1363 my @distributed = map { {$k => $_} } @v;
1366 $self->_debug("OP($op) reinjected into the distributed array");
1367 unshift @distributed, $op;
1370 my $logic = $op ? substr($op, 1) : '';
1372 return $self->_recurse_where(\@distributed, $logic);
1375 $self->_debug("empty ARRAY($k) means 0=1");
1376 return ($self->{sqlfalse});
1380 sub _where_hashpair_HASHREF {
1381 my ($self, $k, $v, $logic) = @_;
1384 local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
1385 ? $self->{_nested_func_lhs}
1389 my ($all_sql, @all_bind);
1391 for my $orig_op (sort keys %$v) {
1392 my $val = $v->{$orig_op};
1394 # put the operator in canonical form
1397 # FIXME - we need to phase out dash-less ops
1398 $op =~ s/^-//; # remove possible initial dash
1399 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
1400 $op =~ s/\s+/ /g; # compress whitespace
1402 $self->_assert_pass_injection_guard($op);
1405 $op =~ s/^is_not/IS NOT/i;
1407 # so that -not_foo works correctly
1408 $op =~ s/^not_/NOT /i;
1410 # another retarded special case: foo => { $op => { -value => undef } }
1411 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
1417 # CASE: col-value logic modifiers
1418 if ($orig_op =~ /^ \- (and|or) $/xi) {
1419 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
1421 # CASE: special operators like -in or -between
1422 elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
1423 my $handler = $special_op->{handler};
1425 puke "No handler supplied for special operator $orig_op";
1427 elsif (not ref $handler) {
1428 ($sql, @bind) = $self->$handler($k, $op, $val);
1430 elsif (ref $handler eq 'CODE') {
1431 ($sql, @bind) = $handler->($self, $k, $op, $val);
1434 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
1438 $self->_SWITCH_refkind($val, {
1440 ARRAYREF => sub { # CASE: col => {op => \@vals}
1441 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
1444 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
1445 my ($sub_sql, @sub_bind) = @$$val;
1446 $self->_assert_bindval_matches_bindtype(@sub_bind);
1447 $sql = join ' ', $self->_convert($self->_quote($k)),
1448 $self->_sqlcase($op),
1453 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
1455 $op =~ /^not$/i ? 'is not' # legacy
1456 : $op =~ $self->{equality_op} ? 'is'
1457 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
1458 : $op =~ $self->{inequality_op} ? 'is not'
1459 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
1460 : puke "unexpected operator '$orig_op' with undef operand";
1462 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
1465 FALLBACK => sub { # CASE: col => {op/func => $stuff}
1466 ($sql, @bind) = $self->_where_unary_op($op, $val);
1469 $self->_convert($self->_quote($k)),
1470 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
1476 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
1477 push @all_bind, @bind;
1479 return ($all_sql, @all_bind);
1482 sub _where_field_IS {
1483 my ($self, $k, $op, $v) = @_;
1485 my ($s) = $self->_SWITCH_refkind($v, {
1488 $self->_convert($self->_quote($k)),
1489 map { $self->_sqlcase($_)} ($op, 'null')
1492 puke "$op can only take undef as argument";
1499 sub _where_field_op_ARRAYREF {
1500 my ($self, $k, $op, $vals) = @_;
1502 my @vals = @$vals; #always work on a copy
1505 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
1507 join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
1510 # see if the first element is an -and/-or op
1512 if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) {
1517 # a long standing API wart - an attempt to change this behavior during
1518 # the 1.50 series failed *spectacularly*. Warn instead and leave the
1523 (!$logic or $logic eq 'OR')
1525 ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op})
1528 belch "A multi-element arrayref as an argument to the inequality op '$o' "
1529 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
1530 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1534 # distribute $op over each remaining member of @vals, append logic if exists
1535 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1539 # try to DWIM on equality operators
1541 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1542 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1543 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1544 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1545 : puke "operator '$op' applied on an empty array (field '$k')";
1550 sub _where_hashpair_SCALARREF {
1551 my ($self, $k, $v) = @_;
1552 $self->_debug("SCALAR($k) means literal SQL: $$v");
1553 my $sql = $self->_quote($k) . " " . $$v;
1557 # literal SQL with bind
1558 sub _where_hashpair_ARRAYREFREF {
1559 my ($self, $k, $v) = @_;
1560 $self->_debug("REF($k) means literal SQL: @${$v}");
1561 my ($sql, @bind) = @$$v;
1562 $self->_assert_bindval_matches_bindtype(@bind);
1563 $sql = $self->_quote($k) . " " . $sql;
1564 return ($sql, @bind );
1567 # literal SQL without bind
1568 sub _where_hashpair_SCALAR {
1569 my ($self, $k, $v) = @_;
1570 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1571 return ($self->_where_hashpair_HASHREF($k, { $self->{cmp} => $v }));
1575 sub _where_hashpair_UNDEF {
1576 my ($self, $k, $v) = @_;
1577 $self->_debug("UNDEF($k) means IS NULL");
1578 return $self->_where_hashpair_HASHREF($k, { -is => undef });
1581 #======================================================================
1582 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1583 #======================================================================
1586 sub _where_SCALARREF {
1587 my ($self, $where) = @_;
1590 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1596 my ($self, $where) = @_;
1599 $self->_debug("NOREF(*top) means literal SQL: $where");
1610 #======================================================================
1611 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1612 #======================================================================
1615 sub _where_field_BETWEEN {
1616 my ($self, $k, $op, $vals) = @_;
1618 my ($label, $and, $placeholder);
1619 $label = $self->_convert($self->_quote($k));
1620 $and = ' ' . $self->_sqlcase('and') . ' ';
1621 $placeholder = $self->_convert('?');
1622 $op = $self->_sqlcase($op);
1624 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1626 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1627 ARRAYREFREF => sub {
1628 my ($s, @b) = @$$vals;
1629 $self->_assert_bindval_matches_bindtype(@b);
1636 puke $invalid_args if @$vals != 2;
1638 my (@all_sql, @all_bind);
1639 foreach my $val (@$vals) {
1640 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1642 return ($placeholder, $self->_bindtype($k, $val) );
1647 ARRAYREFREF => sub {
1648 my ($sql, @bind) = @$$val;
1649 $self->_assert_bindval_matches_bindtype(@bind);
1650 return ($sql, @bind);
1653 my ($func, $arg, @rest) = %$val;
1654 puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN"
1655 if (@rest or $func !~ /^ \- (.+)/x);
1656 $self->_where_unary_op($1 => $arg);
1662 push @all_sql, $sql;
1663 push @all_bind, @bind;
1667 (join $and, @all_sql),
1676 my $sql = "( $label $op $clause )";
1677 return ($sql, @bind)
1681 sub _where_field_IN {
1682 my ($self, $k, $op, $vals) = @_;
1684 # backwards compatibility: if scalar, force into an arrayref
1685 $vals = [$vals] if defined $vals && ! ref $vals;
1687 my ($label) = $self->_convert($self->_quote($k));
1688 my ($placeholder) = $self->_convert('?');
1689 $op = $self->_sqlcase($op);
1691 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1692 ARRAYREF => sub { # list of choices
1693 if (@$vals) { # nonempty list
1694 my (@all_sql, @all_bind);
1696 for my $val (@$vals) {
1697 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1699 return ($placeholder, $val);
1704 ARRAYREFREF => sub {
1705 my ($sql, @bind) = @$$val;
1706 $self->_assert_bindval_matches_bindtype(@bind);
1707 return ($sql, @bind);
1710 my ($func, $arg, @rest) = %$val;
1711 puke "Only simple { -func => arg } functions accepted as sub-arguments to IN"
1712 if (@rest or $func !~ /^ \- (.+)/x);
1713 $self->_where_unary_op($1 => $arg);
1717 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1718 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1719 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1720 . 'will emit the logically correct SQL instead of raising this exception)'
1724 push @all_sql, $sql;
1725 push @all_bind, @bind;
1729 sprintf('%s %s ( %s )',
1732 join(', ', @all_sql)
1734 $self->_bindtype($k, @all_bind),
1737 else { # empty list: some databases won't understand "IN ()", so DWIM
1738 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1743 SCALARREF => sub { # literal SQL
1744 my $sql = $self->_open_outer_paren($$vals);
1745 return ("$label $op ( $sql )");
1747 ARRAYREFREF => sub { # literal SQL with bind
1748 my ($sql, @bind) = @$$vals;
1749 $self->_assert_bindval_matches_bindtype(@bind);
1750 $sql = $self->_open_outer_paren($sql);
1751 return ("$label $op ( $sql )", @bind);
1755 puke "Argument passed to the '$op' operator can not be undefined";
1759 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1763 return ($sql, @bind);
1766 # Some databases (SQLite) treat col IN (1, 2) different from
1767 # col IN ( (1, 2) ). Use this to strip all outer parens while
1768 # adding them back in the corresponding method
1769 sub _open_outer_paren {
1770 my ($self, $sql) = @_;
1772 while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
1774 # there are closing parens inside, need the heavy duty machinery
1775 # to reevaluate the extraction starting from $sql (full reevaluation)
1776 if ($inner =~ /\)/) {
1777 require Text::Balanced;
1779 my (undef, $remainder) = do {
1780 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1782 Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
1785 # the entire expression needs to be a balanced bracketed thing
1786 # (after an extract no remainder sans trailing space)
1787 last if defined $remainder and $remainder =~ /\S/;
1797 #======================================================================
1799 #======================================================================
1802 my ($self, $arg) = @_;
1805 for my $c ($self->_order_by_chunks($arg) ) {
1806 $self->_SWITCH_refkind($c, {
1807 SCALAR => sub { push @sql, $c },
1808 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1814 $self->_sqlcase(' order by'),
1820 return wantarray ? ($sql, @bind) : $sql;
1823 sub _order_by_chunks {
1824 my ($self, $arg) = @_;
1826 return $self->_SWITCH_refkind($arg, {
1829 map { $self->_order_by_chunks($_ ) } @$arg;
1832 ARRAYREFREF => sub {
1833 my ($s, @b) = @$$arg;
1834 $self->_assert_bindval_matches_bindtype(@b);
1838 SCALAR => sub {$self->_quote($arg)},
1840 UNDEF => sub {return () },
1842 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1845 # get first pair in hash
1846 my ($key, $val, @rest) = %$arg;
1848 return () unless $key;
1850 if (@rest or not $key =~ /^-(desc|asc)/i) {
1851 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1857 for my $c ($self->_order_by_chunks($val)) {
1860 $self->_SWITCH_refkind($c, {
1865 ($sql, @bind) = @$c;
1869 $sql = $sql . ' ' . $self->_sqlcase($direction);
1871 push @ret, [ $sql, @bind];
1880 #======================================================================
1881 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1882 #======================================================================
1887 $self->_SWITCH_refkind($from, {
1888 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1889 SCALAR => sub {$self->_quote($from)},
1890 SCALARREF => sub {$$from},
1895 #======================================================================
1897 #======================================================================
1899 # highly optimized, as it's called way too often
1901 # my ($self, $label) = @_;
1903 return '' unless defined $_[1];
1904 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1906 $_[0]->{quote_char} or
1907 ($_[0]->_assert_pass_injection_guard($_[1]), return $_[1]);
1909 my $qref = ref $_[0]->{quote_char};
1911 !$qref ? ($_[0]->{quote_char}, $_[0]->{quote_char})
1912 : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}}
1913 : puke "Unsupported quote_char format: $_[0]->{quote_char}";
1915 my $esc = $_[0]->{escape_char} || $r;
1917 # parts containing * are naturally unquoted
1918 return join($_[0]->{name_sep}||'', map
1919 +( $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } ),
1920 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1925 # Conversion, if applicable
1927 #my ($self, $arg) = @_;
1928 if ($_[0]->{convert}) {
1929 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1936 #my ($self, $col, @vals) = @_;
1937 # called often - tighten code
1938 return $_[0]->{bindtype} eq 'columns'
1939 ? map {[$_[1], $_]} @_[2 .. $#_]
1944 # Dies if any element of @bind is not in [colname => value] format
1945 # if bindtype is 'columns'.
1946 sub _assert_bindval_matches_bindtype {
1947 # my ($self, @bind) = @_;
1949 if ($self->{bindtype} eq 'columns') {
1951 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1952 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1958 sub _join_sql_clauses {
1959 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1961 if (@$clauses_aref > 1) {
1962 my $join = " " . $self->_sqlcase($logic) . " ";
1963 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1964 return ($sql, @$bind_aref);
1966 elsif (@$clauses_aref) {
1967 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1970 return (); # if no SQL, ignore @$bind_aref
1975 # Fix SQL case, if so requested
1977 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1978 # don't touch the argument ... crooked logic, but let's not change it!
1979 return $_[0]->{case} ? $_[1] : uc($_[1]);
1983 #======================================================================
1984 # DISPATCHING FROM REFKIND
1985 #======================================================================
1988 my ($self, $data) = @_;
1990 return 'UNDEF' unless defined $data;
1992 # blessed objects are treated like scalars
1993 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1995 return 'SCALAR' unless $ref;
1998 while ($ref eq 'REF') {
2000 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
2004 return ($ref||'SCALAR') . ('REF' x $n_steps);
2008 my ($self, $data) = @_;
2009 my @try = ($self->_refkind($data));
2010 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
2011 push @try, 'FALLBACK';
2015 sub _METHOD_FOR_refkind {
2016 my ($self, $meth_prefix, $data) = @_;
2019 for (@{$self->_try_refkind($data)}) {
2020 $method = $self->can($meth_prefix."_".$_)
2024 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
2028 sub _SWITCH_refkind {
2029 my ($self, $data, $dispatch_table) = @_;
2032 for (@{$self->_try_refkind($data)}) {
2033 $coderef = $dispatch_table->{$_}
2037 puke "no dispatch entry for ".$self->_refkind($data)
2046 #======================================================================
2047 # VALUES, GENERATE, AUTOLOAD
2048 #======================================================================
2050 # LDNOTE: original code from nwiger, didn't touch code in that section
2051 # I feel the AUTOLOAD stuff should not be the default, it should
2052 # only be activated on explicit demand by user.
2056 my $data = shift || return;
2057 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
2058 unless ref $data eq 'HASH';
2061 foreach my $k (sort keys %$data) {
2062 my $v = $data->{$k};
2063 $self->_SWITCH_refkind($v, {
2065 if ($self->{array_datatypes}) { # array datatype
2066 push @all_bind, $self->_bindtype($k, $v);
2068 else { # literal SQL with bind
2069 my ($sql, @bind) = @$v;
2070 $self->_assert_bindval_matches_bindtype(@bind);
2071 push @all_bind, @bind;
2074 ARRAYREFREF => sub { # literal SQL with bind
2075 my ($sql, @bind) = @${$v};
2076 $self->_assert_bindval_matches_bindtype(@bind);
2077 push @all_bind, @bind;
2079 SCALARREF => sub { # literal SQL without bind
2081 SCALAR_or_UNDEF => sub {
2082 push @all_bind, $self->_bindtype($k, $v);
2093 my(@sql, @sqlq, @sqlv);
2097 if ($ref eq 'HASH') {
2098 for my $k (sort keys %$_) {
2101 my $label = $self->_quote($k);
2102 if ($r eq 'ARRAY') {
2103 # literal SQL with bind
2104 my ($sql, @bind) = @$v;
2105 $self->_assert_bindval_matches_bindtype(@bind);
2106 push @sqlq, "$label = $sql";
2108 } elsif ($r eq 'SCALAR') {
2109 # literal SQL without bind
2110 push @sqlq, "$label = $$v";
2112 push @sqlq, "$label = ?";
2113 push @sqlv, $self->_bindtype($k, $v);
2116 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
2117 } elsif ($ref eq 'ARRAY') {
2118 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
2121 if ($r eq 'ARRAY') { # literal SQL with bind
2122 my ($sql, @bind) = @$v;
2123 $self->_assert_bindval_matches_bindtype(@bind);
2126 } elsif ($r eq 'SCALAR') { # literal SQL without bind
2127 # embedded literal SQL
2134 push @sql, '(' . join(', ', @sqlq) . ')';
2135 } elsif ($ref eq 'SCALAR') {
2139 # strings get case twiddled
2140 push @sql, $self->_sqlcase($_);
2144 my $sql = join ' ', @sql;
2146 # this is pretty tricky
2147 # if ask for an array, return ($stmt, @bind)
2148 # otherwise, s/?/shift @sqlv/ to put it inline
2150 return ($sql, @sqlv);
2152 1 while $sql =~ s/\?/my $d = shift(@sqlv);
2153 ref $d ? $d->[1] : $d/e;
2162 # This allows us to check for a local, then _form, attr
2164 my($name) = $AUTOLOAD =~ /.*::(.+)/;
2165 return $self->generate($name, @_);
2176 SQL::Abstract - Generate SQL from Perl data structures
2182 my $sql = SQL::Abstract->new;
2184 my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order);
2186 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
2188 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
2190 my($stmt, @bind) = $sql->delete($table, \%where);
2192 # Then, use these in your DBI statements
2193 my $sth = $dbh->prepare($stmt);
2194 $sth->execute(@bind);
2196 # Just generate the WHERE clause
2197 my($stmt, @bind) = $sql->where(\%where, $order);
2199 # Return values in the same order, for hashed queries
2200 # See PERFORMANCE section for more details
2201 my @bind = $sql->values(\%fieldvals);
2205 This module was inspired by the excellent L<DBIx::Abstract>.
2206 However, in using that module I found that what I really wanted
2207 to do was generate SQL, but still retain complete control over my
2208 statement handles and use the DBI interface. So, I set out to
2209 create an abstract SQL generation module.
2211 While based on the concepts used by L<DBIx::Abstract>, there are
2212 several important differences, especially when it comes to WHERE
2213 clauses. I have modified the concepts used to make the SQL easier
2214 to generate from Perl data structures and, IMO, more intuitive.
2215 The underlying idea is for this module to do what you mean, based
2216 on the data structures you provide it. The big advantage is that
2217 you don't have to modify your code every time your data changes,
2218 as this module figures it out.
2220 To begin with, an SQL INSERT is as easy as just specifying a hash
2221 of C<key=value> pairs:
2224 name => 'Jimbo Bobson',
2225 phone => '123-456-7890',
2226 address => '42 Sister Lane',
2227 city => 'St. Louis',
2228 state => 'Louisiana',
2231 The SQL can then be generated with this:
2233 my($stmt, @bind) = $sql->insert('people', \%data);
2235 Which would give you something like this:
2237 $stmt = "INSERT INTO people
2238 (address, city, name, phone, state)
2239 VALUES (?, ?, ?, ?, ?)";
2240 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
2241 '123-456-7890', 'Louisiana');
2243 These are then used directly in your DBI code:
2245 my $sth = $dbh->prepare($stmt);
2246 $sth->execute(@bind);
2248 =head2 Inserting and Updating Arrays
2250 If your database has array types (like for example Postgres),
2251 activate the special option C<< array_datatypes => 1 >>
2252 when creating the C<SQL::Abstract> object.
2253 Then you may use an arrayref to insert and update database array types:
2255 my $sql = SQL::Abstract->new(array_datatypes => 1);
2257 planets => [qw/Mercury Venus Earth Mars/]
2260 my($stmt, @bind) = $sql->insert('solar_system', \%data);
2264 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
2266 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
2269 =head2 Inserting and Updating SQL
2271 In order to apply SQL functions to elements of your C<%data> you may
2272 specify a reference to an arrayref for the given hash value. For example,
2273 if you need to execute the Oracle C<to_date> function on a value, you can
2274 say something like this:
2278 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
2281 The first value in the array is the actual SQL. Any other values are
2282 optional and would be included in the bind values array. This gives
2285 my($stmt, @bind) = $sql->insert('people', \%data);
2287 $stmt = "INSERT INTO people (name, date_entered)
2288 VALUES (?, to_date(?,'MM/DD/YYYY'))";
2289 @bind = ('Bill', '03/02/2003');
2291 An UPDATE is just as easy, all you change is the name of the function:
2293 my($stmt, @bind) = $sql->update('people', \%data);
2295 Notice that your C<%data> isn't touched; the module will generate
2296 the appropriately quirky SQL for you automatically. Usually you'll
2297 want to specify a WHERE clause for your UPDATE, though, which is
2298 where handling C<%where> hashes comes in handy...
2300 =head2 Complex where statements
2302 This module can generate pretty complicated WHERE statements
2303 easily. For example, simple C<key=value> pairs are taken to mean
2304 equality, and if you want to see if a field is within a set
2305 of values, you can use an arrayref. Let's say we wanted to
2306 SELECT some data based on this criteria:
2309 requestor => 'inna',
2310 worker => ['nwiger', 'rcwe', 'sfz'],
2311 status => { '!=', 'completed' }
2314 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
2316 The above would give you something like this:
2318 $stmt = "SELECT * FROM tickets WHERE
2319 ( requestor = ? ) AND ( status != ? )
2320 AND ( worker = ? OR worker = ? OR worker = ? )";
2321 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
2323 Which you could then use in DBI code like so:
2325 my $sth = $dbh->prepare($stmt);
2326 $sth->execute(@bind);
2332 The methods are simple. There's one for every major SQL operation,
2333 and a constructor you use first. The arguments are specified in a
2334 similar order for each method (table, then fields, then a where
2335 clause) to try and simplify things.
2337 =head2 new(option => 'value')
2339 The C<new()> function takes a list of options and values, and returns
2340 a new B<SQL::Abstract> object which can then be used to generate SQL
2341 through the methods below. The options accepted are:
2347 If set to 'lower', then SQL will be generated in all lowercase. By
2348 default SQL is generated in "textbook" case meaning something like:
2350 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
2352 Any setting other than 'lower' is ignored.
2356 This determines what the default comparison operator is. By default
2357 it is C<=>, meaning that a hash like this:
2359 %where = (name => 'nwiger', email => 'nate@wiger.org');
2361 Will generate SQL like this:
2363 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
2365 However, you may want loose comparisons by default, so if you set
2366 C<cmp> to C<like> you would get SQL such as:
2368 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
2370 You can also override the comparison on an individual basis - see
2371 the huge section on L</"WHERE CLAUSES"> at the bottom.
2373 =item sqltrue, sqlfalse
2375 Expressions for inserting boolean values within SQL statements.
2376 By default these are C<1=1> and C<1=0>. They are used
2377 by the special operators C<-in> and C<-not_in> for generating
2378 correct SQL even when the argument is an empty array (see below).
2382 This determines the default logical operator for multiple WHERE
2383 statements in arrays or hashes. If absent, the default logic is "or"
2384 for arrays, and "and" for hashes. This means that a WHERE
2388 event_date => {'>=', '2/13/99'},
2389 event_date => {'<=', '4/24/03'},
2392 will generate SQL like this:
2394 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
2396 This is probably not what you want given this query, though (look
2397 at the dates). To change the "OR" to an "AND", simply specify:
2399 my $sql = SQL::Abstract->new(logic => 'and');
2401 Which will change the above C<WHERE> to:
2403 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
2405 The logic can also be changed locally by inserting
2406 a modifier in front of an arrayref:
2408 @where = (-and => [event_date => {'>=', '2/13/99'},
2409 event_date => {'<=', '4/24/03'} ]);
2411 See the L</"WHERE CLAUSES"> section for explanations.
2415 This will automatically convert comparisons using the specified SQL
2416 function for both column and value. This is mostly used with an argument
2417 of C<upper> or C<lower>, so that the SQL will have the effect of
2418 case-insensitive "searches". For example, this:
2420 $sql = SQL::Abstract->new(convert => 'upper');
2421 %where = (keywords => 'MaKe iT CAse inSeNSItive');
2423 Will turn out the following SQL:
2425 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
2427 The conversion can be C<upper()>, C<lower()>, or any other SQL function
2428 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
2429 not validate this option; it will just pass through what you specify verbatim).
2433 This is a kludge because many databases suck. For example, you can't
2434 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
2435 Instead, you have to use C<bind_param()>:
2437 $sth->bind_param(1, 'reg data');
2438 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
2440 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
2441 which loses track of which field each slot refers to. Fear not.
2443 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
2444 Currently, you can specify either C<normal> (default) or C<columns>. If you
2445 specify C<columns>, you will get an array that looks like this:
2447 my $sql = SQL::Abstract->new(bindtype => 'columns');
2448 my($stmt, @bind) = $sql->insert(...);
2451 [ 'column1', 'value1' ],
2452 [ 'column2', 'value2' ],
2453 [ 'column3', 'value3' ],
2456 You can then iterate through this manually, using DBI's C<bind_param()>.
2458 $sth->prepare($stmt);
2461 my($col, $data) = @$_;
2462 if ($col eq 'details' || $col eq 'comments') {
2463 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
2464 } elsif ($col eq 'image') {
2465 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
2467 $sth->bind_param($i, $data);
2471 $sth->execute; # execute without @bind now
2473 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
2474 Basically, the advantage is still that you don't have to care which fields
2475 are or are not included. You could wrap that above C<for> loop in a simple
2476 sub called C<bind_fields()> or something and reuse it repeatedly. You still
2477 get a layer of abstraction over manual SQL specification.
2479 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
2480 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
2481 will expect the bind values in this format.
2485 This is the character that a table or column name will be quoted
2486 with. By default this is an empty string, but you could set it to
2487 the character C<`>, to generate SQL like this:
2489 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
2491 Alternatively, you can supply an array ref of two items, the first being the left
2492 hand quote character, and the second the right hand quote character. For
2493 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
2494 that generates SQL like this:
2496 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
2498 Quoting is useful if you have tables or columns names that are reserved
2499 words in your database's SQL dialect.
2503 This is the character that will be used to escape L</quote_char>s appearing
2504 in an identifier before it has been quoted.
2506 The parameter default in case of a single L</quote_char> character is the quote
2509 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
2510 this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences
2511 of the B<opening (left)> L</quote_char> within the identifier are currently left
2512 untouched. The default for opening-closing-style quotes may change in future
2513 versions, thus you are B<strongly encouraged> to specify the escape character
2518 This is the character that separates a table and column name. It is
2519 necessary to specify this when the C<quote_char> option is selected,
2520 so that tables and column names can be individually quoted like this:
2522 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2524 =item injection_guard
2526 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2527 column name specified in a query structure. This is a safety mechanism to avoid
2528 injection attacks when mishandling user input e.g.:
2530 my %condition_as_column_value_pairs = get_values_from_user();
2531 $sqla->select( ... , \%condition_as_column_value_pairs );
2533 If the expression matches an exception is thrown. Note that literal SQL
2534 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2536 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2538 =item array_datatypes
2540 When this option is true, arrayrefs in INSERT or UPDATE are
2541 interpreted as array datatypes and are passed directly
2543 When this option is false, arrayrefs are interpreted
2544 as literal SQL, just like refs to arrayrefs
2545 (but this behavior is for backwards compatibility; when writing
2546 new queries, use the "reference to arrayref" syntax
2552 Takes a reference to a list of "special operators"
2553 to extend the syntax understood by L<SQL::Abstract>.
2554 See section L</"SPECIAL OPERATORS"> for details.
2558 Takes a reference to a list of "unary operators"
2559 to extend the syntax understood by L<SQL::Abstract>.
2560 See section L</"UNARY OPERATORS"> for details.
2566 =head2 insert($table, \@values || \%fieldvals, \%options)
2568 This is the simplest function. You simply give it a table name
2569 and either an arrayref of values or hashref of field/value pairs.
2570 It returns an SQL INSERT statement and a list of bind values.
2571 See the sections on L</"Inserting and Updating Arrays"> and
2572 L</"Inserting and Updating SQL"> for information on how to insert
2573 with those data types.
2575 The optional C<\%options> hash reference may contain additional
2576 options to generate the insert SQL. Currently supported options
2583 Takes either a scalar of raw SQL fields, or an array reference of
2584 field names, and adds on an SQL C<RETURNING> statement at the end.
2585 This allows you to return data generated by the insert statement
2586 (such as row IDs) without performing another C<SELECT> statement.
2587 Note, however, this is not part of the SQL standard and may not
2588 be supported by all database engines.
2592 =head2 update($table, \%fieldvals, \%where, \%options)
2594 This takes a table, hashref of field/value pairs, and an optional
2595 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2597 See the sections on L</"Inserting and Updating Arrays"> and
2598 L</"Inserting and Updating SQL"> for information on how to insert
2599 with those data types.
2601 The optional C<\%options> hash reference may contain additional
2602 options to generate the update SQL. Currently supported options
2609 See the C<returning> option to
2610 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2614 =head2 select($source, $fields, $where, $order)
2616 This returns a SQL SELECT statement and associated list of bind values, as
2617 specified by the arguments:
2623 Specification of the 'FROM' part of the statement.
2624 The argument can be either a plain scalar (interpreted as a table
2625 name, will be quoted), or an arrayref (interpreted as a list
2626 of table names, joined by commas, quoted), or a scalarref
2627 (literal SQL, not quoted).
2631 Specification of the list of fields to retrieve from
2633 The argument can be either an arrayref (interpreted as a list
2634 of field names, will be joined by commas and quoted), or a
2635 plain scalar (literal SQL, not quoted).
2636 Please observe that this API is not as flexible as that of
2637 the first argument C<$source>, for backwards compatibility reasons.
2641 Optional argument to specify the WHERE part of the query.
2642 The argument is most often a hashref, but can also be
2643 an arrayref or plain scalar --
2644 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2648 Optional argument to specify the ORDER BY part of the query.
2649 The argument can be a scalar, a hashref or an arrayref
2650 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2656 =head2 delete($table, \%where, \%options)
2658 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2659 It returns an SQL DELETE statement and list of bind values.
2661 The optional C<\%options> hash reference may contain additional
2662 options to generate the delete SQL. Currently supported options
2669 See the C<returning> option to
2670 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2674 =head2 where(\%where, $order)
2676 This is used to generate just the WHERE clause. For example,
2677 if you have an arbitrary data structure and know what the
2678 rest of your SQL is going to look like, but want an easy way
2679 to produce a WHERE clause, use this. It returns an SQL WHERE
2680 clause and list of bind values.
2683 =head2 values(\%data)
2685 This just returns the values from the hash C<%data>, in the same
2686 order that would be returned from any of the other above queries.
2687 Using this allows you to markedly speed up your queries if you
2688 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2690 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2692 Warning: This is an experimental method and subject to change.
2694 This returns arbitrarily generated SQL. It's a really basic shortcut.
2695 It will return two different things, depending on return context:
2697 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2698 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2700 These would return the following:
2702 # First calling form
2703 $stmt = "CREATE TABLE test (?, ?)";
2704 @bind = (field1, field2);
2706 # Second calling form
2707 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2709 Depending on what you're trying to do, it's up to you to choose the correct
2710 format. In this example, the second form is what you would want.
2714 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2718 ALTER SESSION SET nls_date_format = 'MM/YY'
2720 You get the idea. Strings get their case twiddled, but everything
2721 else remains verbatim.
2723 =head1 EXPORTABLE FUNCTIONS
2725 =head2 is_plain_value
2727 Determines if the supplied argument is a plain value as understood by this
2732 =item * The value is C<undef>
2734 =item * The value is a non-reference
2736 =item * The value is an object with stringification overloading
2738 =item * The value is of the form C<< { -value => $anything } >>
2742 On failure returns C<undef>, on success returns a B<scalar> reference
2743 to the original supplied argument.
2749 The stringification overloading detection is rather advanced: it takes
2750 into consideration not only the presence of a C<""> overload, but if that
2751 fails also checks for enabled
2752 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2753 on either C<0+> or C<bool>.
2755 Unfortunately testing in the field indicates that this
2756 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2757 but only when very large numbers of stringifying objects are involved.
2758 At the time of writing ( Sep 2014 ) there is no clear explanation of
2759 the direct cause, nor is there a manageably small test case that reliably
2760 reproduces the problem.
2762 If you encounter any of the following exceptions in B<random places within
2763 your application stack> - this module may be to blame:
2765 Operation "ne": no method found,
2766 left argument in overloaded package <something>,
2767 right argument in overloaded package <something>
2771 Stub found while resolving method "???" overloading """" in package <something>
2773 If you fall victim to the above - please attempt to reduce the problem
2774 to something that could be sent to the L<SQL::Abstract developers
2775 |DBIx::Class/GETTING HELP/SUPPORT>
2776 (either publicly or privately). As a workaround in the meantime you can
2777 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2778 value, which will most likely eliminate your problem (at the expense of
2779 not being able to properly detect exotic forms of stringification).
2781 This notice and environment variable will be removed in a future version,
2782 as soon as the underlying problem is found and a reliable workaround is
2787 =head2 is_literal_value
2789 Determines if the supplied argument is a literal value as understood by this
2794 =item * C<\$sql_string>
2796 =item * C<\[ $sql_string, @bind_values ]>
2800 On failure returns C<undef>, on success returns an B<array> reference
2801 containing the unpacked version of the supplied literal SQL and bind values.
2803 =head1 WHERE CLAUSES
2807 This module uses a variation on the idea from L<DBIx::Abstract>. It
2808 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2809 module is that things in arrays are OR'ed, and things in hashes
2812 The easiest way to explain is to show lots of examples. After
2813 each C<%where> hash shown, it is assumed you used:
2815 my($stmt, @bind) = $sql->where(\%where);
2817 However, note that the C<%where> hash can be used directly in any
2818 of the other functions as well, as described above.
2820 =head2 Key-value pairs
2822 So, let's get started. To begin, a simple hash:
2826 status => 'completed'
2829 Is converted to SQL C<key = val> statements:
2831 $stmt = "WHERE user = ? AND status = ?";
2832 @bind = ('nwiger', 'completed');
2834 One common thing I end up doing is having a list of values that
2835 a field can be in. To do this, simply specify a list inside of
2840 status => ['assigned', 'in-progress', 'pending'];
2843 This simple code will create the following:
2845 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2846 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2848 A field associated to an empty arrayref will be considered a
2849 logical false and will generate 0=1.
2851 =head2 Tests for NULL values
2853 If the value part is C<undef> then this is converted to SQL <IS NULL>
2862 $stmt = "WHERE user = ? AND status IS NULL";
2865 To test if a column IS NOT NULL:
2869 status => { '!=', undef },
2872 =head2 Specific comparison operators
2874 If you want to specify a different type of operator for your comparison,
2875 you can use a hashref for a given column:
2879 status => { '!=', 'completed' }
2882 Which would generate:
2884 $stmt = "WHERE user = ? AND status != ?";
2885 @bind = ('nwiger', 'completed');
2887 To test against multiple values, just enclose the values in an arrayref:
2889 status => { '=', ['assigned', 'in-progress', 'pending'] };
2891 Which would give you:
2893 "WHERE status = ? OR status = ? OR status = ?"
2896 The hashref can also contain multiple pairs, in which case it is expanded
2897 into an C<AND> of its elements:
2901 status => { '!=', 'completed', -not_like => 'pending%' }
2904 # Or more dynamically, like from a form
2905 $where{user} = 'nwiger';
2906 $where{status}{'!='} = 'completed';
2907 $where{status}{'-not_like'} = 'pending%';
2909 # Both generate this
2910 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2911 @bind = ('nwiger', 'completed', 'pending%');
2914 To get an OR instead, you can combine it with the arrayref idea:
2918 priority => [ { '=', 2 }, { '>', 5 } ]
2921 Which would generate:
2923 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2924 @bind = ('2', '5', 'nwiger');
2926 If you want to include literal SQL (with or without bind values), just use a
2927 scalar reference or reference to an arrayref as the value:
2930 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2931 date_expires => { '<' => \"now()" }
2934 Which would generate:
2936 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2937 @bind = ('11/26/2008');
2940 =head2 Logic and nesting operators
2942 In the example above,
2943 there is a subtle trap if you want to say something like
2944 this (notice the C<AND>):
2946 WHERE priority != ? AND priority != ?
2948 Because, in Perl you I<can't> do this:
2950 priority => { '!=' => 2, '!=' => 1 }
2952 As the second C<!=> key will obliterate the first. The solution
2953 is to use the special C<-modifier> form inside an arrayref:
2955 priority => [ -and => {'!=', 2},
2959 Normally, these would be joined by C<OR>, but the modifier tells it
2960 to use C<AND> instead. (Hint: You can use this in conjunction with the
2961 C<logic> option to C<new()> in order to change the way your queries
2962 work by default.) B<Important:> Note that the C<-modifier> goes
2963 B<INSIDE> the arrayref, as an extra first element. This will
2964 B<NOT> do what you think it might:
2966 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2968 Here is a quick list of equivalencies, since there is some overlap:
2971 status => {'!=', 'completed', 'not like', 'pending%' }
2972 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2975 status => {'=', ['assigned', 'in-progress']}
2976 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2977 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2981 =head2 Special operators: IN, BETWEEN, etc.
2983 You can also use the hashref format to compare a list of fields using the
2984 C<IN> comparison operator, by specifying the list as an arrayref:
2987 status => 'completed',
2988 reportid => { -in => [567, 2335, 2] }
2991 Which would generate:
2993 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2994 @bind = ('completed', '567', '2335', '2');
2996 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2999 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
3000 (by default: C<1=0>). Similarly, C<< -not_in => [] >> generates
3001 'sqltrue' (by default: C<1=1>).
3003 In addition to the array you can supply a chunk of literal sql or
3004 literal sql with bind:
3007 customer => { -in => \[
3008 'SELECT cust_id FROM cust WHERE balance > ?',
3011 status => { -in => \'SELECT status_codes FROM states' },
3017 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
3018 AND status IN ( SELECT status_codes FROM states )
3022 Finally, if the argument to C<-in> is not a reference, it will be
3023 treated as a single-element array.
3025 Another pair of operators is C<-between> and C<-not_between>,
3026 used with an arrayref of two values:
3030 completion_date => {
3031 -not_between => ['2002-10-01', '2003-02-06']
3037 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
3039 Just like with C<-in> all plausible combinations of literal SQL
3043 start0 => { -between => [ 1, 2 ] },
3044 start1 => { -between => \["? AND ?", 1, 2] },
3045 start2 => { -between => \"lower(x) AND upper(y)" },
3046 start3 => { -between => [
3048 \["upper(?)", 'stuff' ],
3055 ( start0 BETWEEN ? AND ? )
3056 AND ( start1 BETWEEN ? AND ? )
3057 AND ( start2 BETWEEN lower(x) AND upper(y) )
3058 AND ( start3 BETWEEN lower(x) AND upper(?) )
3060 @bind = (1, 2, 1, 2, 'stuff');
3063 These are the two builtin "special operators"; but the
3064 list can be expanded: see section L</"SPECIAL OPERATORS"> below.
3066 =head2 Unary operators: bool
3068 If you wish to test against boolean columns or functions within your
3069 database you can use the C<-bool> and C<-not_bool> operators. For
3070 example to test the column C<is_user> being true and the column
3071 C<is_enabled> being false you would use:-
3075 -not_bool => 'is_enabled',
3080 WHERE is_user AND NOT is_enabled
3082 If a more complex combination is required, testing more conditions,
3083 then you should use the and/or operators:-
3088 -not_bool => { two=> { -rlike => 'bar' } },
3089 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
3100 (NOT ( three = ? OR three > ? ))
3103 =head2 Nested conditions, -and/-or prefixes
3105 So far, we've seen how multiple conditions are joined with a top-level
3106 C<AND>. We can change this by putting the different conditions we want in
3107 hashes and then putting those hashes in an array. For example:
3112 status => { -like => ['pending%', 'dispatched'] },
3116 status => 'unassigned',
3120 This data structure would create the following:
3122 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
3123 OR ( user = ? AND status = ? ) )";
3124 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
3127 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
3128 to change the logic inside:
3134 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
3135 -or => { workhrs => {'<', 50}, geo => 'EURO' },
3142 $stmt = "WHERE ( user = ?
3143 AND ( ( workhrs > ? AND geo = ? )
3144 OR ( workhrs < ? OR geo = ? ) ) )";
3145 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
3147 =head3 Algebraic inconsistency, for historical reasons
3149 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
3150 operator goes C<outside> of the nested structure; whereas when connecting
3151 several constraints on one column, the C<-and> operator goes
3152 C<inside> the arrayref. Here is an example combining both features:
3155 -and => [a => 1, b => 2],
3156 -or => [c => 3, d => 4],
3157 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
3162 WHERE ( ( ( a = ? AND b = ? )
3163 OR ( c = ? OR d = ? )
3164 OR ( e LIKE ? AND e LIKE ? ) ) )
3166 This difference in syntax is unfortunate but must be preserved for
3167 historical reasons. So be careful: the two examples below would
3168 seem algebraically equivalent, but they are not
3171 { -like => 'foo%' },
3172 { -like => '%bar' },
3174 # yields: WHERE ( ( col LIKE ? AND col LIKE ? ) )
3177 { col => { -like => 'foo%' } },
3178 { col => { -like => '%bar' } },
3180 # yields: WHERE ( ( col LIKE ? OR col LIKE ? ) )
3183 =head2 Literal SQL and value type operators
3185 The basic premise of SQL::Abstract is that in WHERE specifications the "left
3186 side" is a column name and the "right side" is a value (normally rendered as
3187 a placeholder). This holds true for both hashrefs and arrayref pairs as you
3188 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
3189 alter this behavior. There are several ways of doing so.
3193 This is a virtual operator that signals the string to its right side is an
3194 identifier (a column name) and not a value. For example to compare two
3195 columns you would write:
3198 priority => { '<', 2 },
3199 requestor => { -ident => 'submitter' },
3204 $stmt = "WHERE priority < ? AND requestor = submitter";
3207 If you are maintaining legacy code you may see a different construct as
3208 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
3213 This is a virtual operator that signals that the construct to its right side
3214 is a value to be passed to DBI. This is for example necessary when you want
3215 to write a where clause against an array (for RDBMS that support such
3216 datatypes). For example:
3219 array => { -value => [1, 2, 3] }
3224 $stmt = 'WHERE array = ?';
3225 @bind = ([1, 2, 3]);
3227 Note that if you were to simply say:
3233 the result would probably not be what you wanted:
3235 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
3240 Finally, sometimes only literal SQL will do. To include a random snippet
3241 of SQL verbatim, you specify it as a scalar reference. Consider this only
3242 as a last resort. Usually there is a better way. For example:
3245 priority => { '<', 2 },
3246 requestor => { -in => \'(SELECT name FROM hitmen)' },
3251 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
3254 Note that in this example, you only get one bind parameter back, since
3255 the verbatim SQL is passed as part of the statement.
3259 Never use untrusted input as a literal SQL argument - this is a massive
3260 security risk (there is no way to check literal snippets for SQL
3261 injections and other nastyness). If you need to deal with untrusted input
3262 use literal SQL with placeholders as described next.
3264 =head3 Literal SQL with placeholders and bind values (subqueries)
3266 If the literal SQL to be inserted has placeholders and bind values,
3267 use a reference to an arrayref (yes this is a double reference --
3268 not so common, but perfectly legal Perl). For example, to find a date
3269 in Postgres you can use something like this:
3272 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
3277 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
3280 Note that you must pass the bind values in the same format as they are returned
3281 by L<where|/where(\%where, $order)>. This means that if you set L</bindtype>
3282 to C<columns>, you must provide the bind values in the
3283 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
3284 scalar value; most commonly the column name, but you can use any scalar value
3285 (including references and blessed references), L<SQL::Abstract> will simply
3286 pass it through intact. So if C<bindtype> is set to C<columns> the above
3287 example will look like:
3290 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
3293 Literal SQL is especially useful for nesting parenthesized clauses in the
3294 main SQL query. Here is a first example:
3296 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
3300 bar => \["IN ($sub_stmt)" => @sub_bind],
3305 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
3306 WHERE c2 < ? AND c3 LIKE ?))";
3307 @bind = (1234, 100, "foo%");
3309 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
3310 are expressed in the same way. Of course the C<$sub_stmt> and
3311 its associated bind values can be generated through a former call
3314 my ($sub_stmt, @sub_bind)
3315 = $sql->select("t1", "c1", {c2 => {"<" => 100},
3316 c3 => {-like => "foo%"}});
3319 bar => \["> ALL ($sub_stmt)" => @sub_bind],
3322 In the examples above, the subquery was used as an operator on a column;
3323 but the same principle also applies for a clause within the main C<%where>
3324 hash, like an EXISTS subquery:
3326 my ($sub_stmt, @sub_bind)
3327 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
3328 my %where = ( -and => [
3330 \["EXISTS ($sub_stmt)" => @sub_bind],
3335 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
3336 WHERE c1 = ? AND c2 > t0.c0))";
3340 Observe that the condition on C<c2> in the subquery refers to
3341 column C<t0.c0> of the main query: this is I<not> a bind
3342 value, so we have to express it through a scalar ref.
3343 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
3344 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
3345 what we wanted here.
3347 Finally, here is an example where a subquery is used
3348 for expressing unary negation:
3350 my ($sub_stmt, @sub_bind)
3351 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
3352 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
3354 lname => {like => '%son%'},
3355 \["NOT ($sub_stmt)" => @sub_bind],
3360 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
3361 @bind = ('%son%', 10, 20)
3363 =head3 Deprecated usage of Literal SQL
3365 Below are some examples of archaic use of literal SQL. It is shown only as
3366 reference for those who deal with legacy code. Each example has a much
3367 better, cleaner and safer alternative that users should opt for in new code.
3373 my %where = ( requestor => \'IS NOT NULL' )
3375 $stmt = "WHERE requestor IS NOT NULL"
3377 This used to be the way of generating NULL comparisons, before the handling
3378 of C<undef> got formalized. For new code please use the superior syntax as
3379 described in L</Tests for NULL values>.
3383 my %where = ( requestor => \'= submitter' )
3385 $stmt = "WHERE requestor = submitter"
3387 This used to be the only way to compare columns. Use the superior L</-ident>
3388 method for all new code. For example an identifier declared in such a way
3389 will be properly quoted if L</quote_char> is properly set, while the legacy
3390 form will remain as supplied.
3394 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
3396 $stmt = "WHERE completed > ? AND is_ready"
3397 @bind = ('2012-12-21')
3399 Using an empty string literal used to be the only way to express a boolean.
3400 For all new code please use the much more readable
3401 L<-bool|/Unary operators: bool> operator.
3407 These pages could go on for a while, since the nesting of the data
3408 structures this module can handle are pretty much unlimited (the
3409 module implements the C<WHERE> expansion as a recursive function
3410 internally). Your best bet is to "play around" with the module a
3411 little to see how the data structures behave, and choose the best
3412 format for your data based on that.
3414 And of course, all the values above will probably be replaced with
3415 variables gotten from forms or the command line. After all, if you
3416 knew everything ahead of time, you wouldn't have to worry about
3417 dynamically-generating SQL and could just hardwire it into your
3420 =head1 ORDER BY CLAUSES
3422 Some functions take an order by clause. This can either be a scalar (just a
3423 column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' }
3424 >>, a scalarref, an arrayref-ref, or an arrayref of any of the previous
3427 Given | Will Generate
3428 ---------------------------------------------------------------
3430 'colA' | ORDER BY colA
3432 [qw/colA colB/] | ORDER BY colA, colB
3434 {-asc => 'colA'} | ORDER BY colA ASC
3436 {-desc => 'colB'} | ORDER BY colB DESC
3438 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
3440 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
3442 \'colA DESC' | ORDER BY colA DESC
3444 \[ 'FUNC(colA, ?)', $x ] | ORDER BY FUNC(colA, ?)
3445 | /* ...with $x bound to ? */
3448 { -asc => 'colA' }, | colA ASC,
3449 { -desc => [qw/colB/] }, | colB DESC,
3450 { -asc => [qw/colC colD/] },| colC ASC, colD ASC,
3451 \'colE DESC', | colE DESC,
3452 \[ 'FUNC(colF, ?)', $x ], | FUNC(colF, ?)
3453 ] | /* ...with $x bound to ? */
3454 ===============================================================
3458 =head1 SPECIAL OPERATORS
3460 my $sqlmaker = SQL::Abstract->new(special_ops => [
3464 my ($self, $field, $op, $arg) = @_;
3470 handler => 'method_name',
3474 A "special operator" is a SQL syntactic clause that can be
3475 applied to a field, instead of a usual binary operator.
3478 WHERE field IN (?, ?, ?)
3479 WHERE field BETWEEN ? AND ?
3480 WHERE MATCH(field) AGAINST (?, ?)
3482 Special operators IN and BETWEEN are fairly standard and therefore
3483 are builtin within C<SQL::Abstract> (as the overridable methods
3484 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
3485 like the MATCH .. AGAINST example above which is specific to MySQL,
3486 you can write your own operator handlers - supply a C<special_ops>
3487 argument to the C<new> method. That argument takes an arrayref of
3488 operator definitions; each operator definition is a hashref with two
3495 the regular expression to match the operator
3499 Either a coderef or a plain scalar method name. In both cases
3500 the expected return is C<< ($sql, @bind) >>.
3502 When supplied with a method name, it is simply called on the
3503 L<SQL::Abstract> object as:
3505 $self->$method_name($field, $op, $arg)
3509 $field is the LHS of the operator
3510 $op is the part that matched the handler regex
3513 When supplied with a coderef, it is called as:
3515 $coderef->($self, $field, $op, $arg)
3520 For example, here is an implementation
3521 of the MATCH .. AGAINST syntax for MySQL
3523 my $sqlmaker = SQL::Abstract->new(special_ops => [
3525 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
3526 {regex => qr/^match$/i,
3528 my ($self, $field, $op, $arg) = @_;
3529 $arg = [$arg] if not ref $arg;
3530 my $label = $self->_quote($field);
3531 my ($placeholder) = $self->_convert('?');
3532 my $placeholders = join ", ", (($placeholder) x @$arg);
3533 my $sql = $self->_sqlcase('match') . " ($label) "
3534 . $self->_sqlcase('against') . " ($placeholders) ";
3535 my @bind = $self->_bindtype($field, @$arg);
3536 return ($sql, @bind);
3543 =head1 UNARY OPERATORS
3545 my $sqlmaker = SQL::Abstract->new(unary_ops => [
3549 my ($self, $op, $arg) = @_;
3555 handler => 'method_name',
3559 A "unary operator" is a SQL syntactic clause that can be
3560 applied to a field - the operator goes before the field
3562 You can write your own operator handlers - supply a C<unary_ops>
3563 argument to the C<new> method. That argument takes an arrayref of
3564 operator definitions; each operator definition is a hashref with two
3571 the regular expression to match the operator
3575 Either a coderef or a plain scalar method name. In both cases
3576 the expected return is C<< $sql >>.
3578 When supplied with a method name, it is simply called on the
3579 L<SQL::Abstract> object as:
3581 $self->$method_name($op, $arg)
3585 $op is the part that matched the handler regex
3586 $arg is the RHS or argument of the operator
3588 When supplied with a coderef, it is called as:
3590 $coderef->($self, $op, $arg)
3598 Thanks to some benchmarking by Mark Stosberg, it turns out that
3599 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3600 I must admit this wasn't an intentional design issue, but it's a
3601 byproduct of the fact that you get to control your C<DBI> handles
3604 To maximize performance, use a code snippet like the following:
3606 # prepare a statement handle using the first row
3607 # and then reuse it for the rest of the rows
3609 for my $href (@array_of_hashrefs) {
3610 $stmt ||= $sql->insert('table', $href);
3611 $sth ||= $dbh->prepare($stmt);
3612 $sth->execute($sql->values($href));
3615 The reason this works is because the keys in your C<$href> are sorted
3616 internally by B<SQL::Abstract>. Thus, as long as your data retains
3617 the same structure, you only have to generate the SQL the first time
3618 around. On subsequent queries, simply use the C<values> function provided
3619 by this module to return your values in the correct order.
3621 However this depends on the values having the same type - if, for
3622 example, the values of a where clause may either have values
3623 (resulting in sql of the form C<column = ?> with a single bind
3624 value), or alternatively the values might be C<undef> (resulting in
3625 sql of the form C<column IS NULL> with no bind value) then the
3626 caching technique suggested will not work.
3630 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3631 really like this part (I do, at least). Building up a complex query
3632 can be as simple as the following:
3639 use CGI::FormBuilder;
3642 my $form = CGI::FormBuilder->new(...);
3643 my $sql = SQL::Abstract->new;
3645 if ($form->submitted) {
3646 my $field = $form->field;
3647 my $id = delete $field->{id};
3648 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3651 Of course, you would still have to connect using C<DBI> to run the
3652 query, but the point is that if you make your form look like your
3653 table, the actual query script can be extremely simplistic.
3655 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3656 a fast interface to returning and formatting data. I frequently
3657 use these three modules together to write complex database query
3658 apps in under 50 lines.
3660 =head1 HOW TO CONTRIBUTE
3662 Contributions are always welcome, in all usable forms (we especially
3663 welcome documentation improvements). The delivery methods include git-
3664 or unified-diff formatted patches, GitHub pull requests, or plain bug
3665 reports either via RT or the Mailing list. Contributors are generally
3666 granted full access to the official repository after their first several
3667 patches pass successful review.
3669 This project is maintained in a git repository. The code and related tools are
3670 accessible at the following locations:
3674 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3676 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3678 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3680 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3686 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3687 Great care has been taken to preserve the I<published> behavior
3688 documented in previous versions in the 1.* family; however,
3689 some features that were previously undocumented, or behaved
3690 differently from the documentation, had to be changed in order
3691 to clarify the semantics. Hence, client code that was relying
3692 on some dark areas of C<SQL::Abstract> v1.*
3693 B<might behave differently> in v1.50.
3695 The main changes are:
3701 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3705 support for the { operator => \"..." } construct (to embed literal SQL)
3709 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3713 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3717 defensive programming: check arguments
3721 fixed bug with global logic, which was previously implemented
3722 through global variables yielding side-effects. Prior versions would
3723 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3724 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3725 Now this is interpreted
3726 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3731 fixed semantics of _bindtype on array args
3735 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3736 we just avoid shifting arrays within that tree.
3740 dropped the C<_modlogic> function
3744 =head1 ACKNOWLEDGEMENTS
3746 There are a number of individuals that have really helped out with
3747 this module. Unfortunately, most of them submitted bugs via CPAN
3748 so I have no idea who they are! But the people I do know are:
3750 Ash Berlin (order_by hash term support)
3751 Matt Trout (DBIx::Class support)
3752 Mark Stosberg (benchmarking)
3753 Chas Owens (initial "IN" operator support)
3754 Philip Collins (per-field SQL functions)
3755 Eric Kolve (hashref "AND" support)
3756 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3757 Dan Kubb (support for "quote_char" and "name_sep")
3758 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3759 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3760 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3761 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3762 Oliver Charles (support for "RETURNING" after "INSERT")
3768 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3772 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3774 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3776 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3777 While not an official support venue, C<DBIx::Class> makes heavy use of
3778 C<SQL::Abstract>, and as such list members there are very familiar with
3779 how to create queries.
3783 This module is free software; you may copy this under the same
3784 terms as perl itself (either the GNU General Public License or
3785 the Artistic License)