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 our $Cur_Col_Meta = $k;
437 my ($sql, @bind) = $self->_render_expr(
438 $self->_expand_expr_hashpair($op, $arg)
441 push @set, "$label = $sql";
442 push @all_bind, @bind;
444 SCALAR_or_UNDEF => sub {
445 push @set, "$label = ?";
446 push @all_bind, $self->_bindtype($k, $v);
452 my $sql = join ', ', @set;
454 return ($sql, @all_bind);
457 # So that subclasses can override UPDATE ... RETURNING separately from
459 sub _update_returning { shift->_returning(@_) }
463 #======================================================================
465 #======================================================================
470 my $table = $self->_table(shift);
471 my $fields = shift || '*';
475 my ($fields_sql, @bind) = $self->_select_fields($fields);
477 my ($where_sql, @where_bind) = $self->where($where, $order);
478 push @bind, @where_bind;
480 my $sql = join(' ', $self->_sqlcase('select'), $fields_sql,
481 $self->_sqlcase('from'), $table)
484 return wantarray ? ($sql, @bind) : $sql;
488 my ($self, $fields) = @_;
489 return ref $fields eq 'ARRAY' ? join ', ', map { $self->_quote($_) } @$fields
493 #======================================================================
495 #======================================================================
500 my $table = $self->_table(shift);
504 my($where_sql, @bind) = $self->where($where);
505 my $sql = $self->_sqlcase('delete from ') . $table . $where_sql;
507 if ($options->{returning}) {
508 my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
509 $sql .= $returning_sql;
510 push @bind, @returning_bind;
513 return wantarray ? ($sql, @bind) : $sql;
516 # So that subclasses can override DELETE ... RETURNING separately from
518 sub _delete_returning { shift->_returning(@_) }
522 #======================================================================
524 #======================================================================
528 # Finally, a separate routine just to handle WHERE clauses
530 my ($self, $where, $order) = @_;
533 my ($sql, @bind) = defined($where)
534 ? $self->_recurse_where($where)
536 $sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
540 my ($order_sql, @order_bind) = $self->_order_by($order);
542 push @bind, @order_bind;
545 return wantarray ? ($sql, @bind) : $sql;
549 my ($self, $expr, $logic) = @_;
550 return undef unless defined($expr);
551 if (ref($expr) eq 'HASH') {
552 if (keys %$expr > 1) {
556 map $self->_expand_expr_hashpair($_ => $expr->{$_}, $logic),
560 return unless %$expr;
561 return $self->_expand_expr_hashpair(%$expr, $logic);
563 if (ref($expr) eq 'ARRAY') {
564 my $logic = lc($logic || $self->{logic});
565 $logic eq 'and' or $logic eq 'or' or puke "unknown logic: $logic";
571 while (my ($el) = splice @expr, 0, 1) {
572 puke "Supplying an empty left hand side argument is not supported in array-pairs"
573 unless defined($el) and length($el);
574 my $elref = ref($el);
576 push(@res, $self->_expand_expr({ $el, shift(@expr) }));
577 } elsif ($elref eq 'ARRAY') {
578 push(@res, $self->_expand_expr($el)) if @$el;
579 } elsif (my $l = is_literal_value($el)) {
580 push @res, { -literal => $l };
581 } elsif ($elref eq 'HASH') {
582 push @res, $self->_expand_expr($el);
587 return { -op => [ $logic, @res ] };
589 if (my $literal = is_literal_value($expr)) {
590 return +{ -literal => $literal };
592 if (!ref($expr) or Scalar::Util::blessed($expr)) {
593 if (my $m = our $Cur_Col_Meta) {
594 return +{ -bind => [ $m, $expr ] };
596 return +{ -value => $expr };
601 sub _expand_expr_hashpair {
602 my ($self, $k, $v, $logic) = @_;
603 unless (defined($k) and length($k)) {
604 if (defined($k) and my $literal = is_literal_value($v)) {
605 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
606 return { -literal => $literal };
608 puke "Supplying an empty left hand side argument is not supported";
611 $self->_assert_pass_injection_guard($k =~ /^-(.*)$/s);
612 if ($k =~ s/ [_\s]? \d+ $//x ) {
613 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
614 . "You probably wanted ...-and => [ $k => COND1, $k => COND2 ... ]";
617 return $self->_expand_expr($v);
621 return $self->_expand_expr($v);
623 puke "-bool => undef not supported" unless defined($v);
624 return { -ident => $v };
627 return { -op => [ 'not', $self->_expand_expr($v) ] };
629 if (my ($rest) = $k =~/^-not[_ ](.*)$/) {
632 $self->_expand_expr_hashpair("-${rest}", $v, $logic)
635 if (my ($logic) = $k =~ /^-(and|or)$/i) {
636 if (ref($v) eq 'HASH') {
637 return $self->_expand_expr($v, $logic);
639 if (ref($v) eq 'ARRAY') {
640 return $self->_expand_expr($v, $logic);
645 $op =~ s/^-// if length($op) > 1;
647 # top level special ops are illegal in general
648 puke "Illegal use of top-level '-$op'"
649 if !(defined $self->{_nested_func_lhs})
650 and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
651 and not List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}};
653 if ($k eq '-value' and my $m = our $Cur_Col_Meta) {
654 return +{ -bind => [ $m, $v ] };
656 if ($k eq '-op' or $k eq '-ident' or $k eq '-value' or $k eq '-bind' or $k eq '-literal' or $k eq '-func') {
662 and (keys %$v)[0] =~ /^-/
664 my ($func) = $k =~ /^-(.*)$/;
665 return +{ -func => [ $func, $self->_expand_expr($v) ] };
667 if (!ref($v) or is_literal_value($v)) {
668 return +{ -op => [ $k =~ /^-(.*)$/, $self->_expand_expr($v) ] };
675 and exists $v->{-value}
676 and not defined $v->{-value}
679 return $self->_expand_expr_hashpair($k => { $self->{cmp} => undef });
681 if (!ref($v) or Scalar::Util::blessed($v)) {
686 { -bind => [ $k, $v ] }
690 if (ref($v) eq 'HASH') {
694 map $self->_expand_expr_hashpair($k => { $_ => $v->{$_} }),
701 $self->_assert_pass_injection_guard($vk);
702 if ($vk =~ s/ [_\s]? \d+ $//x ) {
703 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
704 . "You probably wanted ...-and => [ -$vk => COND1, -$vk => COND2 ... ]";
706 if ($vk =~ /^(?:not[ _])?between$/) {
707 local our $Cur_Col_Meta = $k;
708 my @rhs = map $self->_expand_expr($_),
709 ref($vv) eq 'ARRAY' ? @$vv : $vv;
711 (@rhs == 1 and ref($rhs[0]) eq 'HASH' and $rhs[0]->{-literal})
713 (@rhs == 2 and defined($rhs[0]) and defined($rhs[1]))
715 puke "Operator '${\uc($vk)}' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
718 join(' ', split '_', $vk),
723 if ($vk =~ /^(?:not[ _])?in$/) {
724 if (my $literal = is_literal_value($vv)) {
725 my ($sql, @bind) = @$literal;
726 my $opened_sql = $self->_open_outer_paren($sql);
728 $vk, { -ident => $k },
729 [ { -literal => [ $opened_sql, @bind ] } ]
733 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
734 . "-${\uc($vk)} operator was given an undef-containing list: !!!AUDIT YOUR CODE "
735 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
736 . 'will emit the logically correct SQL instead of raising this exception)'
738 puke("Argument passed to the '${\uc($vk)}' operator can not be undefined")
740 my @rhs = map $self->_expand_expr($_),
741 map { ref($_) ? $_ : { -bind => [ $k, $_ ] } }
742 map { defined($_) ? $_: puke($undef_err) }
743 (ref($vv) eq 'ARRAY' ? @$vv : $vv);
744 return $self->${\($vk =~ /^not/ ? 'sqltrue' : 'sqlfalse')} unless @rhs;
747 join(' ', split '_', $vk),
752 if ($vk eq 'ident') {
753 if (! defined $vv or ref $vv) {
754 puke "-$vk requires a single plain scalar argument (a quotable identifier)";
762 if ($vk eq 'value') {
763 return $self->_expand_expr_hashpair($k, undef) unless defined($vv);
767 { -bind => [ $k, $vv ] }
770 if ($vk =~ /^is(?:[ _]not)?$/) {
771 puke "$vk can only take undef as argument"
775 and exists($vv->{-value})
776 and !defined($vv->{-value})
779 return +{ -op => [ $vk.' null', { -ident => $k } ] };
781 if ($vk =~ /^(and|or)$/) {
782 if (ref($vv) eq 'HASH') {
785 map $self->_expand_expr_hashpair($k, { $_ => $vv->{$_} }),
790 if (my $us = List::Util::first { $vk =~ $_->{regex} } @{$self->{user_special_ops}}) {
791 return { -op => [ $vk, { -ident => $k }, $vv ] };
793 if (ref($vv) eq 'ARRAY') {
794 my ($logic, @values) = (
795 (defined($vv->[0]) and $vv->[0] =~ /^-(and|or)$/i)
800 $vk =~ $self->{inequality_op}
801 or join(' ', split '_', $vk) =~ $self->{not_like_op}
803 if (lc($logic) eq '-or' and @values > 1) {
804 my $op = uc join ' ', split '_', $vk;
805 belch "A multi-element arrayref as an argument to the inequality op '$op' "
806 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
807 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
812 # try to DWIM on equality operators
813 my $op = join ' ', split '_', $vk;
815 $op =~ $self->{equality_op} ? $self->sqlfalse
816 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqlfalse
817 : $op =~ $self->{inequality_op} ? $self->sqltrue
818 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqltrue
819 : puke "operator '$op' applied on an empty array (field '$k')";
823 map $self->_expand_expr_hashpair($k => { $vk => $_ }),
831 and exists $vv->{-value}
832 and not defined $vv->{-value}
835 my $op = join ' ', split '_', $vk;
837 $op =~ /^not$/i ? 'is not' # legacy
838 : $op =~ $self->{equality_op} ? 'is'
839 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
840 : $op =~ $self->{inequality_op} ? 'is not'
841 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
842 : puke "unexpected operator '$op' with undef operand";
843 return +{ -op => [ $is.' null', { -ident => $k } ] };
845 local our $Cur_Col_Meta = $k;
849 $self->_expand_expr($vv)
852 if (ref($v) eq 'ARRAY') {
853 return $self->sqlfalse unless @$v;
854 $self->_debug("ARRAY($k) means distribute over elements");
856 $v->[0] =~ /^-((?:and|or))$/i
857 ? ($v = [ @{$v}[1..$#$v] ], $1)
858 : ($self->{logic} || 'or')
862 map $self->_expand_expr({ $k => $_ }, $this_logic), @$v
865 if (my $literal = is_literal_value($v)) {
867 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
870 my ($sql, @bind) = @$literal;
871 if ($self->{bindtype} eq 'columns') {
873 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
874 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
878 return +{ -literal => [ $self->_quote($k).' '.$sql, @bind ] };
884 my ($self, $expr) = @_;
885 my ($k, $v, @rest) = %$expr;
887 my %op = map +("-$_" => '_where_op_'.uc($_)),
888 qw(op func value bind ident literal);
889 if (my $meth = $op{$k}) {
890 return $self->$meth(undef, $v);
892 die "notreached: $k";
896 my ($self, $where, $logic) = @_;
898 #print STDERR Data::Dumper::Concise::Dumper([ $where, $logic ]);
900 my $where_exp = $self->_expand_expr($where, $logic);
902 #print STDERR Data::Dumper::Concise::Dumper([ EXP => $where_exp ]);
904 # dispatch on appropriate method according to refkind of $where
905 # my $method = $self->_METHOD_FOR_refkind("_where", $where_exp);
907 # my ($sql, @bind) = $self->$method($where_exp, $logic);
909 my ($sql, @bind) = defined($where_exp) ? $self->_render_expr($where_exp) : (undef);
911 # DBIx::Class used to call _recurse_where in scalar context
912 # something else might too...
914 return ($sql, @bind);
917 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
922 sub _where_op_IDENT {
924 my ($op, $rhs) = splice @_, -2;
925 if (! defined $rhs or length ref $rhs) {
926 puke "-$op requires a single plain scalar argument (a quotable identifier)";
929 # in case we are called as a top level special op (no '=')
930 my $has_lhs = my $lhs = shift;
932 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
940 sub _where_op_VALUE {
942 my ($op, $rhs) = splice @_, -2;
944 # in case we are called as a top level special op (no '=')
948 if (! defined $rhs) {
950 ? $self->_where_hashpair_HASHREF($lhs, { -is => undef })
957 (defined $lhs ? $lhs : $self->{_nested_func_lhs}),
964 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
968 $self->_convert('?'),
975 my %unop_postfix = map +($_ => 1), 'is null', 'is not null';
981 my ($self, $args) = @_;
982 my ($left, $low, $high) = @$args;
983 my ($rhsql, @rhbind) = do {
985 puke "Single arg to between must be a literal"
986 unless $low->{-literal};
989 my ($l, $h) = map [ $self->_render_expr($_) ], $low, $high;
990 (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
991 @{$l}[1..$#$l], @{$h}[1..$#$h])
994 my ($lhsql, @lhbind) = $self->_render_expr($left);
996 join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
1000 }), 'between', 'not between'),
1004 my ($self, $args) = @_;
1005 my ($lhs, $rhs) = @$args;
1008 my ($sql, @bind) = $self->_render_expr($_);
1009 push @in_bind, @bind;
1012 my ($lhsql, @lbind) = $self->_render_expr($lhs);
1014 $lhsql.' '.$self->_sqlcase($op).' ( '
1015 .join(', ', @in_sql)
1020 }), 'in', 'not in'),
1024 my ($self, undef, $v) = @_;
1025 my ($op, @args) = @$v;
1026 $op =~ s/^-// if length($op) > 1;
1028 local $self->{_nested_func_lhs};
1029 if (my $h = $special{$op}) {
1030 return $self->$h(\@args);
1032 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{user_special_ops}}) {
1033 puke "Special op '${op}' requires first value to be identifier"
1034 unless my ($k) = map $_->{-ident}, grep ref($_) eq 'HASH', $args[0];
1035 return $self->${\($us->{handler})}($k, $op, $args[1]);
1037 my $final_op = $op =~ /^(?:is|not)_/ ? join(' ', split '_', $op) : $op;
1038 if (@args == 1 and $op !~ /^(and|or)$/) {
1039 my ($expr_sql, @bind) = $self->_render_expr($args[0]);
1040 my $op_sql = $self->_sqlcase($final_op);
1042 $unop_postfix{lc($final_op)}
1043 ? "${expr_sql} ${op_sql}"
1044 : "${op_sql} ${expr_sql}"
1046 return (($op eq 'not' ? '('.$final_sql.')' : $final_sql), @bind);
1048 my @parts = map [ $self->_render_expr($_) ], @args;
1049 my ($final_sql) = map +($op =~ /^(and|or)$/ ? "(${_})" : $_), join(
1050 ' '.$self->_sqlcase($final_op).' ',
1055 map @{$_}[1..$#$_], @parts
1061 sub _where_op_FUNC {
1062 my ($self, undef, $rest) = @_;
1063 my ($func, @args) = @$rest;
1067 push @arg_sql, shift @x;
1069 } map [ $self->_render_expr($_) ], @args;
1070 return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
1073 sub _where_op_BIND {
1074 my ($self, undef, $bind) = @_;
1075 return ($self->_convert('?'), $self->_bindtype(@$bind));
1078 sub _where_op_LITERAL {
1079 my ($self, undef, $literal) = @_;
1080 $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
1084 sub _where_hashpair_ARRAYREF {
1085 my ($self, $k, $v) = @_;
1088 my @v = @$v; # need copy because of shift below
1089 $self->_debug("ARRAY($k) means distribute over elements");
1091 # put apart first element if it is an operator (-and, -or)
1093 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
1097 my @distributed = map { {$k => $_} } @v;
1100 $self->_debug("OP($op) reinjected into the distributed array");
1101 unshift @distributed, $op;
1104 my $logic = $op ? substr($op, 1) : '';
1106 return $self->_recurse_where(\@distributed, $logic);
1109 $self->_debug("empty ARRAY($k) means 0=1");
1110 return ($self->{sqlfalse});
1114 sub _where_hashpair_HASHREF {
1115 my ($self, $k, $v, $logic) = @_;
1118 local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
1119 ? $self->{_nested_func_lhs}
1123 my ($all_sql, @all_bind);
1125 for my $orig_op (sort keys %$v) {
1126 my $val = $v->{$orig_op};
1128 # put the operator in canonical form
1131 # FIXME - we need to phase out dash-less ops
1132 $op =~ s/^-//; # remove possible initial dash
1133 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
1134 $op =~ s/\s+/ /g; # compress whitespace
1136 $self->_assert_pass_injection_guard($op);
1139 $op =~ s/^is_not/IS NOT/i;
1141 # so that -not_foo works correctly
1142 $op =~ s/^not_/NOT /i;
1144 # another retarded special case: foo => { $op => { -value => undef } }
1145 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
1151 # CASE: col-value logic modifiers
1152 if ($orig_op =~ /^ \- (and|or) $/xi) {
1153 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
1155 # CASE: special operators like -in or -between
1156 elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
1157 my $handler = $special_op->{handler};
1159 puke "No handler supplied for special operator $orig_op";
1161 elsif (not ref $handler) {
1162 ($sql, @bind) = $self->$handler($k, $op, $val);
1164 elsif (ref $handler eq 'CODE') {
1165 ($sql, @bind) = $handler->($self, $k, $op, $val);
1168 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
1172 $self->_SWITCH_refkind($val, {
1174 ARRAYREF => sub { # CASE: col => {op => \@vals}
1175 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
1178 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
1179 my ($sub_sql, @sub_bind) = @$$val;
1180 $self->_assert_bindval_matches_bindtype(@sub_bind);
1181 $sql = join ' ', $self->_convert($self->_quote($k)),
1182 $self->_sqlcase($op),
1187 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
1189 $op =~ /^not$/i ? 'is not' # legacy
1190 : $op =~ $self->{equality_op} ? 'is'
1191 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
1192 : $op =~ $self->{inequality_op} ? 'is not'
1193 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
1194 : puke "unexpected operator '$orig_op' with undef operand";
1196 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
1199 FALLBACK => sub { # CASE: col => {op/func => $stuff}
1200 ($sql, @bind) = $self->_where_unary_op($op, $val);
1203 $self->_convert($self->_quote($k)),
1204 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
1210 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
1211 push @all_bind, @bind;
1213 return ($all_sql, @all_bind);
1216 sub _where_field_IS {
1217 my ($self, $k, $op, $v) = @_;
1219 my ($s) = $self->_SWITCH_refkind($v, {
1222 $self->_convert($self->_quote($k)),
1223 map { $self->_sqlcase($_)} ($op, 'null')
1226 puke "$op can only take undef as argument";
1233 sub _where_field_op_ARRAYREF {
1234 my ($self, $k, $op, $vals) = @_;
1236 my @vals = @$vals; #always work on a copy
1239 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
1241 join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
1244 # see if the first element is an -and/-or op
1246 if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) {
1251 # a long standing API wart - an attempt to change this behavior during
1252 # the 1.50 series failed *spectacularly*. Warn instead and leave the
1257 (!$logic or $logic eq 'OR')
1259 ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op})
1262 belch "A multi-element arrayref as an argument to the inequality op '$o' "
1263 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
1264 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1268 # distribute $op over each remaining member of @vals, append logic if exists
1269 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1273 # try to DWIM on equality operators
1275 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1276 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1277 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1278 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1279 : puke "operator '$op' applied on an empty array (field '$k')";
1284 sub _where_hashpair_SCALARREF {
1285 my ($self, $k, $v) = @_;
1286 $self->_debug("SCALAR($k) means literal SQL: $$v");
1287 my $sql = $self->_quote($k) . " " . $$v;
1291 # literal SQL with bind
1292 sub _where_hashpair_ARRAYREFREF {
1293 my ($self, $k, $v) = @_;
1294 $self->_debug("REF($k) means literal SQL: @${$v}");
1295 my ($sql, @bind) = @$$v;
1296 $self->_assert_bindval_matches_bindtype(@bind);
1297 $sql = $self->_quote($k) . " " . $sql;
1298 return ($sql, @bind );
1301 # literal SQL without bind
1302 sub _where_hashpair_SCALAR {
1303 my ($self, $k, $v) = @_;
1304 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1305 return ($self->_where_hashpair_HASHREF($k, { $self->{cmp} => $v }));
1309 sub _where_hashpair_UNDEF {
1310 my ($self, $k, $v) = @_;
1311 $self->_debug("UNDEF($k) means IS NULL");
1312 return $self->_where_hashpair_HASHREF($k, { -is => undef });
1315 #======================================================================
1316 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1317 #======================================================================
1320 sub _where_SCALARREF {
1321 my ($self, $where) = @_;
1324 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1330 my ($self, $where) = @_;
1333 $self->_debug("NOREF(*top) means literal SQL: $where");
1344 #======================================================================
1345 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1346 #======================================================================
1349 sub _where_field_BETWEEN {
1350 my ($self, $k, $op, $vals) = @_;
1352 my ($label, $and, $placeholder);
1353 $label = $self->_convert($self->_quote($k));
1354 $and = ' ' . $self->_sqlcase('and') . ' ';
1355 $placeholder = $self->_convert('?');
1356 $op = $self->_sqlcase($op);
1358 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1360 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1361 ARRAYREFREF => sub {
1362 my ($s, @b) = @$$vals;
1363 $self->_assert_bindval_matches_bindtype(@b);
1370 puke $invalid_args if @$vals != 2;
1372 my (@all_sql, @all_bind);
1373 foreach my $val (@$vals) {
1374 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1376 return ($placeholder, $self->_bindtype($k, $val) );
1381 ARRAYREFREF => sub {
1382 my ($sql, @bind) = @$$val;
1383 $self->_assert_bindval_matches_bindtype(@bind);
1384 return ($sql, @bind);
1387 my ($func, $arg, @rest) = %$val;
1388 puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN"
1389 if (@rest or $func !~ /^ \- (.+)/x);
1390 $self->_where_unary_op($1 => $arg);
1396 push @all_sql, $sql;
1397 push @all_bind, @bind;
1401 (join $and, @all_sql),
1410 my $sql = "( $label $op $clause )";
1411 return ($sql, @bind)
1415 sub _where_field_IN {
1416 my ($self, $k, $op, $vals) = @_;
1418 # backwards compatibility: if scalar, force into an arrayref
1419 $vals = [$vals] if defined $vals && ! ref $vals;
1421 my ($label) = $self->_convert($self->_quote($k));
1422 my ($placeholder) = $self->_convert('?');
1423 $op = $self->_sqlcase($op);
1425 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1426 ARRAYREF => sub { # list of choices
1427 if (@$vals) { # nonempty list
1428 my (@all_sql, @all_bind);
1430 for my $val (@$vals) {
1431 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1433 return ($placeholder, $val);
1438 ARRAYREFREF => sub {
1439 my ($sql, @bind) = @$$val;
1440 $self->_assert_bindval_matches_bindtype(@bind);
1441 return ($sql, @bind);
1444 my ($func, $arg, @rest) = %$val;
1445 puke "Only simple { -func => arg } functions accepted as sub-arguments to IN"
1446 if (@rest or $func !~ /^ \- (.+)/x);
1447 $self->_where_unary_op($1 => $arg);
1451 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1452 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1453 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1454 . 'will emit the logically correct SQL instead of raising this exception)'
1458 push @all_sql, $sql;
1459 push @all_bind, @bind;
1463 sprintf('%s %s ( %s )',
1466 join(', ', @all_sql)
1468 $self->_bindtype($k, @all_bind),
1471 else { # empty list: some databases won't understand "IN ()", so DWIM
1472 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1477 SCALARREF => sub { # literal SQL
1478 my $sql = $self->_open_outer_paren($$vals);
1479 return ("$label $op ( $sql )");
1481 ARRAYREFREF => sub { # literal SQL with bind
1482 my ($sql, @bind) = @$$vals;
1483 $self->_assert_bindval_matches_bindtype(@bind);
1484 $sql = $self->_open_outer_paren($sql);
1485 return ("$label $op ( $sql )", @bind);
1489 puke "Argument passed to the '$op' operator can not be undefined";
1493 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1497 return ($sql, @bind);
1500 # Some databases (SQLite) treat col IN (1, 2) different from
1501 # col IN ( (1, 2) ). Use this to strip all outer parens while
1502 # adding them back in the corresponding method
1503 sub _open_outer_paren {
1504 my ($self, $sql) = @_;
1506 while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
1508 # there are closing parens inside, need the heavy duty machinery
1509 # to reevaluate the extraction starting from $sql (full reevaluation)
1510 if ($inner =~ /\)/) {
1511 require Text::Balanced;
1513 my (undef, $remainder) = do {
1514 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1516 Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
1519 # the entire expression needs to be a balanced bracketed thing
1520 # (after an extract no remainder sans trailing space)
1521 last if defined $remainder and $remainder =~ /\S/;
1531 #======================================================================
1533 #======================================================================
1536 my ($self, $arg) = @_;
1539 for my $c ($self->_order_by_chunks($arg) ) {
1540 $self->_SWITCH_refkind($c, {
1541 SCALAR => sub { push @sql, $c },
1542 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1548 $self->_sqlcase(' order by'),
1554 return wantarray ? ($sql, @bind) : $sql;
1557 sub _order_by_chunks {
1558 my ($self, $arg) = @_;
1560 return $self->_SWITCH_refkind($arg, {
1563 map { $self->_order_by_chunks($_ ) } @$arg;
1566 ARRAYREFREF => sub {
1567 my ($s, @b) = @$$arg;
1568 $self->_assert_bindval_matches_bindtype(@b);
1572 SCALAR => sub {$self->_quote($arg)},
1574 UNDEF => sub {return () },
1576 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1579 # get first pair in hash
1580 my ($key, $val, @rest) = %$arg;
1582 return () unless $key;
1584 if (@rest or not $key =~ /^-(desc|asc)/i) {
1585 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1591 for my $c ($self->_order_by_chunks($val)) {
1594 $self->_SWITCH_refkind($c, {
1599 ($sql, @bind) = @$c;
1603 $sql = $sql . ' ' . $self->_sqlcase($direction);
1605 push @ret, [ $sql, @bind];
1614 #======================================================================
1615 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1616 #======================================================================
1621 $self->_SWITCH_refkind($from, {
1622 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1623 SCALAR => sub {$self->_quote($from)},
1624 SCALARREF => sub {$$from},
1629 #======================================================================
1631 #======================================================================
1633 # highly optimized, as it's called way too often
1635 # my ($self, $label) = @_;
1637 return '' unless defined $_[1];
1638 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1640 $_[0]->{quote_char} or
1641 ($_[0]->_assert_pass_injection_guard($_[1]), return $_[1]);
1643 my $qref = ref $_[0]->{quote_char};
1645 !$qref ? ($_[0]->{quote_char}, $_[0]->{quote_char})
1646 : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}}
1647 : puke "Unsupported quote_char format: $_[0]->{quote_char}";
1649 my $esc = $_[0]->{escape_char} || $r;
1651 # parts containing * are naturally unquoted
1652 return join($_[0]->{name_sep}||'', map
1653 +( $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } ),
1654 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1659 # Conversion, if applicable
1661 #my ($self, $arg) = @_;
1662 if ($_[0]->{convert}) {
1663 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1670 #my ($self, $col, @vals) = @_;
1671 # called often - tighten code
1672 return $_[0]->{bindtype} eq 'columns'
1673 ? map {[$_[1], $_]} @_[2 .. $#_]
1678 # Dies if any element of @bind is not in [colname => value] format
1679 # if bindtype is 'columns'.
1680 sub _assert_bindval_matches_bindtype {
1681 # my ($self, @bind) = @_;
1683 if ($self->{bindtype} eq 'columns') {
1685 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1686 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1692 sub _join_sql_clauses {
1693 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1695 if (@$clauses_aref > 1) {
1696 my $join = " " . $self->_sqlcase($logic) . " ";
1697 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1698 return ($sql, @$bind_aref);
1700 elsif (@$clauses_aref) {
1701 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1704 return (); # if no SQL, ignore @$bind_aref
1709 # Fix SQL case, if so requested
1711 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1712 # don't touch the argument ... crooked logic, but let's not change it!
1713 return $_[0]->{case} ? $_[1] : uc($_[1]);
1717 #======================================================================
1718 # DISPATCHING FROM REFKIND
1719 #======================================================================
1722 my ($self, $data) = @_;
1724 return 'UNDEF' unless defined $data;
1726 # blessed objects are treated like scalars
1727 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1729 return 'SCALAR' unless $ref;
1732 while ($ref eq 'REF') {
1734 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1738 return ($ref||'SCALAR') . ('REF' x $n_steps);
1742 my ($self, $data) = @_;
1743 my @try = ($self->_refkind($data));
1744 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1745 push @try, 'FALLBACK';
1749 sub _METHOD_FOR_refkind {
1750 my ($self, $meth_prefix, $data) = @_;
1753 for (@{$self->_try_refkind($data)}) {
1754 $method = $self->can($meth_prefix."_".$_)
1758 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1762 sub _SWITCH_refkind {
1763 my ($self, $data, $dispatch_table) = @_;
1766 for (@{$self->_try_refkind($data)}) {
1767 $coderef = $dispatch_table->{$_}
1771 puke "no dispatch entry for ".$self->_refkind($data)
1780 #======================================================================
1781 # VALUES, GENERATE, AUTOLOAD
1782 #======================================================================
1784 # LDNOTE: original code from nwiger, didn't touch code in that section
1785 # I feel the AUTOLOAD stuff should not be the default, it should
1786 # only be activated on explicit demand by user.
1790 my $data = shift || return;
1791 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1792 unless ref $data eq 'HASH';
1795 foreach my $k (sort keys %$data) {
1796 my $v = $data->{$k};
1797 $self->_SWITCH_refkind($v, {
1799 if ($self->{array_datatypes}) { # array datatype
1800 push @all_bind, $self->_bindtype($k, $v);
1802 else { # literal SQL with bind
1803 my ($sql, @bind) = @$v;
1804 $self->_assert_bindval_matches_bindtype(@bind);
1805 push @all_bind, @bind;
1808 ARRAYREFREF => sub { # literal SQL with bind
1809 my ($sql, @bind) = @${$v};
1810 $self->_assert_bindval_matches_bindtype(@bind);
1811 push @all_bind, @bind;
1813 SCALARREF => sub { # literal SQL without bind
1815 SCALAR_or_UNDEF => sub {
1816 push @all_bind, $self->_bindtype($k, $v);
1827 my(@sql, @sqlq, @sqlv);
1831 if ($ref eq 'HASH') {
1832 for my $k (sort keys %$_) {
1835 my $label = $self->_quote($k);
1836 if ($r eq 'ARRAY') {
1837 # literal SQL with bind
1838 my ($sql, @bind) = @$v;
1839 $self->_assert_bindval_matches_bindtype(@bind);
1840 push @sqlq, "$label = $sql";
1842 } elsif ($r eq 'SCALAR') {
1843 # literal SQL without bind
1844 push @sqlq, "$label = $$v";
1846 push @sqlq, "$label = ?";
1847 push @sqlv, $self->_bindtype($k, $v);
1850 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1851 } elsif ($ref eq 'ARRAY') {
1852 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1855 if ($r eq 'ARRAY') { # literal SQL with bind
1856 my ($sql, @bind) = @$v;
1857 $self->_assert_bindval_matches_bindtype(@bind);
1860 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1861 # embedded literal SQL
1868 push @sql, '(' . join(', ', @sqlq) . ')';
1869 } elsif ($ref eq 'SCALAR') {
1873 # strings get case twiddled
1874 push @sql, $self->_sqlcase($_);
1878 my $sql = join ' ', @sql;
1880 # this is pretty tricky
1881 # if ask for an array, return ($stmt, @bind)
1882 # otherwise, s/?/shift @sqlv/ to put it inline
1884 return ($sql, @sqlv);
1886 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1887 ref $d ? $d->[1] : $d/e;
1896 # This allows us to check for a local, then _form, attr
1898 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1899 return $self->generate($name, @_);
1910 SQL::Abstract - Generate SQL from Perl data structures
1916 my $sql = SQL::Abstract->new;
1918 my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order);
1920 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1922 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1924 my($stmt, @bind) = $sql->delete($table, \%where);
1926 # Then, use these in your DBI statements
1927 my $sth = $dbh->prepare($stmt);
1928 $sth->execute(@bind);
1930 # Just generate the WHERE clause
1931 my($stmt, @bind) = $sql->where(\%where, $order);
1933 # Return values in the same order, for hashed queries
1934 # See PERFORMANCE section for more details
1935 my @bind = $sql->values(\%fieldvals);
1939 This module was inspired by the excellent L<DBIx::Abstract>.
1940 However, in using that module I found that what I really wanted
1941 to do was generate SQL, but still retain complete control over my
1942 statement handles and use the DBI interface. So, I set out to
1943 create an abstract SQL generation module.
1945 While based on the concepts used by L<DBIx::Abstract>, there are
1946 several important differences, especially when it comes to WHERE
1947 clauses. I have modified the concepts used to make the SQL easier
1948 to generate from Perl data structures and, IMO, more intuitive.
1949 The underlying idea is for this module to do what you mean, based
1950 on the data structures you provide it. The big advantage is that
1951 you don't have to modify your code every time your data changes,
1952 as this module figures it out.
1954 To begin with, an SQL INSERT is as easy as just specifying a hash
1955 of C<key=value> pairs:
1958 name => 'Jimbo Bobson',
1959 phone => '123-456-7890',
1960 address => '42 Sister Lane',
1961 city => 'St. Louis',
1962 state => 'Louisiana',
1965 The SQL can then be generated with this:
1967 my($stmt, @bind) = $sql->insert('people', \%data);
1969 Which would give you something like this:
1971 $stmt = "INSERT INTO people
1972 (address, city, name, phone, state)
1973 VALUES (?, ?, ?, ?, ?)";
1974 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1975 '123-456-7890', 'Louisiana');
1977 These are then used directly in your DBI code:
1979 my $sth = $dbh->prepare($stmt);
1980 $sth->execute(@bind);
1982 =head2 Inserting and Updating Arrays
1984 If your database has array types (like for example Postgres),
1985 activate the special option C<< array_datatypes => 1 >>
1986 when creating the C<SQL::Abstract> object.
1987 Then you may use an arrayref to insert and update database array types:
1989 my $sql = SQL::Abstract->new(array_datatypes => 1);
1991 planets => [qw/Mercury Venus Earth Mars/]
1994 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1998 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
2000 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
2003 =head2 Inserting and Updating SQL
2005 In order to apply SQL functions to elements of your C<%data> you may
2006 specify a reference to an arrayref for the given hash value. For example,
2007 if you need to execute the Oracle C<to_date> function on a value, you can
2008 say something like this:
2012 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
2015 The first value in the array is the actual SQL. Any other values are
2016 optional and would be included in the bind values array. This gives
2019 my($stmt, @bind) = $sql->insert('people', \%data);
2021 $stmt = "INSERT INTO people (name, date_entered)
2022 VALUES (?, to_date(?,'MM/DD/YYYY'))";
2023 @bind = ('Bill', '03/02/2003');
2025 An UPDATE is just as easy, all you change is the name of the function:
2027 my($stmt, @bind) = $sql->update('people', \%data);
2029 Notice that your C<%data> isn't touched; the module will generate
2030 the appropriately quirky SQL for you automatically. Usually you'll
2031 want to specify a WHERE clause for your UPDATE, though, which is
2032 where handling C<%where> hashes comes in handy...
2034 =head2 Complex where statements
2036 This module can generate pretty complicated WHERE statements
2037 easily. For example, simple C<key=value> pairs are taken to mean
2038 equality, and if you want to see if a field is within a set
2039 of values, you can use an arrayref. Let's say we wanted to
2040 SELECT some data based on this criteria:
2043 requestor => 'inna',
2044 worker => ['nwiger', 'rcwe', 'sfz'],
2045 status => { '!=', 'completed' }
2048 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
2050 The above would give you something like this:
2052 $stmt = "SELECT * FROM tickets WHERE
2053 ( requestor = ? ) AND ( status != ? )
2054 AND ( worker = ? OR worker = ? OR worker = ? )";
2055 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
2057 Which you could then use in DBI code like so:
2059 my $sth = $dbh->prepare($stmt);
2060 $sth->execute(@bind);
2066 The methods are simple. There's one for every major SQL operation,
2067 and a constructor you use first. The arguments are specified in a
2068 similar order for each method (table, then fields, then a where
2069 clause) to try and simplify things.
2071 =head2 new(option => 'value')
2073 The C<new()> function takes a list of options and values, and returns
2074 a new B<SQL::Abstract> object which can then be used to generate SQL
2075 through the methods below. The options accepted are:
2081 If set to 'lower', then SQL will be generated in all lowercase. By
2082 default SQL is generated in "textbook" case meaning something like:
2084 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
2086 Any setting other than 'lower' is ignored.
2090 This determines what the default comparison operator is. By default
2091 it is C<=>, meaning that a hash like this:
2093 %where = (name => 'nwiger', email => 'nate@wiger.org');
2095 Will generate SQL like this:
2097 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
2099 However, you may want loose comparisons by default, so if you set
2100 C<cmp> to C<like> you would get SQL such as:
2102 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
2104 You can also override the comparison on an individual basis - see
2105 the huge section on L</"WHERE CLAUSES"> at the bottom.
2107 =item sqltrue, sqlfalse
2109 Expressions for inserting boolean values within SQL statements.
2110 By default these are C<1=1> and C<1=0>. They are used
2111 by the special operators C<-in> and C<-not_in> for generating
2112 correct SQL even when the argument is an empty array (see below).
2116 This determines the default logical operator for multiple WHERE
2117 statements in arrays or hashes. If absent, the default logic is "or"
2118 for arrays, and "and" for hashes. This means that a WHERE
2122 event_date => {'>=', '2/13/99'},
2123 event_date => {'<=', '4/24/03'},
2126 will generate SQL like this:
2128 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
2130 This is probably not what you want given this query, though (look
2131 at the dates). To change the "OR" to an "AND", simply specify:
2133 my $sql = SQL::Abstract->new(logic => 'and');
2135 Which will change the above C<WHERE> to:
2137 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
2139 The logic can also be changed locally by inserting
2140 a modifier in front of an arrayref:
2142 @where = (-and => [event_date => {'>=', '2/13/99'},
2143 event_date => {'<=', '4/24/03'} ]);
2145 See the L</"WHERE CLAUSES"> section for explanations.
2149 This will automatically convert comparisons using the specified SQL
2150 function for both column and value. This is mostly used with an argument
2151 of C<upper> or C<lower>, so that the SQL will have the effect of
2152 case-insensitive "searches". For example, this:
2154 $sql = SQL::Abstract->new(convert => 'upper');
2155 %where = (keywords => 'MaKe iT CAse inSeNSItive');
2157 Will turn out the following SQL:
2159 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
2161 The conversion can be C<upper()>, C<lower()>, or any other SQL function
2162 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
2163 not validate this option; it will just pass through what you specify verbatim).
2167 This is a kludge because many databases suck. For example, you can't
2168 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
2169 Instead, you have to use C<bind_param()>:
2171 $sth->bind_param(1, 'reg data');
2172 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
2174 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
2175 which loses track of which field each slot refers to. Fear not.
2177 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
2178 Currently, you can specify either C<normal> (default) or C<columns>. If you
2179 specify C<columns>, you will get an array that looks like this:
2181 my $sql = SQL::Abstract->new(bindtype => 'columns');
2182 my($stmt, @bind) = $sql->insert(...);
2185 [ 'column1', 'value1' ],
2186 [ 'column2', 'value2' ],
2187 [ 'column3', 'value3' ],
2190 You can then iterate through this manually, using DBI's C<bind_param()>.
2192 $sth->prepare($stmt);
2195 my($col, $data) = @$_;
2196 if ($col eq 'details' || $col eq 'comments') {
2197 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
2198 } elsif ($col eq 'image') {
2199 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
2201 $sth->bind_param($i, $data);
2205 $sth->execute; # execute without @bind now
2207 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
2208 Basically, the advantage is still that you don't have to care which fields
2209 are or are not included. You could wrap that above C<for> loop in a simple
2210 sub called C<bind_fields()> or something and reuse it repeatedly. You still
2211 get a layer of abstraction over manual SQL specification.
2213 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
2214 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
2215 will expect the bind values in this format.
2219 This is the character that a table or column name will be quoted
2220 with. By default this is an empty string, but you could set it to
2221 the character C<`>, to generate SQL like this:
2223 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
2225 Alternatively, you can supply an array ref of two items, the first being the left
2226 hand quote character, and the second the right hand quote character. For
2227 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
2228 that generates SQL like this:
2230 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
2232 Quoting is useful if you have tables or columns names that are reserved
2233 words in your database's SQL dialect.
2237 This is the character that will be used to escape L</quote_char>s appearing
2238 in an identifier before it has been quoted.
2240 The parameter default in case of a single L</quote_char> character is the quote
2243 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
2244 this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences
2245 of the B<opening (left)> L</quote_char> within the identifier are currently left
2246 untouched. The default for opening-closing-style quotes may change in future
2247 versions, thus you are B<strongly encouraged> to specify the escape character
2252 This is the character that separates a table and column name. It is
2253 necessary to specify this when the C<quote_char> option is selected,
2254 so that tables and column names can be individually quoted like this:
2256 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2258 =item injection_guard
2260 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2261 column name specified in a query structure. This is a safety mechanism to avoid
2262 injection attacks when mishandling user input e.g.:
2264 my %condition_as_column_value_pairs = get_values_from_user();
2265 $sqla->select( ... , \%condition_as_column_value_pairs );
2267 If the expression matches an exception is thrown. Note that literal SQL
2268 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2270 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2272 =item array_datatypes
2274 When this option is true, arrayrefs in INSERT or UPDATE are
2275 interpreted as array datatypes and are passed directly
2277 When this option is false, arrayrefs are interpreted
2278 as literal SQL, just like refs to arrayrefs
2279 (but this behavior is for backwards compatibility; when writing
2280 new queries, use the "reference to arrayref" syntax
2286 Takes a reference to a list of "special operators"
2287 to extend the syntax understood by L<SQL::Abstract>.
2288 See section L</"SPECIAL OPERATORS"> for details.
2292 Takes a reference to a list of "unary operators"
2293 to extend the syntax understood by L<SQL::Abstract>.
2294 See section L</"UNARY OPERATORS"> for details.
2300 =head2 insert($table, \@values || \%fieldvals, \%options)
2302 This is the simplest function. You simply give it a table name
2303 and either an arrayref of values or hashref of field/value pairs.
2304 It returns an SQL INSERT statement and a list of bind values.
2305 See the sections on L</"Inserting and Updating Arrays"> and
2306 L</"Inserting and Updating SQL"> for information on how to insert
2307 with those data types.
2309 The optional C<\%options> hash reference may contain additional
2310 options to generate the insert SQL. Currently supported options
2317 Takes either a scalar of raw SQL fields, or an array reference of
2318 field names, and adds on an SQL C<RETURNING> statement at the end.
2319 This allows you to return data generated by the insert statement
2320 (such as row IDs) without performing another C<SELECT> statement.
2321 Note, however, this is not part of the SQL standard and may not
2322 be supported by all database engines.
2326 =head2 update($table, \%fieldvals, \%where, \%options)
2328 This takes a table, hashref of field/value pairs, and an optional
2329 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2331 See the sections on L</"Inserting and Updating Arrays"> and
2332 L</"Inserting and Updating SQL"> for information on how to insert
2333 with those data types.
2335 The optional C<\%options> hash reference may contain additional
2336 options to generate the update SQL. Currently supported options
2343 See the C<returning> option to
2344 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2348 =head2 select($source, $fields, $where, $order)
2350 This returns a SQL SELECT statement and associated list of bind values, as
2351 specified by the arguments:
2357 Specification of the 'FROM' part of the statement.
2358 The argument can be either a plain scalar (interpreted as a table
2359 name, will be quoted), or an arrayref (interpreted as a list
2360 of table names, joined by commas, quoted), or a scalarref
2361 (literal SQL, not quoted).
2365 Specification of the list of fields to retrieve from
2367 The argument can be either an arrayref (interpreted as a list
2368 of field names, will be joined by commas and quoted), or a
2369 plain scalar (literal SQL, not quoted).
2370 Please observe that this API is not as flexible as that of
2371 the first argument C<$source>, for backwards compatibility reasons.
2375 Optional argument to specify the WHERE part of the query.
2376 The argument is most often a hashref, but can also be
2377 an arrayref or plain scalar --
2378 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2382 Optional argument to specify the ORDER BY part of the query.
2383 The argument can be a scalar, a hashref or an arrayref
2384 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2390 =head2 delete($table, \%where, \%options)
2392 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2393 It returns an SQL DELETE statement and list of bind values.
2395 The optional C<\%options> hash reference may contain additional
2396 options to generate the delete SQL. Currently supported options
2403 See the C<returning> option to
2404 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2408 =head2 where(\%where, $order)
2410 This is used to generate just the WHERE clause. For example,
2411 if you have an arbitrary data structure and know what the
2412 rest of your SQL is going to look like, but want an easy way
2413 to produce a WHERE clause, use this. It returns an SQL WHERE
2414 clause and list of bind values.
2417 =head2 values(\%data)
2419 This just returns the values from the hash C<%data>, in the same
2420 order that would be returned from any of the other above queries.
2421 Using this allows you to markedly speed up your queries if you
2422 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2424 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2426 Warning: This is an experimental method and subject to change.
2428 This returns arbitrarily generated SQL. It's a really basic shortcut.
2429 It will return two different things, depending on return context:
2431 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2432 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2434 These would return the following:
2436 # First calling form
2437 $stmt = "CREATE TABLE test (?, ?)";
2438 @bind = (field1, field2);
2440 # Second calling form
2441 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2443 Depending on what you're trying to do, it's up to you to choose the correct
2444 format. In this example, the second form is what you would want.
2448 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2452 ALTER SESSION SET nls_date_format = 'MM/YY'
2454 You get the idea. Strings get their case twiddled, but everything
2455 else remains verbatim.
2457 =head1 EXPORTABLE FUNCTIONS
2459 =head2 is_plain_value
2461 Determines if the supplied argument is a plain value as understood by this
2466 =item * The value is C<undef>
2468 =item * The value is a non-reference
2470 =item * The value is an object with stringification overloading
2472 =item * The value is of the form C<< { -value => $anything } >>
2476 On failure returns C<undef>, on success returns a B<scalar> reference
2477 to the original supplied argument.
2483 The stringification overloading detection is rather advanced: it takes
2484 into consideration not only the presence of a C<""> overload, but if that
2485 fails also checks for enabled
2486 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2487 on either C<0+> or C<bool>.
2489 Unfortunately testing in the field indicates that this
2490 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2491 but only when very large numbers of stringifying objects are involved.
2492 At the time of writing ( Sep 2014 ) there is no clear explanation of
2493 the direct cause, nor is there a manageably small test case that reliably
2494 reproduces the problem.
2496 If you encounter any of the following exceptions in B<random places within
2497 your application stack> - this module may be to blame:
2499 Operation "ne": no method found,
2500 left argument in overloaded package <something>,
2501 right argument in overloaded package <something>
2505 Stub found while resolving method "???" overloading """" in package <something>
2507 If you fall victim to the above - please attempt to reduce the problem
2508 to something that could be sent to the L<SQL::Abstract developers
2509 |DBIx::Class/GETTING HELP/SUPPORT>
2510 (either publicly or privately). As a workaround in the meantime you can
2511 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2512 value, which will most likely eliminate your problem (at the expense of
2513 not being able to properly detect exotic forms of stringification).
2515 This notice and environment variable will be removed in a future version,
2516 as soon as the underlying problem is found and a reliable workaround is
2521 =head2 is_literal_value
2523 Determines if the supplied argument is a literal value as understood by this
2528 =item * C<\$sql_string>
2530 =item * C<\[ $sql_string, @bind_values ]>
2534 On failure returns C<undef>, on success returns an B<array> reference
2535 containing the unpacked version of the supplied literal SQL and bind values.
2537 =head1 WHERE CLAUSES
2541 This module uses a variation on the idea from L<DBIx::Abstract>. It
2542 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2543 module is that things in arrays are OR'ed, and things in hashes
2546 The easiest way to explain is to show lots of examples. After
2547 each C<%where> hash shown, it is assumed you used:
2549 my($stmt, @bind) = $sql->where(\%where);
2551 However, note that the C<%where> hash can be used directly in any
2552 of the other functions as well, as described above.
2554 =head2 Key-value pairs
2556 So, let's get started. To begin, a simple hash:
2560 status => 'completed'
2563 Is converted to SQL C<key = val> statements:
2565 $stmt = "WHERE user = ? AND status = ?";
2566 @bind = ('nwiger', 'completed');
2568 One common thing I end up doing is having a list of values that
2569 a field can be in. To do this, simply specify a list inside of
2574 status => ['assigned', 'in-progress', 'pending'];
2577 This simple code will create the following:
2579 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2580 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2582 A field associated to an empty arrayref will be considered a
2583 logical false and will generate 0=1.
2585 =head2 Tests for NULL values
2587 If the value part is C<undef> then this is converted to SQL <IS NULL>
2596 $stmt = "WHERE user = ? AND status IS NULL";
2599 To test if a column IS NOT NULL:
2603 status => { '!=', undef },
2606 =head2 Specific comparison operators
2608 If you want to specify a different type of operator for your comparison,
2609 you can use a hashref for a given column:
2613 status => { '!=', 'completed' }
2616 Which would generate:
2618 $stmt = "WHERE user = ? AND status != ?";
2619 @bind = ('nwiger', 'completed');
2621 To test against multiple values, just enclose the values in an arrayref:
2623 status => { '=', ['assigned', 'in-progress', 'pending'] };
2625 Which would give you:
2627 "WHERE status = ? OR status = ? OR status = ?"
2630 The hashref can also contain multiple pairs, in which case it is expanded
2631 into an C<AND> of its elements:
2635 status => { '!=', 'completed', -not_like => 'pending%' }
2638 # Or more dynamically, like from a form
2639 $where{user} = 'nwiger';
2640 $where{status}{'!='} = 'completed';
2641 $where{status}{'-not_like'} = 'pending%';
2643 # Both generate this
2644 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2645 @bind = ('nwiger', 'completed', 'pending%');
2648 To get an OR instead, you can combine it with the arrayref idea:
2652 priority => [ { '=', 2 }, { '>', 5 } ]
2655 Which would generate:
2657 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2658 @bind = ('2', '5', 'nwiger');
2660 If you want to include literal SQL (with or without bind values), just use a
2661 scalar reference or reference to an arrayref as the value:
2664 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2665 date_expires => { '<' => \"now()" }
2668 Which would generate:
2670 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2671 @bind = ('11/26/2008');
2674 =head2 Logic and nesting operators
2676 In the example above,
2677 there is a subtle trap if you want to say something like
2678 this (notice the C<AND>):
2680 WHERE priority != ? AND priority != ?
2682 Because, in Perl you I<can't> do this:
2684 priority => { '!=' => 2, '!=' => 1 }
2686 As the second C<!=> key will obliterate the first. The solution
2687 is to use the special C<-modifier> form inside an arrayref:
2689 priority => [ -and => {'!=', 2},
2693 Normally, these would be joined by C<OR>, but the modifier tells it
2694 to use C<AND> instead. (Hint: You can use this in conjunction with the
2695 C<logic> option to C<new()> in order to change the way your queries
2696 work by default.) B<Important:> Note that the C<-modifier> goes
2697 B<INSIDE> the arrayref, as an extra first element. This will
2698 B<NOT> do what you think it might:
2700 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2702 Here is a quick list of equivalencies, since there is some overlap:
2705 status => {'!=', 'completed', 'not like', 'pending%' }
2706 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2709 status => {'=', ['assigned', 'in-progress']}
2710 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2711 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2715 =head2 Special operators: IN, BETWEEN, etc.
2717 You can also use the hashref format to compare a list of fields using the
2718 C<IN> comparison operator, by specifying the list as an arrayref:
2721 status => 'completed',
2722 reportid => { -in => [567, 2335, 2] }
2725 Which would generate:
2727 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2728 @bind = ('completed', '567', '2335', '2');
2730 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2733 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2734 (by default: C<1=0>). Similarly, C<< -not_in => [] >> generates
2735 'sqltrue' (by default: C<1=1>).
2737 In addition to the array you can supply a chunk of literal sql or
2738 literal sql with bind:
2741 customer => { -in => \[
2742 'SELECT cust_id FROM cust WHERE balance > ?',
2745 status => { -in => \'SELECT status_codes FROM states' },
2751 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2752 AND status IN ( SELECT status_codes FROM states )
2756 Finally, if the argument to C<-in> is not a reference, it will be
2757 treated as a single-element array.
2759 Another pair of operators is C<-between> and C<-not_between>,
2760 used with an arrayref of two values:
2764 completion_date => {
2765 -not_between => ['2002-10-01', '2003-02-06']
2771 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2773 Just like with C<-in> all plausible combinations of literal SQL
2777 start0 => { -between => [ 1, 2 ] },
2778 start1 => { -between => \["? AND ?", 1, 2] },
2779 start2 => { -between => \"lower(x) AND upper(y)" },
2780 start3 => { -between => [
2782 \["upper(?)", 'stuff' ],
2789 ( start0 BETWEEN ? AND ? )
2790 AND ( start1 BETWEEN ? AND ? )
2791 AND ( start2 BETWEEN lower(x) AND upper(y) )
2792 AND ( start3 BETWEEN lower(x) AND upper(?) )
2794 @bind = (1, 2, 1, 2, 'stuff');
2797 These are the two builtin "special operators"; but the
2798 list can be expanded: see section L</"SPECIAL OPERATORS"> below.
2800 =head2 Unary operators: bool
2802 If you wish to test against boolean columns or functions within your
2803 database you can use the C<-bool> and C<-not_bool> operators. For
2804 example to test the column C<is_user> being true and the column
2805 C<is_enabled> being false you would use:-
2809 -not_bool => 'is_enabled',
2814 WHERE is_user AND NOT is_enabled
2816 If a more complex combination is required, testing more conditions,
2817 then you should use the and/or operators:-
2822 -not_bool => { two=> { -rlike => 'bar' } },
2823 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2834 (NOT ( three = ? OR three > ? ))
2837 =head2 Nested conditions, -and/-or prefixes
2839 So far, we've seen how multiple conditions are joined with a top-level
2840 C<AND>. We can change this by putting the different conditions we want in
2841 hashes and then putting those hashes in an array. For example:
2846 status => { -like => ['pending%', 'dispatched'] },
2850 status => 'unassigned',
2854 This data structure would create the following:
2856 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2857 OR ( user = ? AND status = ? ) )";
2858 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2861 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2862 to change the logic inside:
2868 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2869 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2876 $stmt = "WHERE ( user = ?
2877 AND ( ( workhrs > ? AND geo = ? )
2878 OR ( workhrs < ? OR geo = ? ) ) )";
2879 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2881 =head3 Algebraic inconsistency, for historical reasons
2883 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2884 operator goes C<outside> of the nested structure; whereas when connecting
2885 several constraints on one column, the C<-and> operator goes
2886 C<inside> the arrayref. Here is an example combining both features:
2889 -and => [a => 1, b => 2],
2890 -or => [c => 3, d => 4],
2891 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2896 WHERE ( ( ( a = ? AND b = ? )
2897 OR ( c = ? OR d = ? )
2898 OR ( e LIKE ? AND e LIKE ? ) ) )
2900 This difference in syntax is unfortunate but must be preserved for
2901 historical reasons. So be careful: the two examples below would
2902 seem algebraically equivalent, but they are not
2905 { -like => 'foo%' },
2906 { -like => '%bar' },
2908 # yields: WHERE ( ( col LIKE ? AND col LIKE ? ) )
2911 { col => { -like => 'foo%' } },
2912 { col => { -like => '%bar' } },
2914 # yields: WHERE ( ( col LIKE ? OR col LIKE ? ) )
2917 =head2 Literal SQL and value type operators
2919 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2920 side" is a column name and the "right side" is a value (normally rendered as
2921 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2922 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2923 alter this behavior. There are several ways of doing so.
2927 This is a virtual operator that signals the string to its right side is an
2928 identifier (a column name) and not a value. For example to compare two
2929 columns you would write:
2932 priority => { '<', 2 },
2933 requestor => { -ident => 'submitter' },
2938 $stmt = "WHERE priority < ? AND requestor = submitter";
2941 If you are maintaining legacy code you may see a different construct as
2942 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2947 This is a virtual operator that signals that the construct to its right side
2948 is a value to be passed to DBI. This is for example necessary when you want
2949 to write a where clause against an array (for RDBMS that support such
2950 datatypes). For example:
2953 array => { -value => [1, 2, 3] }
2958 $stmt = 'WHERE array = ?';
2959 @bind = ([1, 2, 3]);
2961 Note that if you were to simply say:
2967 the result would probably not be what you wanted:
2969 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2974 Finally, sometimes only literal SQL will do. To include a random snippet
2975 of SQL verbatim, you specify it as a scalar reference. Consider this only
2976 as a last resort. Usually there is a better way. For example:
2979 priority => { '<', 2 },
2980 requestor => { -in => \'(SELECT name FROM hitmen)' },
2985 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2988 Note that in this example, you only get one bind parameter back, since
2989 the verbatim SQL is passed as part of the statement.
2993 Never use untrusted input as a literal SQL argument - this is a massive
2994 security risk (there is no way to check literal snippets for SQL
2995 injections and other nastyness). If you need to deal with untrusted input
2996 use literal SQL with placeholders as described next.
2998 =head3 Literal SQL with placeholders and bind values (subqueries)
3000 If the literal SQL to be inserted has placeholders and bind values,
3001 use a reference to an arrayref (yes this is a double reference --
3002 not so common, but perfectly legal Perl). For example, to find a date
3003 in Postgres you can use something like this:
3006 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
3011 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
3014 Note that you must pass the bind values in the same format as they are returned
3015 by L<where|/where(\%where, $order)>. This means that if you set L</bindtype>
3016 to C<columns>, you must provide the bind values in the
3017 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
3018 scalar value; most commonly the column name, but you can use any scalar value
3019 (including references and blessed references), L<SQL::Abstract> will simply
3020 pass it through intact. So if C<bindtype> is set to C<columns> the above
3021 example will look like:
3024 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
3027 Literal SQL is especially useful for nesting parenthesized clauses in the
3028 main SQL query. Here is a first example:
3030 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
3034 bar => \["IN ($sub_stmt)" => @sub_bind],
3039 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
3040 WHERE c2 < ? AND c3 LIKE ?))";
3041 @bind = (1234, 100, "foo%");
3043 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
3044 are expressed in the same way. Of course the C<$sub_stmt> and
3045 its associated bind values can be generated through a former call
3048 my ($sub_stmt, @sub_bind)
3049 = $sql->select("t1", "c1", {c2 => {"<" => 100},
3050 c3 => {-like => "foo%"}});
3053 bar => \["> ALL ($sub_stmt)" => @sub_bind],
3056 In the examples above, the subquery was used as an operator on a column;
3057 but the same principle also applies for a clause within the main C<%where>
3058 hash, like an EXISTS subquery:
3060 my ($sub_stmt, @sub_bind)
3061 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
3062 my %where = ( -and => [
3064 \["EXISTS ($sub_stmt)" => @sub_bind],
3069 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
3070 WHERE c1 = ? AND c2 > t0.c0))";
3074 Observe that the condition on C<c2> in the subquery refers to
3075 column C<t0.c0> of the main query: this is I<not> a bind
3076 value, so we have to express it through a scalar ref.
3077 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
3078 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
3079 what we wanted here.
3081 Finally, here is an example where a subquery is used
3082 for expressing unary negation:
3084 my ($sub_stmt, @sub_bind)
3085 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
3086 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
3088 lname => {like => '%son%'},
3089 \["NOT ($sub_stmt)" => @sub_bind],
3094 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
3095 @bind = ('%son%', 10, 20)
3097 =head3 Deprecated usage of Literal SQL
3099 Below are some examples of archaic use of literal SQL. It is shown only as
3100 reference for those who deal with legacy code. Each example has a much
3101 better, cleaner and safer alternative that users should opt for in new code.
3107 my %where = ( requestor => \'IS NOT NULL' )
3109 $stmt = "WHERE requestor IS NOT NULL"
3111 This used to be the way of generating NULL comparisons, before the handling
3112 of C<undef> got formalized. For new code please use the superior syntax as
3113 described in L</Tests for NULL values>.
3117 my %where = ( requestor => \'= submitter' )
3119 $stmt = "WHERE requestor = submitter"
3121 This used to be the only way to compare columns. Use the superior L</-ident>
3122 method for all new code. For example an identifier declared in such a way
3123 will be properly quoted if L</quote_char> is properly set, while the legacy
3124 form will remain as supplied.
3128 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
3130 $stmt = "WHERE completed > ? AND is_ready"
3131 @bind = ('2012-12-21')
3133 Using an empty string literal used to be the only way to express a boolean.
3134 For all new code please use the much more readable
3135 L<-bool|/Unary operators: bool> operator.
3141 These pages could go on for a while, since the nesting of the data
3142 structures this module can handle are pretty much unlimited (the
3143 module implements the C<WHERE> expansion as a recursive function
3144 internally). Your best bet is to "play around" with the module a
3145 little to see how the data structures behave, and choose the best
3146 format for your data based on that.
3148 And of course, all the values above will probably be replaced with
3149 variables gotten from forms or the command line. After all, if you
3150 knew everything ahead of time, you wouldn't have to worry about
3151 dynamically-generating SQL and could just hardwire it into your
3154 =head1 ORDER BY CLAUSES
3156 Some functions take an order by clause. This can either be a scalar (just a
3157 column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' }
3158 >>, a scalarref, an arrayref-ref, or an arrayref of any of the previous
3161 Given | Will Generate
3162 ---------------------------------------------------------------
3164 'colA' | ORDER BY colA
3166 [qw/colA colB/] | ORDER BY colA, colB
3168 {-asc => 'colA'} | ORDER BY colA ASC
3170 {-desc => 'colB'} | ORDER BY colB DESC
3172 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
3174 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
3176 \'colA DESC' | ORDER BY colA DESC
3178 \[ 'FUNC(colA, ?)', $x ] | ORDER BY FUNC(colA, ?)
3179 | /* ...with $x bound to ? */
3182 { -asc => 'colA' }, | colA ASC,
3183 { -desc => [qw/colB/] }, | colB DESC,
3184 { -asc => [qw/colC colD/] },| colC ASC, colD ASC,
3185 \'colE DESC', | colE DESC,
3186 \[ 'FUNC(colF, ?)', $x ], | FUNC(colF, ?)
3187 ] | /* ...with $x bound to ? */
3188 ===============================================================
3192 =head1 SPECIAL OPERATORS
3194 my $sqlmaker = SQL::Abstract->new(special_ops => [
3198 my ($self, $field, $op, $arg) = @_;
3204 handler => 'method_name',
3208 A "special operator" is a SQL syntactic clause that can be
3209 applied to a field, instead of a usual binary operator.
3212 WHERE field IN (?, ?, ?)
3213 WHERE field BETWEEN ? AND ?
3214 WHERE MATCH(field) AGAINST (?, ?)
3216 Special operators IN and BETWEEN are fairly standard and therefore
3217 are builtin within C<SQL::Abstract> (as the overridable methods
3218 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
3219 like the MATCH .. AGAINST example above which is specific to MySQL,
3220 you can write your own operator handlers - supply a C<special_ops>
3221 argument to the C<new> method. That argument takes an arrayref of
3222 operator definitions; each operator definition is a hashref with two
3229 the regular expression to match the operator
3233 Either a coderef or a plain scalar method name. In both cases
3234 the expected return is C<< ($sql, @bind) >>.
3236 When supplied with a method name, it is simply called on the
3237 L<SQL::Abstract> object as:
3239 $self->$method_name($field, $op, $arg)
3243 $field is the LHS of the operator
3244 $op is the part that matched the handler regex
3247 When supplied with a coderef, it is called as:
3249 $coderef->($self, $field, $op, $arg)
3254 For example, here is an implementation
3255 of the MATCH .. AGAINST syntax for MySQL
3257 my $sqlmaker = SQL::Abstract->new(special_ops => [
3259 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
3260 {regex => qr/^match$/i,
3262 my ($self, $field, $op, $arg) = @_;
3263 $arg = [$arg] if not ref $arg;
3264 my $label = $self->_quote($field);
3265 my ($placeholder) = $self->_convert('?');
3266 my $placeholders = join ", ", (($placeholder) x @$arg);
3267 my $sql = $self->_sqlcase('match') . " ($label) "
3268 . $self->_sqlcase('against') . " ($placeholders) ";
3269 my @bind = $self->_bindtype($field, @$arg);
3270 return ($sql, @bind);
3277 =head1 UNARY OPERATORS
3279 my $sqlmaker = SQL::Abstract->new(unary_ops => [
3283 my ($self, $op, $arg) = @_;
3289 handler => 'method_name',
3293 A "unary operator" is a SQL syntactic clause that can be
3294 applied to a field - the operator goes before the field
3296 You can write your own operator handlers - supply a C<unary_ops>
3297 argument to the C<new> method. That argument takes an arrayref of
3298 operator definitions; each operator definition is a hashref with two
3305 the regular expression to match the operator
3309 Either a coderef or a plain scalar method name. In both cases
3310 the expected return is C<< $sql >>.
3312 When supplied with a method name, it is simply called on the
3313 L<SQL::Abstract> object as:
3315 $self->$method_name($op, $arg)
3319 $op is the part that matched the handler regex
3320 $arg is the RHS or argument of the operator
3322 When supplied with a coderef, it is called as:
3324 $coderef->($self, $op, $arg)
3332 Thanks to some benchmarking by Mark Stosberg, it turns out that
3333 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3334 I must admit this wasn't an intentional design issue, but it's a
3335 byproduct of the fact that you get to control your C<DBI> handles
3338 To maximize performance, use a code snippet like the following:
3340 # prepare a statement handle using the first row
3341 # and then reuse it for the rest of the rows
3343 for my $href (@array_of_hashrefs) {
3344 $stmt ||= $sql->insert('table', $href);
3345 $sth ||= $dbh->prepare($stmt);
3346 $sth->execute($sql->values($href));
3349 The reason this works is because the keys in your C<$href> are sorted
3350 internally by B<SQL::Abstract>. Thus, as long as your data retains
3351 the same structure, you only have to generate the SQL the first time
3352 around. On subsequent queries, simply use the C<values> function provided
3353 by this module to return your values in the correct order.
3355 However this depends on the values having the same type - if, for
3356 example, the values of a where clause may either have values
3357 (resulting in sql of the form C<column = ?> with a single bind
3358 value), or alternatively the values might be C<undef> (resulting in
3359 sql of the form C<column IS NULL> with no bind value) then the
3360 caching technique suggested will not work.
3364 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3365 really like this part (I do, at least). Building up a complex query
3366 can be as simple as the following:
3373 use CGI::FormBuilder;
3376 my $form = CGI::FormBuilder->new(...);
3377 my $sql = SQL::Abstract->new;
3379 if ($form->submitted) {
3380 my $field = $form->field;
3381 my $id = delete $field->{id};
3382 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3385 Of course, you would still have to connect using C<DBI> to run the
3386 query, but the point is that if you make your form look like your
3387 table, the actual query script can be extremely simplistic.
3389 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3390 a fast interface to returning and formatting data. I frequently
3391 use these three modules together to write complex database query
3392 apps in under 50 lines.
3394 =head1 HOW TO CONTRIBUTE
3396 Contributions are always welcome, in all usable forms (we especially
3397 welcome documentation improvements). The delivery methods include git-
3398 or unified-diff formatted patches, GitHub pull requests, or plain bug
3399 reports either via RT or the Mailing list. Contributors are generally
3400 granted full access to the official repository after their first several
3401 patches pass successful review.
3403 This project is maintained in a git repository. The code and related tools are
3404 accessible at the following locations:
3408 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3410 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3412 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3414 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3420 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3421 Great care has been taken to preserve the I<published> behavior
3422 documented in previous versions in the 1.* family; however,
3423 some features that were previously undocumented, or behaved
3424 differently from the documentation, had to be changed in order
3425 to clarify the semantics. Hence, client code that was relying
3426 on some dark areas of C<SQL::Abstract> v1.*
3427 B<might behave differently> in v1.50.
3429 The main changes are:
3435 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3439 support for the { operator => \"..." } construct (to embed literal SQL)
3443 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3447 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3451 defensive programming: check arguments
3455 fixed bug with global logic, which was previously implemented
3456 through global variables yielding side-effects. Prior versions would
3457 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3458 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3459 Now this is interpreted
3460 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3465 fixed semantics of _bindtype on array args
3469 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3470 we just avoid shifting arrays within that tree.
3474 dropped the C<_modlogic> function
3478 =head1 ACKNOWLEDGEMENTS
3480 There are a number of individuals that have really helped out with
3481 this module. Unfortunately, most of them submitted bugs via CPAN
3482 so I have no idea who they are! But the people I do know are:
3484 Ash Berlin (order_by hash term support)
3485 Matt Trout (DBIx::Class support)
3486 Mark Stosberg (benchmarking)
3487 Chas Owens (initial "IN" operator support)
3488 Philip Collins (per-field SQL functions)
3489 Eric Kolve (hashref "AND" support)
3490 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3491 Dan Kubb (support for "quote_char" and "name_sep")
3492 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3493 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3494 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3495 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3496 Oliver Charles (support for "RETURNING" after "INSERT")
3502 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3506 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3508 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3510 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3511 While not an official support venue, C<DBIx::Class> makes heavy use of
3512 C<SQL::Abstract>, and as such list members there are very familiar with
3513 how to create queries.
3517 This module is free software; you may copy this under the same
3518 terms as perl itself (either the GNU General Public License or
3519 the Artistic License)