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.87';
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/^ is (?: \s+ not )? $/ix, handler => sub { die "NOPE" }},
42 {regex => qr/^ (?: not \s )? in $/ix, handler => sub { die "NOPE" }},
43 {regex => qr/^ ident $/ix, handler => sub { die "NOPE" }},
44 {regex => qr/^ value $/ix, handler => sub { die "NOPE" }},
47 #======================================================================
48 # DEBUGGING AND ERROR REPORTING
49 #======================================================================
52 return unless $_[0]->{debug}; shift; # a little faster
53 my $func = (caller(1))[3];
54 warn "[$func] ", @_, "\n";
58 my($func) = (caller(1))[3];
59 Carp::carp "[$func] Warning: ", @_;
63 my($func) = (caller(1))[3];
64 Carp::croak "[$func] Fatal: ", @_;
67 sub is_literal_value ($) {
68 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
69 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
73 sub is_undef_value ($) {
77 and exists $_[0]->{-value}
78 and not defined $_[0]->{-value}
82 # FIXME XSify - this can be done so much more efficiently
83 sub is_plain_value ($) {
85 ! length ref $_[0] ? \($_[0])
87 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
89 exists $_[0]->{-value}
90 ) ? \($_[0]->{-value})
92 # reuse @_ for even moar speedz
93 defined ( $_[1] = Scalar::Util::blessed $_[0] )
95 # deliberately not using Devel::OverloadInfo - the checks we are
96 # intersted in are much more limited than the fullblown thing, and
97 # this is a very hot piece of code
99 # simply using ->can('(""') can leave behind stub methods that
100 # break actually using the overload later (see L<perldiag/Stub
101 # found while resolving method "%s" overloading "%s" in package
102 # "%s"> and the source of overload::mycan())
104 # either has stringification which DBI SHOULD prefer out of the box
105 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
107 # has nummification or boolification, AND fallback is *not* disabled
109 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
112 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
114 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
118 # no fallback specified at all
119 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
121 # fallback explicitly undef
122 ! defined ${"$_[3]::()"}
135 #======================================================================
137 #======================================================================
141 my $class = ref($self) || $self;
142 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
144 # choose our case by keeping an option around
145 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
147 # default logic for interpreting arrayrefs
148 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
150 # how to return bind vars
151 $opt{bindtype} ||= 'normal';
153 # default comparison is "=", but can be overridden
156 # try to recognize which are the 'equality' and 'inequality' ops
157 # (temporary quickfix (in 2007), should go through a more seasoned API)
158 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
159 $opt{inequality_op} = qr/^( != | <> )$/ix;
161 $opt{like_op} = qr/^ (is_)?r?like $/xi;
162 $opt{not_like_op} = qr/^ (is_)?not_r?like $/xi;
165 $opt{sqltrue} ||= '1=1';
166 $opt{sqlfalse} ||= '0=1';
169 $opt{special_ops} ||= [];
171 if ($class->isa('DBIx::Class::SQLMaker')) {
172 $opt{warn_once_on_nest} = 1;
173 $opt{disable_old_special_ops} = 1;
177 $opt{unary_ops} ||= [];
179 # rudimentary sanity-check for user supplied bits treated as functions/operators
180 # If a purported function matches this regular expression, an exception is thrown.
181 # Literal SQL is *NOT* subject to this check, only functions (and column names
182 # when quoting is not in effect)
185 # need to guard against ()'s in column names too, but this will break tons of
186 # hacks... ideas anyone?
187 $opt{injection_guard} ||= qr/
193 $opt{expand_unary} = {};
196 not => '_expand_not',
197 bool => '_expand_bool',
198 and => '_expand_op_andor',
199 or => '_expand_op_andor',
200 nest => '_expand_nest',
201 bind => '_expand_bind',
203 not_in => '_expand_in',
204 row => '_expand_row',
205 between => '_expand_between',
206 not_between => '_expand_between',
208 (map +($_ => '_expand_op_is'), ('is', 'is_not')),
209 ident => '_expand_ident',
210 value => '_expand_value',
211 func => '_expand_func',
212 values => '_expand_values',
216 'between' => '_expand_between',
217 'not_between' => '_expand_between',
218 'in' => '_expand_in',
219 'not_in' => '_expand_in',
220 'nest' => '_expand_nest',
221 (map +($_ => '_expand_op_andor'), ('and', 'or')),
222 (map +($_ => '_expand_op_is'), ('is', 'is_not')),
223 'ident' => '_expand_ident',
224 'value' => '_expand_value',
228 (map +($_, "_render_$_"), qw(op func bind ident literal row values)),
233 (map +($_ => '_render_op_between'), 'between', 'not_between'),
234 (map +($_ => '_render_op_in'), 'in', 'not_in'),
235 (map +($_ => '_render_unop_postfix'),
236 'is_null', 'is_not_null', 'asc', 'desc',
238 (not => '_render_unop_paren'),
239 (map +($_ => '_render_op_andor'), qw(and or)),
240 ',' => '_render_op_multop',
243 return bless \%opt, $class;
246 sub sqltrue { +{ -literal => [ $_[0]->{sqltrue} ] } }
247 sub sqlfalse { +{ -literal => [ $_[0]->{sqlfalse} ] } }
249 sub _assert_pass_injection_guard {
250 if ($_[1] =~ $_[0]->{injection_guard}) {
251 my $class = ref $_[0];
252 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
253 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
254 . "{injection_guard} attribute to ${class}->new()"
259 #======================================================================
261 #======================================================================
265 my $table = $self->_table(shift);
266 my $data = shift || return;
271 my ($f_aqt, $v_aqt) = $self->_expand_insert_values($data);
273 my @parts = ([ $self->_sqlcase('insert into').' '.$table ]);
274 push @parts, [ $self->render_aqt($f_aqt) ] if $f_aqt;
275 push @parts, [ $self->render_aqt({ -values => $v_aqt }) ];
277 if ($options->{returning}) {
278 push @parts, [ $self->_insert_returning($options) ];
281 return $self->_join_parts(' ', @parts);
284 sub _expand_insert_values {
285 my ($self, $data) = @_;
286 if (is_literal_value($data)) {
287 (undef, $self->expand_expr($data));
289 my ($fields, $values) = (
290 ref($data) eq 'HASH' ?
291 ([ sort keys %$data ], [ @{$data}{sort keys %$data} ])
295 # no names (arrayref) means can't generate bindtype
296 !($fields) && $self->{bindtype} eq 'columns'
297 && belch "can't do 'columns' bindtype when called with arrayref";
301 ? $self->expand_expr({ -row => $fields }, -ident)
306 local our $Cur_Col_Meta = $fields->[$_];
307 $self->_expand_insert_value($values->[$_])
314 # So that subclasses can override INSERT ... RETURNING separately from
315 # UPDATE and DELETE (e.g. DBIx::Class::SQLMaker::Oracle does this)
316 sub _insert_returning { shift->_returning(@_) }
319 my ($self, $options) = @_;
321 my $f = $options->{returning};
323 my ($sql, @bind) = $self->render_aqt(
324 $self->_expand_maybe_list_expr($f, -ident)
327 ? $self->_sqlcase(' returning ') . $sql
328 : ($self->_sqlcase(' returning ').$sql, @bind);
331 sub _expand_insert_value {
334 my $k = our $Cur_Col_Meta;
336 if (ref($v) eq 'ARRAY') {
337 if ($self->{array_datatypes}) {
338 return +{ -bind => [ $k, $v ] };
340 my ($sql, @bind) = @$v;
341 $self->_assert_bindval_matches_bindtype(@bind);
342 return +{ -literal => $v };
344 if (ref($v) eq 'HASH') {
345 if (grep !/^-/, keys %$v) {
346 belch "HASH ref as bind value in insert is not supported";
347 return +{ -bind => [ $k, $v ] };
351 return +{ -bind => [ $k, undef ] };
353 return $self->expand_expr($v);
358 #======================================================================
360 #======================================================================
365 my $table = $self->_table(shift);
366 my $data = shift || return;
370 # first build the 'SET' part of the sql statement
371 puke "Unsupported data type specified to \$sql->update"
372 unless ref $data eq 'HASH';
374 my ($sql, @all_bind) = $self->_update_set_values($data);
375 $sql = $self->_sqlcase('update ') . $table . $self->_sqlcase(' set ')
379 my($where_sql, @where_bind) = $self->where($where);
381 push @all_bind, @where_bind;
384 if ($options->{returning}) {
385 my ($returning_sql, @returning_bind) = $self->_update_returning($options);
386 $sql .= $returning_sql;
387 push @all_bind, @returning_bind;
390 return wantarray ? ($sql, @all_bind) : $sql;
393 sub _update_set_values {
394 my ($self, $data) = @_;
396 return $self->render_aqt(
397 $self->_expand_update_set_values($data),
401 sub _expand_update_set_values {
402 my ($self, $data) = @_;
403 $self->_expand_maybe_list_expr( [
406 $set = { -bind => $_ } unless defined $set;
407 +{ -op => [ '=', $self->_expand_ident(-ident => $k), $set ] };
413 ? ($self->{array_datatypes}
414 ? [ $k, +{ -bind => [ $k, $v ] } ]
415 : [ $k, +{ -literal => $v } ])
417 local our $Cur_Col_Meta = $k;
418 [ $k, $self->_expand_expr($v) ]
425 # So that subclasses can override UPDATE ... RETURNING separately from
427 sub _update_returning { shift->_returning(@_) }
431 #======================================================================
433 #======================================================================
438 my $table = $self->_table(shift);
439 my $fields = shift || '*';
443 my ($fields_sql, @bind) = $self->_select_fields($fields);
445 my ($where_sql, @where_bind) = $self->where($where, $order);
446 push @bind, @where_bind;
448 my $sql = join(' ', $self->_sqlcase('select'), $fields_sql,
449 $self->_sqlcase('from'), $table)
452 return wantarray ? ($sql, @bind) : $sql;
456 my ($self, $fields) = @_;
457 return $fields unless ref($fields);
458 return $self->render_aqt(
459 $self->_expand_maybe_list_expr($fields, '-ident')
463 #======================================================================
465 #======================================================================
470 my $table = $self->_table(shift);
474 my($where_sql, @bind) = $self->where($where);
475 my $sql = $self->_sqlcase('delete from ') . $table . $where_sql;
477 if ($options->{returning}) {
478 my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
479 $sql .= $returning_sql;
480 push @bind, @returning_bind;
483 return wantarray ? ($sql, @bind) : $sql;
486 # So that subclasses can override DELETE ... RETURNING separately from
488 sub _delete_returning { shift->_returning(@_) }
492 #======================================================================
494 #======================================================================
498 # Finally, a separate routine just to handle WHERE clauses
500 my ($self, $where, $order) = @_;
502 local $self->{convert_where} = $self->{convert};
505 my ($sql, @bind) = defined($where)
506 ? $self->_recurse_where($where)
508 $sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
512 my ($order_sql, @order_bind) = $self->_order_by($order);
514 push @bind, @order_bind;
517 return wantarray ? ($sql, @bind) : $sql;
520 { our $Default_Scalar_To = -value }
523 my ($self, $expr, $default_scalar_to) = @_;
524 local our $Default_Scalar_To = $default_scalar_to if $default_scalar_to;
525 $self->_expand_expr($expr);
529 my ($self, $aqt) = @_;
530 my ($k, $v, @rest) = %$aqt;
532 die "Not a node type: $k" unless $k =~ s/^-//;
533 if (my $meth = $self->{render}{$k}) {
534 return $self->$meth($v);
536 die "notreached: $k";
540 my ($self, $expr, $default_scalar_to) = @_;
541 my ($sql, @bind) = $self->render_aqt(
542 $self->expand_expr($expr, $default_scalar_to)
544 return (wantarray ? ($sql, @bind) : $sql);
548 my ($self, $raw) = @_;
549 s/^-(?=.)//, s/\s+/_/g for my $op = lc $raw;
554 my ($self, $expr) = @_;
555 our $Expand_Depth ||= 0; local $Expand_Depth = $Expand_Depth + 1;
556 return undef unless defined($expr);
557 if (ref($expr) eq 'HASH') {
558 return undef unless my $kc = keys %$expr;
560 return $self->_expand_op_andor(and => $expr);
562 my ($key, $value) = %$expr;
563 if ($key =~ /^-/ and $key =~ s/ [_\s]? \d+ $//x ) {
564 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
565 . "You probably wanted ...-and => [ $key => COND1, $key => COND2 ... ]";
567 return $self->_expand_hashpair($key, $value);
569 if (ref($expr) eq 'ARRAY') {
570 return $self->_expand_op_andor(lc($self->{logic}), $expr);
572 if (my $literal = is_literal_value($expr)) {
573 return +{ -literal => $literal };
575 if (!ref($expr) or Scalar::Util::blessed($expr)) {
576 return $self->_expand_scalar($expr);
581 sub _expand_hashpair {
582 my ($self, $k, $v) = @_;
583 unless (defined($k) and length($k)) {
584 if (defined($k) and my $literal = is_literal_value($v)) {
585 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
586 return { -literal => $literal };
588 puke "Supplying an empty left hand side argument is not supported";
591 return $self->_expand_hashpair_op($k, $v);
592 } elsif ($k =~ /^[^\w]/i) {
593 my ($lhs, @rhs) = @$v;
594 return $self->_expand_op(
595 -op, [ $k, $self->expand_expr($lhs, -ident), @rhs ]
598 return $self->_expand_hashpair_ident($k, $v);
601 sub _expand_hashpair_ident {
602 my ($self, $k, $v) = @_;
604 local our $Cur_Col_Meta = $k;
606 # hash with multiple or no elements is andor
608 if (ref($v) eq 'HASH' and keys %$v != 1) {
609 return $self->_expand_op_andor(and => $v, $k);
612 # undef needs to be re-sent with cmp to achieve IS/IS NOT NULL
614 if (is_undef_value($v)) {
615 return $self->_expand_hashpair_cmp($k => undef);
618 # scalars and objects get expanded as whatever requested or values
620 if (!ref($v) or Scalar::Util::blessed($v)) {
621 return $self->_expand_hashpair_scalar($k, $v);
624 # single key hashref is a hashtriple
626 if (ref($v) eq 'HASH') {
627 return $self->_expand_hashtriple($k, %$v);
630 # arrayref needs re-engineering over the elements
632 if (ref($v) eq 'ARRAY') {
633 return $self->sqlfalse unless @$v;
634 $self->_debug("ARRAY($k) means distribute over elements");
636 $v->[0] =~ /^-(and|or)$/i
637 ? (shift(@{$v = [ @$v ]}), $1)
638 : lc($self->{logic} || 'OR')
640 return $self->_expand_op_andor(
645 if (my $literal = is_literal_value($v)) {
647 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
650 my ($sql, @bind) = @$literal;
651 if ($self->{bindtype} eq 'columns') {
653 $self->_assert_bindval_matches_bindtype($_);
656 return +{ -literal => [ $self->_quote($k).' '.$sql, @bind ] };
662 my ($self, $expr) = @_;
664 return $self->_expand_expr({ (our $Default_Scalar_To) => $expr });
667 sub _expand_hashpair_scalar {
668 my ($self, $k, $v) = @_;
670 return $self->_expand_hashpair_cmp(
671 $k, $self->_expand_scalar($v),
675 sub _expand_hashpair_op {
676 my ($self, $k, $v) = @_;
678 $self->_assert_pass_injection_guard($k =~ /\A-(.*)\Z/s);
680 my $op = $self->_normalize_op($k);
682 if (my $exp = $self->{expand}{$op}) {
683 return $self->$exp($op, $v);
686 # Ops prefixed with -not_ get converted
688 if (my ($rest) = $op =~/^not_(.*)$/) {
691 $self->_expand_expr({ "-${rest}", $v })
697 my $op = join(' ', split '_', $op);
699 # the old special op system requires illegality for top-level use
702 (our $Expand_Depth) == 1
704 List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
706 $self->{disable_old_special_ops}
707 and List::Util::first { $op =~ $_->{regex} } @BUILTIN_SPECIAL_OPS
711 puke "Illegal use of top-level '-$op'"
714 # the old unary op system means we should touch nothing and let it work
716 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
717 return { -op => [ $op, $v ] };
721 # an explicit node type is currently assumed to be expanded (this is almost
722 # certainly wrong and there should be expansion anyway)
724 if ($self->{render}{$op}) {
728 # hashref RHS values get expanded and used as op/func args
733 and (keys %$v)[0] =~ /^-/
735 my ($func) = $k =~ /^-(.*)$/;
737 if (List::Util::first { $func =~ $_->{regex} } @{$self->{special_ops}}) {
738 return +{ -op => [ $func, $self->_expand_expr($v) ] };
743 map $self->_expand_expr($_),
744 ref($v) eq 'ARRAY' ? @$v : $v
748 # scalars and literals get simply expanded
750 if (!ref($v) or is_literal_value($v)) {
751 return +{ -op => [ $op, $self->_expand_expr($v) ] };
757 sub _expand_hashpair_cmp {
758 my ($self, $k, $v) = @_;
759 $self->_expand_hashtriple($k, $self->{cmp}, $v);
762 sub _expand_hashtriple {
763 my ($self, $k, $vk, $vv) = @_;
765 my $ik = $self->_expand_ident(-ident => $k);
767 my $op = $self->_normalize_op($vk);
768 $self->_assert_pass_injection_guard($op);
770 if ($op =~ s/ _? \d+ $//x ) {
771 return $self->_expand_expr($k, { $vk, $vv });
773 if (my $x = $self->{expand_op}{$op}) {
774 local our $Cur_Col_Meta = $k;
775 return $self->$x($op, $vv, $k);
779 my $op = join(' ', split '_', $op);
781 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
782 return { -op => [ $op, $ik, $vv ] };
784 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
788 { -op => [ $op, $vv ] }
792 if (ref($vv) eq 'ARRAY') {
794 my $logic = (defined($raw[0]) and $raw[0] =~ /^-(and|or)$/i)
795 ? (shift(@raw), $1) : 'or';
796 my @values = map +{ $vk => $_ }, @raw;
798 $op =~ $self->{inequality_op}
799 or $op =~ $self->{not_like_op}
801 if (lc($logic) eq 'or' and @values > 1) {
802 belch "A multi-element arrayref as an argument to the inequality op '${\uc(join ' ', split '_', $op)}' "
803 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
804 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
809 # try to DWIM on equality operators
810 return ($self->_dwim_op_to_is($op,
811 "Supplying an empty arrayref to '%s' is deprecated",
812 "operator '%s' applied on an empty array (field '$k')"
813 ) ? $self->sqlfalse : $self->sqltrue);
815 return $self->_expand_op_andor($logic => \@values, $k);
817 if (is_undef_value($vv)) {
818 my $is = ($self->_dwim_op_to_is($op,
819 "Supplying an undefined argument to '%s' is deprecated",
820 "unexpected operator '%s' with undef operand",
821 ) ? 'is' : 'is not');
823 return $self->_expand_hashpair($k => { $is, undef });
825 local our $Cur_Col_Meta = $k;
829 $self->_expand_expr($vv)
834 my ($self, $raw, $empty, $fail) = @_;
836 my $op = $self->_normalize_op($raw);
838 if ($op =~ /^not$/i) {
841 if ($op =~ $self->{equality_op}) {
844 if ($op =~ $self->{like_op}) {
845 belch(sprintf $empty, uc(join ' ', split '_', $op));
848 if ($op =~ $self->{inequality_op}) {
851 if ($op =~ $self->{not_like_op}) {
852 belch(sprintf $empty, uc(join ' ', split '_', $op));
855 puke(sprintf $fail, $op);
859 my ($self, undef, $args) = @_;
860 my ($func, @args) = @$args;
861 return { -func => [ $func, map $self->expand_expr($_), @args ] };
865 my ($self, undef, $body, $k) = @_;
866 return $self->_expand_hashpair_cmp(
867 $k, { -ident => $body }
869 unless (defined($body) or (ref($body) and ref($body) eq 'ARRAY')) {
870 puke "-ident requires a single plain scalar argument (a quotable identifier) or an arrayref of identifier parts";
872 my @parts = map split(/\Q${\($self->{name_sep}||'.')}\E/, $_),
873 ref($body) ? @$body : $body;
874 return { -ident => $parts[-1] } if $self->{_dequalify_idents};
875 unless ($self->{quote_char}) {
876 $self->_assert_pass_injection_guard($_) for @parts;
878 return +{ -ident => \@parts };
882 return $_[0]->_expand_hashpair_cmp(
883 $_[3], { -value => $_[2] },
885 +{ -bind => [ our $Cur_Col_Meta, $_[2] ] };
889 +{ -op => [ 'not', $_[0]->_expand_expr($_[2]) ] };
893 my ($self, undef, $args) = @_;
894 +{ -row => [ map $self->expand_expr($_), @$args ] };
898 my ($self, undef, $args) = @_;
899 my ($op, @opargs) = @$args;
900 if (my $exp = $self->{expand_op}{$op}) {
901 return $self->$exp($op, \@opargs);
903 +{ -op => [ $op, map $self->expand_expr($_), @opargs ] };
907 my ($self, undef, $v) = @_;
909 return $self->_expand_expr($v);
911 puke "-bool => undef not supported" unless defined($v);
912 return $self->_expand_ident(-ident => $v);
915 sub _expand_op_andor {
916 my ($self, $logop, $v, $k) = @_;
918 $v = [ map +{ $k, $_ },
920 ? (map +{ $_ => $v->{$_} }, sort keys %$v)
924 if (ref($v) eq 'HASH') {
925 return undef unless keys %$v;
928 map $self->_expand_expr({ $_ => $v->{$_} }),
932 if (ref($v) eq 'ARRAY') {
933 $logop eq 'and' or $logop eq 'or' or puke "unknown logic: $logop";
936 (ref($_) eq 'ARRAY' and @$_)
937 or (ref($_) eq 'HASH' and %$_)
943 while (my ($el) = splice @expr, 0, 1) {
944 puke "Supplying an empty left hand side argument is not supported in array-pairs"
945 unless defined($el) and length($el);
946 my $elref = ref($el);
948 local our $Expand_Depth = 0;
949 push(@res, grep defined, $self->_expand_expr({ $el, shift(@expr) }));
950 } elsif ($elref eq 'ARRAY') {
951 push(@res, grep defined, $self->_expand_expr($el)) if @$el;
952 } elsif (my $l = is_literal_value($el)) {
953 push @res, { -literal => $l };
954 } elsif ($elref eq 'HASH') {
955 local our $Expand_Depth = 0;
956 push @res, grep defined, $self->_expand_expr($el) if %$el;
962 # return $res[0] if @res == 1;
963 return { -op => [ $logop, @res ] };
969 my ($self, $op, $vv, $k) = @_;
970 ($k, $vv) = @$vv unless defined $k;
971 puke "$op can only take undef as argument"
975 and exists($vv->{-value})
976 and !defined($vv->{-value})
978 return +{ -op => [ $op.'_null', $self->expand_expr($k, -ident) ] };
981 sub _expand_between {
982 my ($self, $op, $vv, $k) = @_;
983 $k = shift @{$vv = [ @$vv ]} unless defined $k;
984 my @rhs = map $self->_expand_expr($_),
985 ref($vv) eq 'ARRAY' ? @$vv : $vv;
987 (@rhs == 1 and ref($rhs[0]) eq 'HASH' and $rhs[0]->{-literal})
989 (@rhs == 2 and defined($rhs[0]) and defined($rhs[1]))
991 puke "Operator '${\uc($op)}' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
995 $self->expand_expr(ref($k) ? $k : { -ident => $k }),
1001 my ($self, $op, $vv, $k) = @_;
1002 $k = shift @{$vv = [ @$vv ]} unless defined $k;
1003 if (my $literal = is_literal_value($vv)) {
1004 my ($sql, @bind) = @$literal;
1005 my $opened_sql = $self->_open_outer_paren($sql);
1007 $op, $self->expand_expr($k, -ident),
1008 { -literal => [ $opened_sql, @bind ] }
1012 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1013 . "-${\uc($op)} operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1014 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1015 . 'will emit the logically correct SQL instead of raising this exception)'
1017 puke("Argument passed to the '${\uc($op)}' operator can not be undefined")
1019 my @rhs = map $self->expand_expr($_, -value),
1020 map { defined($_) ? $_: puke($undef_err) }
1021 (ref($vv) eq 'ARRAY' ? @$vv : $vv);
1022 return $self->${\($op =~ /^not/ ? 'sqltrue' : 'sqlfalse')} unless @rhs;
1026 $self->expand_expr($k, -ident),
1032 my ($self, undef, $v) = @_;
1033 # DBIx::Class requires a nest warning to be emitted once but the private
1034 # method it overrode to do so no longer exists
1035 if ($self->{warn_once_on_nest}) {
1036 unless (our $Nest_Warned) {
1038 "-nest in search conditions is deprecated, you most probably wanted:\n"
1039 .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
1044 return $self->_expand_expr($v);
1048 my ($self, undef, $bind) = @_;
1049 return { -bind => $bind };
1052 sub _expand_values {
1053 my ($self, undef, $values) = @_;
1054 return { -values => [
1057 ? $self->expand_expr($_)
1058 : +{ -row => [ map $self->expand_expr($_), @$_ ] }
1059 ), ref($values) eq 'ARRAY' ? @$values : $values
1063 sub _recurse_where {
1064 my ($self, $where, $logic) = @_;
1066 # Special case: top level simple string treated as literal
1068 my $where_exp = (ref($where)
1069 ? $self->_expand_expr($where, $logic)
1070 : { -literal => [ $where ] });
1072 # dispatch expanded expression
1074 my ($sql, @bind) = defined($where_exp) ? $self->render_aqt($where_exp) : (undef);
1075 # DBIx::Class used to call _recurse_where in scalar context
1076 # something else might too...
1078 return ($sql, @bind);
1081 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
1087 my ($self, $ident) = @_;
1089 return $self->_convert($self->_quote($ident));
1093 my ($self, $values) = @_;
1094 my ($sql, @bind) = $self->_render_op([ ',', @$values ]);
1095 return "($sql)", @bind;
1098 sub _render_values {
1099 my ($self, $values) = @_;
1100 my ($sql, @bind) = $self->_join_parts(
1102 map [ $self->render_aqt($_) ],
1103 ref($values) eq 'ARRAY' ? @$values : $values
1105 return $self->_sqlcase('values ').$sql, @bind;
1109 my ($self, $rest) = @_;
1110 my ($func, @args) = @$rest;
1111 if (ref($func) eq 'HASH') {
1112 $func = $self->render_aqt($func);
1117 push @arg_sql, shift @x;
1119 } map [ $self->render_aqt($_) ], @args;
1120 return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
1124 my ($self, $bind) = @_;
1125 return ($self->_convert('?'), $self->_bindtype(@$bind));
1128 sub _render_literal {
1129 my ($self, $literal) = @_;
1130 $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
1135 my ($self, $v) = @_;
1136 my ($op, @args) = @$v;
1137 if (my $r = $self->{render_op}{$op}) {
1138 return $self->$r($op, \@args);
1143 my $op = join(' ', split '_', $op);
1145 my $ss = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
1146 if ($ss and @args > 1) {
1147 puke "Special op '${op}' requires first value to be identifier"
1148 unless my ($ident) = map $_->{-ident}, grep ref($_) eq 'HASH', $args[0];
1149 my $k = join(($self->{name_sep}||'.'), @$ident);
1150 local our $Expand_Depth = 1;
1151 return $self->${\($ss->{handler})}($k, $op, $args[1]);
1153 if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
1154 return $self->${\($us->{handler})}($op, $args[0]);
1157 return $self->_render_unop_paren($op, \@args);
1161 return $self->_render_unop_prefix($op, \@args);
1163 return $self->_render_op_multop($op, \@args);
1169 sub _render_op_between {
1170 my ($self, $op, $args) = @_;
1171 my ($left, $low, $high) = @$args;
1172 my ($rhsql, @rhbind) = do {
1174 puke "Single arg to between must be a literal"
1175 unless $low->{-literal};
1178 my ($l, $h) = map [ $self->render_aqt($_) ], $low, $high;
1179 (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
1180 @{$l}[1..$#$l], @{$h}[1..$#$h])
1183 my ($lhsql, @lhbind) = $self->render_aqt($left);
1187 $self->_sqlcase(join ' ', split '_', $op),
1195 my ($self, $op, $args) = @_;
1196 my ($lhs, @rhs) = @$args;
1199 my ($sql, @bind) = $self->render_aqt($_);
1200 push @in_bind, @bind;
1203 my ($lhsql, @lbind) = $self->render_aqt($lhs);
1205 $lhsql.' '.$self->_sqlcase(join ' ', split '_', $op).' ( '
1206 .join(', ', @in_sql)
1212 sub _render_op_andor {
1213 my ($self, $op, $args) = @_;
1214 my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args;
1215 return '' unless @parts;
1216 return @{$parts[0]} if @parts == 1;
1217 my ($sql, @bind) = $self->_join_parts(' '.$self->_sqlcase($op).' ', @parts);
1218 return '( '.$sql.' )', @bind;
1221 sub _render_op_multop {
1222 my ($self, $op, $args) = @_;
1223 my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args;
1224 return '' unless @parts;
1225 return @{$parts[0]} if @parts == 1;
1226 my $join = ($op eq ','
1228 : ' '.$self->_sqlcase(join ' ', split '_', $op).' '
1230 return $self->_join_parts($join, @parts);
1234 my ($self, $join, @parts) = @_;
1236 join($join, map $_->[0], @parts),
1237 (wantarray ? (map @{$_}[1..$#$_], @parts) : ()),
1241 sub _render_unop_paren {
1242 my ($self, $op, $v) = @_;
1243 my ($sql, @bind) = $self->_render_unop_prefix($op, $v);
1244 return "(${sql})", @bind;
1247 sub _render_unop_prefix {
1248 my ($self, $op, $v) = @_;
1249 my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
1251 my $op_sql = $self->_sqlcase($op); # join ' ', split '_', $op);
1252 return ("${op_sql} ${expr_sql}", @bind);
1255 sub _render_unop_postfix {
1256 my ($self, $op, $v) = @_;
1257 my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
1258 my $op_sql = $self->_sqlcase(join ' ', split '_', $op);
1259 return ($expr_sql.' '.$op_sql, @bind);
1262 # Some databases (SQLite) treat col IN (1, 2) different from
1263 # col IN ( (1, 2) ). Use this to strip all outer parens while
1264 # adding them back in the corresponding method
1265 sub _open_outer_paren {
1266 my ($self, $sql) = @_;
1268 while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
1270 # there are closing parens inside, need the heavy duty machinery
1271 # to reevaluate the extraction starting from $sql (full reevaluation)
1272 if ($inner =~ /\)/) {
1273 require Text::Balanced;
1275 my (undef, $remainder) = do {
1276 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1278 Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
1281 # the entire expression needs to be a balanced bracketed thing
1282 # (after an extract no remainder sans trailing space)
1283 last if defined $remainder and $remainder =~ /\S/;
1293 #======================================================================
1295 #======================================================================
1297 sub _expand_order_by {
1298 my ($self, $arg) = @_;
1300 return unless defined($arg) and not (ref($arg) eq 'ARRAY' and !@$arg);
1302 return $self->_expand_maybe_list_expr($arg)
1303 if ref($arg) eq 'HASH' and ($arg->{-op}||[''])->[0] eq ',';
1305 my $expander = sub {
1306 my ($self, $dir, $expr) = @_;
1307 my @to_expand = ref($expr) eq 'ARRAY' ? @$expr : $expr;
1308 foreach my $arg (@to_expand) {
1312 and grep /^-(asc|desc)$/, keys %$arg
1314 puke "ordering direction hash passed to order by must have exactly one key (-asc or -desc)";
1318 defined($dir) ? { -op => [ $dir =~ /^-?(.*)$/ ,=> $_ ] } : $_
1320 map $self->expand_expr($_, -ident),
1321 map ref($_) eq 'ARRAY' ? @$_ : $_, @to_expand;
1322 return undef unless @exp;
1323 return undef if @exp == 1 and not defined($exp[0]);
1324 return +{ -op => [ ',', @exp ] };
1327 local @{$self->{expand}}{qw(asc desc)} = (($expander) x 2);
1329 return $self->$expander(undef, $arg);
1333 my ($self, $arg) = @_;
1335 return '' unless defined(my $expanded = $self->_expand_order_by($arg));
1337 my ($sql, @bind) = $self->render_aqt($expanded);
1339 return '' unless length($sql);
1341 my $final_sql = $self->_sqlcase(' order by ').$sql;
1343 return wantarray ? ($final_sql, @bind) : $final_sql;
1346 # _order_by no longer needs to call this so doesn't but DBIC uses it.
1348 sub _order_by_chunks {
1349 my ($self, $arg) = @_;
1351 return () unless defined(my $expanded = $self->_expand_order_by($arg));
1353 return $self->_chunkify_order_by($expanded);
1356 sub _chunkify_order_by {
1357 my ($self, $expanded) = @_;
1359 return grep length, $self->render_aqt($expanded)
1360 if $expanded->{-ident} or @{$expanded->{-literal}||[]} == 1;
1363 if (ref() eq 'HASH' and $_->{-op} and $_->{-op}[0] eq ',') {
1364 my ($comma, @list) = @{$_->{-op}};
1365 return map $self->_chunkify_order_by($_), @list;
1367 return [ $self->render_aqt($_) ];
1371 #======================================================================
1372 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1373 #======================================================================
1379 $self->_expand_maybe_list_expr($from, -ident)
1384 #======================================================================
1386 #======================================================================
1388 sub _expand_maybe_list_expr {
1389 my ($self, $expr, $default) = @_;
1391 ',', map $self->expand_expr($_, $default),
1392 @{$expr->{-op}}[1..$#{$expr->{-op}}]
1393 ] } if ref($expr) eq 'HASH' and ($expr->{-op}||[''])->[0] eq ',';
1394 return +{ -op => [ ',',
1395 map $self->expand_expr($_, $default),
1396 ref($expr) eq 'ARRAY' ? @$expr : $expr
1400 # highly optimized, as it's called way too often
1402 # my ($self, $label) = @_;
1404 return '' unless defined $_[1];
1405 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1406 puke 'Identifier cannot be hashref' if ref($_[1]) eq 'HASH';
1408 unless ($_[0]->{quote_char}) {
1409 if (ref($_[1]) eq 'ARRAY') {
1410 return join($_[0]->{name_sep}||'.', @{$_[1]});
1412 $_[0]->_assert_pass_injection_guard($_[1]);
1417 my $qref = ref $_[0]->{quote_char};
1419 !$qref ? ($_[0]->{quote_char}, $_[0]->{quote_char})
1420 : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}}
1421 : puke "Unsupported quote_char format: $_[0]->{quote_char}";
1423 my $esc = $_[0]->{escape_char} || $r;
1425 # parts containing * are naturally unquoted
1427 $_[0]->{name_sep}||'',
1431 : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r }
1433 (ref($_[1]) eq 'ARRAY'
1437 ? split (/\Q$_[0]->{name_sep}\E/, $_[1] )
1445 # Conversion, if applicable
1447 #my ($self, $arg) = @_;
1448 if ($_[0]->{convert_where}) {
1449 return $_[0]->_sqlcase($_[0]->{convert_where}) .'(' . $_[1] . ')';
1456 #my ($self, $col, @vals) = @_;
1457 # called often - tighten code
1458 return $_[0]->{bindtype} eq 'columns'
1459 ? map {[$_[1], $_]} @_[2 .. $#_]
1464 # Dies if any element of @bind is not in [colname => value] format
1465 # if bindtype is 'columns'.
1466 sub _assert_bindval_matches_bindtype {
1467 # my ($self, @bind) = @_;
1469 if ($self->{bindtype} eq 'columns') {
1471 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1472 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1478 sub _join_sql_clauses {
1479 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1481 if (@$clauses_aref > 1) {
1482 my $join = " " . $self->_sqlcase($logic) . " ";
1483 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1484 return ($sql, @$bind_aref);
1486 elsif (@$clauses_aref) {
1487 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1490 return (); # if no SQL, ignore @$bind_aref
1495 # Fix SQL case, if so requested
1497 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1498 # don't touch the argument ... crooked logic, but let's not change it!
1499 return $_[0]->{case} ? $_[1] : uc($_[1]);
1503 #======================================================================
1504 # DISPATCHING FROM REFKIND
1505 #======================================================================
1508 my ($self, $data) = @_;
1510 return 'UNDEF' unless defined $data;
1512 # blessed objects are treated like scalars
1513 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1515 return 'SCALAR' unless $ref;
1518 while ($ref eq 'REF') {
1520 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1524 return ($ref||'SCALAR') . ('REF' x $n_steps);
1528 my ($self, $data) = @_;
1529 my @try = ($self->_refkind($data));
1530 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1531 push @try, 'FALLBACK';
1535 sub _METHOD_FOR_refkind {
1536 my ($self, $meth_prefix, $data) = @_;
1539 for (@{$self->_try_refkind($data)}) {
1540 $method = $self->can($meth_prefix."_".$_)
1544 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1548 sub _SWITCH_refkind {
1549 my ($self, $data, $dispatch_table) = @_;
1552 for (@{$self->_try_refkind($data)}) {
1553 $coderef = $dispatch_table->{$_}
1557 puke "no dispatch entry for ".$self->_refkind($data)
1566 #======================================================================
1567 # VALUES, GENERATE, AUTOLOAD
1568 #======================================================================
1570 # LDNOTE: original code from nwiger, didn't touch code in that section
1571 # I feel the AUTOLOAD stuff should not be the default, it should
1572 # only be activated on explicit demand by user.
1576 my $data = shift || return;
1577 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1578 unless ref $data eq 'HASH';
1581 foreach my $k (sort keys %$data) {
1582 my $v = $data->{$k};
1583 $self->_SWITCH_refkind($v, {
1585 if ($self->{array_datatypes}) { # array datatype
1586 push @all_bind, $self->_bindtype($k, $v);
1588 else { # literal SQL with bind
1589 my ($sql, @bind) = @$v;
1590 $self->_assert_bindval_matches_bindtype(@bind);
1591 push @all_bind, @bind;
1594 ARRAYREFREF => sub { # literal SQL with bind
1595 my ($sql, @bind) = @${$v};
1596 $self->_assert_bindval_matches_bindtype(@bind);
1597 push @all_bind, @bind;
1599 SCALARREF => sub { # literal SQL without bind
1601 SCALAR_or_UNDEF => sub {
1602 push @all_bind, $self->_bindtype($k, $v);
1613 my(@sql, @sqlq, @sqlv);
1617 if ($ref eq 'HASH') {
1618 for my $k (sort keys %$_) {
1621 my $label = $self->_quote($k);
1622 if ($r eq 'ARRAY') {
1623 # literal SQL with bind
1624 my ($sql, @bind) = @$v;
1625 $self->_assert_bindval_matches_bindtype(@bind);
1626 push @sqlq, "$label = $sql";
1628 } elsif ($r eq 'SCALAR') {
1629 # literal SQL without bind
1630 push @sqlq, "$label = $$v";
1632 push @sqlq, "$label = ?";
1633 push @sqlv, $self->_bindtype($k, $v);
1636 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1637 } elsif ($ref eq 'ARRAY') {
1638 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1641 if ($r eq 'ARRAY') { # literal SQL with bind
1642 my ($sql, @bind) = @$v;
1643 $self->_assert_bindval_matches_bindtype(@bind);
1646 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1647 # embedded literal SQL
1654 push @sql, '(' . join(', ', @sqlq) . ')';
1655 } elsif ($ref eq 'SCALAR') {
1659 # strings get case twiddled
1660 push @sql, $self->_sqlcase($_);
1664 my $sql = join ' ', @sql;
1666 # this is pretty tricky
1667 # if ask for an array, return ($stmt, @bind)
1668 # otherwise, s/?/shift @sqlv/ to put it inline
1670 return ($sql, @sqlv);
1672 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1673 ref $d ? $d->[1] : $d/e;
1682 # This allows us to check for a local, then _form, attr
1684 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1685 return $self->generate($name, @_);
1696 SQL::Abstract - Generate SQL from Perl data structures
1702 my $sql = SQL::Abstract->new;
1704 my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order);
1706 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1708 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1710 my($stmt, @bind) = $sql->delete($table, \%where);
1712 # Then, use these in your DBI statements
1713 my $sth = $dbh->prepare($stmt);
1714 $sth->execute(@bind);
1716 # Just generate the WHERE clause
1717 my($stmt, @bind) = $sql->where(\%where, $order);
1719 # Return values in the same order, for hashed queries
1720 # See PERFORMANCE section for more details
1721 my @bind = $sql->values(\%fieldvals);
1725 This module was inspired by the excellent L<DBIx::Abstract>.
1726 However, in using that module I found that what I really wanted
1727 to do was generate SQL, but still retain complete control over my
1728 statement handles and use the DBI interface. So, I set out to
1729 create an abstract SQL generation module.
1731 While based on the concepts used by L<DBIx::Abstract>, there are
1732 several important differences, especially when it comes to WHERE
1733 clauses. I have modified the concepts used to make the SQL easier
1734 to generate from Perl data structures and, IMO, more intuitive.
1735 The underlying idea is for this module to do what you mean, based
1736 on the data structures you provide it. The big advantage is that
1737 you don't have to modify your code every time your data changes,
1738 as this module figures it out.
1740 To begin with, an SQL INSERT is as easy as just specifying a hash
1741 of C<key=value> pairs:
1744 name => 'Jimbo Bobson',
1745 phone => '123-456-7890',
1746 address => '42 Sister Lane',
1747 city => 'St. Louis',
1748 state => 'Louisiana',
1751 The SQL can then be generated with this:
1753 my($stmt, @bind) = $sql->insert('people', \%data);
1755 Which would give you something like this:
1757 $stmt = "INSERT INTO people
1758 (address, city, name, phone, state)
1759 VALUES (?, ?, ?, ?, ?)";
1760 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1761 '123-456-7890', 'Louisiana');
1763 These are then used directly in your DBI code:
1765 my $sth = $dbh->prepare($stmt);
1766 $sth->execute(@bind);
1768 =head2 Inserting and Updating Arrays
1770 If your database has array types (like for example Postgres),
1771 activate the special option C<< array_datatypes => 1 >>
1772 when creating the C<SQL::Abstract> object.
1773 Then you may use an arrayref to insert and update database array types:
1775 my $sql = SQL::Abstract->new(array_datatypes => 1);
1777 planets => [qw/Mercury Venus Earth Mars/]
1780 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1784 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1786 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1789 =head2 Inserting and Updating SQL
1791 In order to apply SQL functions to elements of your C<%data> you may
1792 specify a reference to an arrayref for the given hash value. For example,
1793 if you need to execute the Oracle C<to_date> function on a value, you can
1794 say something like this:
1798 date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
1801 The first value in the array is the actual SQL. Any other values are
1802 optional and would be included in the bind values array. This gives
1805 my($stmt, @bind) = $sql->insert('people', \%data);
1807 $stmt = "INSERT INTO people (name, date_entered)
1808 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1809 @bind = ('Bill', '03/02/2003');
1811 An UPDATE is just as easy, all you change is the name of the function:
1813 my($stmt, @bind) = $sql->update('people', \%data);
1815 Notice that your C<%data> isn't touched; the module will generate
1816 the appropriately quirky SQL for you automatically. Usually you'll
1817 want to specify a WHERE clause for your UPDATE, though, which is
1818 where handling C<%where> hashes comes in handy...
1820 =head2 Complex where statements
1822 This module can generate pretty complicated WHERE statements
1823 easily. For example, simple C<key=value> pairs are taken to mean
1824 equality, and if you want to see if a field is within a set
1825 of values, you can use an arrayref. Let's say we wanted to
1826 SELECT some data based on this criteria:
1829 requestor => 'inna',
1830 worker => ['nwiger', 'rcwe', 'sfz'],
1831 status => { '!=', 'completed' }
1834 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1836 The above would give you something like this:
1838 $stmt = "SELECT * FROM tickets WHERE
1839 ( requestor = ? ) AND ( status != ? )
1840 AND ( worker = ? OR worker = ? OR worker = ? )";
1841 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1843 Which you could then use in DBI code like so:
1845 my $sth = $dbh->prepare($stmt);
1846 $sth->execute(@bind);
1852 The methods are simple. There's one for every major SQL operation,
1853 and a constructor you use first. The arguments are specified in a
1854 similar order for each method (table, then fields, then a where
1855 clause) to try and simplify things.
1857 =head2 new(option => 'value')
1859 The C<new()> function takes a list of options and values, and returns
1860 a new B<SQL::Abstract> object which can then be used to generate SQL
1861 through the methods below. The options accepted are:
1867 If set to 'lower', then SQL will be generated in all lowercase. By
1868 default SQL is generated in "textbook" case meaning something like:
1870 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1872 Any setting other than 'lower' is ignored.
1876 This determines what the default comparison operator is. By default
1877 it is C<=>, meaning that a hash like this:
1879 %where = (name => 'nwiger', email => 'nate@wiger.org');
1881 Will generate SQL like this:
1883 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1885 However, you may want loose comparisons by default, so if you set
1886 C<cmp> to C<like> you would get SQL such as:
1888 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1890 You can also override the comparison on an individual basis - see
1891 the huge section on L</"WHERE CLAUSES"> at the bottom.
1893 =item sqltrue, sqlfalse
1895 Expressions for inserting boolean values within SQL statements.
1896 By default these are C<1=1> and C<1=0>. They are used
1897 by the special operators C<-in> and C<-not_in> for generating
1898 correct SQL even when the argument is an empty array (see below).
1902 This determines the default logical operator for multiple WHERE
1903 statements in arrays or hashes. If absent, the default logic is "or"
1904 for arrays, and "and" for hashes. This means that a WHERE
1908 event_date => {'>=', '2/13/99'},
1909 event_date => {'<=', '4/24/03'},
1912 will generate SQL like this:
1914 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1916 This is probably not what you want given this query, though (look
1917 at the dates). To change the "OR" to an "AND", simply specify:
1919 my $sql = SQL::Abstract->new(logic => 'and');
1921 Which will change the above C<WHERE> to:
1923 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1925 The logic can also be changed locally by inserting
1926 a modifier in front of an arrayref:
1928 @where = (-and => [event_date => {'>=', '2/13/99'},
1929 event_date => {'<=', '4/24/03'} ]);
1931 See the L</"WHERE CLAUSES"> section for explanations.
1935 This will automatically convert comparisons using the specified SQL
1936 function for both column and value. This is mostly used with an argument
1937 of C<upper> or C<lower>, so that the SQL will have the effect of
1938 case-insensitive "searches". For example, this:
1940 $sql = SQL::Abstract->new(convert => 'upper');
1941 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1943 Will turn out the following SQL:
1945 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1947 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1948 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1949 not validate this option; it will just pass through what you specify verbatim).
1953 This is a kludge because many databases suck. For example, you can't
1954 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1955 Instead, you have to use C<bind_param()>:
1957 $sth->bind_param(1, 'reg data');
1958 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1960 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1961 which loses track of which field each slot refers to. Fear not.
1963 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1964 Currently, you can specify either C<normal> (default) or C<columns>. If you
1965 specify C<columns>, you will get an array that looks like this:
1967 my $sql = SQL::Abstract->new(bindtype => 'columns');
1968 my($stmt, @bind) = $sql->insert(...);
1971 [ 'column1', 'value1' ],
1972 [ 'column2', 'value2' ],
1973 [ 'column3', 'value3' ],
1976 You can then iterate through this manually, using DBI's C<bind_param()>.
1978 $sth->prepare($stmt);
1981 my($col, $data) = @$_;
1982 if ($col eq 'details' || $col eq 'comments') {
1983 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1984 } elsif ($col eq 'image') {
1985 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1987 $sth->bind_param($i, $data);
1991 $sth->execute; # execute without @bind now
1993 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1994 Basically, the advantage is still that you don't have to care which fields
1995 are or are not included. You could wrap that above C<for> loop in a simple
1996 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1997 get a layer of abstraction over manual SQL specification.
1999 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
2000 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
2001 will expect the bind values in this format.
2005 This is the character that a table or column name will be quoted
2006 with. By default this is an empty string, but you could set it to
2007 the character C<`>, to generate SQL like this:
2009 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
2011 Alternatively, you can supply an array ref of two items, the first being the left
2012 hand quote character, and the second the right hand quote character. For
2013 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
2014 that generates SQL like this:
2016 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
2018 Quoting is useful if you have tables or columns names that are reserved
2019 words in your database's SQL dialect.
2023 This is the character that will be used to escape L</quote_char>s appearing
2024 in an identifier before it has been quoted.
2026 The parameter default in case of a single L</quote_char> character is the quote
2029 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
2030 this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences
2031 of the B<opening (left)> L</quote_char> within the identifier are currently left
2032 untouched. The default for opening-closing-style quotes may change in future
2033 versions, thus you are B<strongly encouraged> to specify the escape character
2038 This is the character that separates a table and column name. It is
2039 necessary to specify this when the C<quote_char> option is selected,
2040 so that tables and column names can be individually quoted like this:
2042 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2044 =item injection_guard
2046 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2047 column name specified in a query structure. This is a safety mechanism to avoid
2048 injection attacks when mishandling user input e.g.:
2050 my %condition_as_column_value_pairs = get_values_from_user();
2051 $sqla->select( ... , \%condition_as_column_value_pairs );
2053 If the expression matches an exception is thrown. Note that literal SQL
2054 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2056 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2058 =item array_datatypes
2060 When this option is true, arrayrefs in INSERT or UPDATE are
2061 interpreted as array datatypes and are passed directly
2063 When this option is false, arrayrefs are interpreted
2064 as literal SQL, just like refs to arrayrefs
2065 (but this behavior is for backwards compatibility; when writing
2066 new queries, use the "reference to arrayref" syntax
2072 Takes a reference to a list of "special operators"
2073 to extend the syntax understood by L<SQL::Abstract>.
2074 See section L</"SPECIAL OPERATORS"> for details.
2078 Takes a reference to a list of "unary operators"
2079 to extend the syntax understood by L<SQL::Abstract>.
2080 See section L</"UNARY OPERATORS"> for details.
2086 =head2 insert($table, \@values || \%fieldvals, \%options)
2088 This is the simplest function. You simply give it a table name
2089 and either an arrayref of values or hashref of field/value pairs.
2090 It returns an SQL INSERT statement and a list of bind values.
2091 See the sections on L</"Inserting and Updating Arrays"> and
2092 L</"Inserting and Updating SQL"> for information on how to insert
2093 with those data types.
2095 The optional C<\%options> hash reference may contain additional
2096 options to generate the insert SQL. Currently supported options
2103 Takes either a scalar of raw SQL fields, or an array reference of
2104 field names, and adds on an SQL C<RETURNING> statement at the end.
2105 This allows you to return data generated by the insert statement
2106 (such as row IDs) without performing another C<SELECT> statement.
2107 Note, however, this is not part of the SQL standard and may not
2108 be supported by all database engines.
2112 =head2 update($table, \%fieldvals, \%where, \%options)
2114 This takes a table, hashref of field/value pairs, and an optional
2115 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2117 See the sections on L</"Inserting and Updating Arrays"> and
2118 L</"Inserting and Updating SQL"> for information on how to insert
2119 with those data types.
2121 The optional C<\%options> hash reference may contain additional
2122 options to generate the update SQL. Currently supported options
2129 See the C<returning> option to
2130 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2134 =head2 select($source, $fields, $where, $order)
2136 This returns a SQL SELECT statement and associated list of bind values, as
2137 specified by the arguments:
2143 Specification of the 'FROM' part of the statement.
2144 The argument can be either a plain scalar (interpreted as a table
2145 name, will be quoted), or an arrayref (interpreted as a list
2146 of table names, joined by commas, quoted), or a scalarref
2147 (literal SQL, not quoted).
2151 Specification of the list of fields to retrieve from
2153 The argument can be either an arrayref (interpreted as a list
2154 of field names, will be joined by commas and quoted), or a
2155 plain scalar (literal SQL, not quoted).
2156 Please observe that this API is not as flexible as that of
2157 the first argument C<$source>, for backwards compatibility reasons.
2161 Optional argument to specify the WHERE part of the query.
2162 The argument is most often a hashref, but can also be
2163 an arrayref or plain scalar --
2164 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2168 Optional argument to specify the ORDER BY part of the query.
2169 The argument can be a scalar, a hashref or an arrayref
2170 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2176 =head2 delete($table, \%where, \%options)
2178 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2179 It returns an SQL DELETE statement and list of bind values.
2181 The optional C<\%options> hash reference may contain additional
2182 options to generate the delete SQL. Currently supported options
2189 See the C<returning> option to
2190 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2194 =head2 where(\%where, $order)
2196 This is used to generate just the WHERE clause. For example,
2197 if you have an arbitrary data structure and know what the
2198 rest of your SQL is going to look like, but want an easy way
2199 to produce a WHERE clause, use this. It returns an SQL WHERE
2200 clause and list of bind values.
2203 =head2 values(\%data)
2205 This just returns the values from the hash C<%data>, in the same
2206 order that would be returned from any of the other above queries.
2207 Using this allows you to markedly speed up your queries if you
2208 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2210 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2212 Warning: This is an experimental method and subject to change.
2214 This returns arbitrarily generated SQL. It's a really basic shortcut.
2215 It will return two different things, depending on return context:
2217 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2218 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2220 These would return the following:
2222 # First calling form
2223 $stmt = "CREATE TABLE test (?, ?)";
2224 @bind = (field1, field2);
2226 # Second calling form
2227 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2229 Depending on what you're trying to do, it's up to you to choose the correct
2230 format. In this example, the second form is what you would want.
2234 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2238 ALTER SESSION SET nls_date_format = 'MM/YY'
2240 You get the idea. Strings get their case twiddled, but everything
2241 else remains verbatim.
2243 =head1 EXPORTABLE FUNCTIONS
2245 =head2 is_plain_value
2247 Determines if the supplied argument is a plain value as understood by this
2252 =item * The value is C<undef>
2254 =item * The value is a non-reference
2256 =item * The value is an object with stringification overloading
2258 =item * The value is of the form C<< { -value => $anything } >>
2262 On failure returns C<undef>, on success returns a B<scalar> reference
2263 to the original supplied argument.
2269 The stringification overloading detection is rather advanced: it takes
2270 into consideration not only the presence of a C<""> overload, but if that
2271 fails also checks for enabled
2272 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2273 on either C<0+> or C<bool>.
2275 Unfortunately testing in the field indicates that this
2276 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2277 but only when very large numbers of stringifying objects are involved.
2278 At the time of writing ( Sep 2014 ) there is no clear explanation of
2279 the direct cause, nor is there a manageably small test case that reliably
2280 reproduces the problem.
2282 If you encounter any of the following exceptions in B<random places within
2283 your application stack> - this module may be to blame:
2285 Operation "ne": no method found,
2286 left argument in overloaded package <something>,
2287 right argument in overloaded package <something>
2291 Stub found while resolving method "???" overloading """" in package <something>
2293 If you fall victim to the above - please attempt to reduce the problem
2294 to something that could be sent to the L<SQL::Abstract developers
2295 |DBIx::Class/GETTING HELP/SUPPORT>
2296 (either publicly or privately). As a workaround in the meantime you can
2297 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2298 value, which will most likely eliminate your problem (at the expense of
2299 not being able to properly detect exotic forms of stringification).
2301 This notice and environment variable will be removed in a future version,
2302 as soon as the underlying problem is found and a reliable workaround is
2307 =head2 is_literal_value
2309 Determines if the supplied argument is a literal value as understood by this
2314 =item * C<\$sql_string>
2316 =item * C<\[ $sql_string, @bind_values ]>
2320 On failure returns C<undef>, on success returns an B<array> reference
2321 containing the unpacked version of the supplied literal SQL and bind values.
2323 =head1 WHERE CLAUSES
2327 This module uses a variation on the idea from L<DBIx::Abstract>. It
2328 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2329 module is that things in arrays are OR'ed, and things in hashes
2332 The easiest way to explain is to show lots of examples. After
2333 each C<%where> hash shown, it is assumed you used:
2335 my($stmt, @bind) = $sql->where(\%where);
2337 However, note that the C<%where> hash can be used directly in any
2338 of the other functions as well, as described above.
2340 =head2 Key-value pairs
2342 So, let's get started. To begin, a simple hash:
2346 status => 'completed'
2349 Is converted to SQL C<key = val> statements:
2351 $stmt = "WHERE user = ? AND status = ?";
2352 @bind = ('nwiger', 'completed');
2354 One common thing I end up doing is having a list of values that
2355 a field can be in. To do this, simply specify a list inside of
2360 status => ['assigned', 'in-progress', 'pending'];
2363 This simple code will create the following:
2365 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2366 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2368 A field associated to an empty arrayref will be considered a
2369 logical false and will generate 0=1.
2371 =head2 Tests for NULL values
2373 If the value part is C<undef> then this is converted to SQL <IS NULL>
2382 $stmt = "WHERE user = ? AND status IS NULL";
2385 To test if a column IS NOT NULL:
2389 status => { '!=', undef },
2392 =head2 Specific comparison operators
2394 If you want to specify a different type of operator for your comparison,
2395 you can use a hashref for a given column:
2399 status => { '!=', 'completed' }
2402 Which would generate:
2404 $stmt = "WHERE user = ? AND status != ?";
2405 @bind = ('nwiger', 'completed');
2407 To test against multiple values, just enclose the values in an arrayref:
2409 status => { '=', ['assigned', 'in-progress', 'pending'] };
2411 Which would give you:
2413 "WHERE status = ? OR status = ? OR status = ?"
2416 The hashref can also contain multiple pairs, in which case it is expanded
2417 into an C<AND> of its elements:
2421 status => { '!=', 'completed', -not_like => 'pending%' }
2424 # Or more dynamically, like from a form
2425 $where{user} = 'nwiger';
2426 $where{status}{'!='} = 'completed';
2427 $where{status}{'-not_like'} = 'pending%';
2429 # Both generate this
2430 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2431 @bind = ('nwiger', 'completed', 'pending%');
2434 To get an OR instead, you can combine it with the arrayref idea:
2438 priority => [ { '=', 2 }, { '>', 5 } ]
2441 Which would generate:
2443 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2444 @bind = ('2', '5', 'nwiger');
2446 If you want to include literal SQL (with or without bind values), just use a
2447 scalar reference or reference to an arrayref as the value:
2450 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2451 date_expires => { '<' => \"now()" }
2454 Which would generate:
2456 $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2457 @bind = ('11/26/2008');
2460 =head2 Logic and nesting operators
2462 In the example above,
2463 there is a subtle trap if you want to say something like
2464 this (notice the C<AND>):
2466 WHERE priority != ? AND priority != ?
2468 Because, in Perl you I<can't> do this:
2470 priority => { '!=' => 2, '!=' => 1 }
2472 As the second C<!=> key will obliterate the first. The solution
2473 is to use the special C<-modifier> form inside an arrayref:
2475 priority => [ -and => {'!=', 2},
2479 Normally, these would be joined by C<OR>, but the modifier tells it
2480 to use C<AND> instead. (Hint: You can use this in conjunction with the
2481 C<logic> option to C<new()> in order to change the way your queries
2482 work by default.) B<Important:> Note that the C<-modifier> goes
2483 B<INSIDE> the arrayref, as an extra first element. This will
2484 B<NOT> do what you think it might:
2486 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2488 Here is a quick list of equivalencies, since there is some overlap:
2491 status => {'!=', 'completed', 'not like', 'pending%' }
2492 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2495 status => {'=', ['assigned', 'in-progress']}
2496 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2497 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2501 =head2 Special operators: IN, BETWEEN, etc.
2503 You can also use the hashref format to compare a list of fields using the
2504 C<IN> comparison operator, by specifying the list as an arrayref:
2507 status => 'completed',
2508 reportid => { -in => [567, 2335, 2] }
2511 Which would generate:
2513 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2514 @bind = ('completed', '567', '2335', '2');
2516 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2519 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2520 (by default: C<1=0>). Similarly, C<< -not_in => [] >> generates
2521 'sqltrue' (by default: C<1=1>).
2523 In addition to the array you can supply a chunk of literal sql or
2524 literal sql with bind:
2527 customer => { -in => \[
2528 'SELECT cust_id FROM cust WHERE balance > ?',
2531 status => { -in => \'SELECT status_codes FROM states' },
2537 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2538 AND status IN ( SELECT status_codes FROM states )
2542 Finally, if the argument to C<-in> is not a reference, it will be
2543 treated as a single-element array.
2545 Another pair of operators is C<-between> and C<-not_between>,
2546 used with an arrayref of two values:
2550 completion_date => {
2551 -not_between => ['2002-10-01', '2003-02-06']
2557 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2559 Just like with C<-in> all plausible combinations of literal SQL
2563 start0 => { -between => [ 1, 2 ] },
2564 start1 => { -between => \["? AND ?", 1, 2] },
2565 start2 => { -between => \"lower(x) AND upper(y)" },
2566 start3 => { -between => [
2568 \["upper(?)", 'stuff' ],
2575 ( start0 BETWEEN ? AND ? )
2576 AND ( start1 BETWEEN ? AND ? )
2577 AND ( start2 BETWEEN lower(x) AND upper(y) )
2578 AND ( start3 BETWEEN lower(x) AND upper(?) )
2580 @bind = (1, 2, 1, 2, 'stuff');
2583 These are the two builtin "special operators"; but the
2584 list can be expanded: see section L</"SPECIAL OPERATORS"> below.
2586 =head2 Unary operators: bool
2588 If you wish to test against boolean columns or functions within your
2589 database you can use the C<-bool> and C<-not_bool> operators. For
2590 example to test the column C<is_user> being true and the column
2591 C<is_enabled> being false you would use:-
2595 -not_bool => 'is_enabled',
2600 WHERE is_user AND NOT is_enabled
2602 If a more complex combination is required, testing more conditions,
2603 then you should use the and/or operators:-
2608 -not_bool => { two=> { -rlike => 'bar' } },
2609 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2620 (NOT ( three = ? OR three > ? ))
2623 =head2 Nested conditions, -and/-or prefixes
2625 So far, we've seen how multiple conditions are joined with a top-level
2626 C<AND>. We can change this by putting the different conditions we want in
2627 hashes and then putting those hashes in an array. For example:
2632 status => { -like => ['pending%', 'dispatched'] },
2636 status => 'unassigned',
2640 This data structure would create the following:
2642 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2643 OR ( user = ? AND status = ? ) )";
2644 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2647 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2648 to change the logic inside:
2654 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2655 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2662 $stmt = "WHERE ( user = ?
2663 AND ( ( workhrs > ? AND geo = ? )
2664 OR ( workhrs < ? OR geo = ? ) ) )";
2665 @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2667 =head3 Algebraic inconsistency, for historical reasons
2669 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2670 operator goes C<outside> of the nested structure; whereas when connecting
2671 several constraints on one column, the C<-and> operator goes
2672 C<inside> the arrayref. Here is an example combining both features:
2675 -and => [a => 1, b => 2],
2676 -or => [c => 3, d => 4],
2677 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2682 WHERE ( ( ( a = ? AND b = ? )
2683 OR ( c = ? OR d = ? )
2684 OR ( e LIKE ? AND e LIKE ? ) ) )
2686 This difference in syntax is unfortunate but must be preserved for
2687 historical reasons. So be careful: the two examples below would
2688 seem algebraically equivalent, but they are not
2691 { -like => 'foo%' },
2692 { -like => '%bar' },
2694 # yields: WHERE ( ( col LIKE ? AND col LIKE ? ) )
2697 { col => { -like => 'foo%' } },
2698 { col => { -like => '%bar' } },
2700 # yields: WHERE ( ( col LIKE ? OR col LIKE ? ) )
2703 =head2 Literal SQL and value type operators
2705 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2706 side" is a column name and the "right side" is a value (normally rendered as
2707 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2708 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2709 alter this behavior. There are several ways of doing so.
2713 This is a virtual operator that signals the string to its right side is an
2714 identifier (a column name) and not a value. For example to compare two
2715 columns you would write:
2718 priority => { '<', 2 },
2719 requestor => { -ident => 'submitter' },
2724 $stmt = "WHERE priority < ? AND requestor = submitter";
2727 If you are maintaining legacy code you may see a different construct as
2728 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2733 This is a virtual operator that signals that the construct to its right side
2734 is a value to be passed to DBI. This is for example necessary when you want
2735 to write a where clause against an array (for RDBMS that support such
2736 datatypes). For example:
2739 array => { -value => [1, 2, 3] }
2744 $stmt = 'WHERE array = ?';
2745 @bind = ([1, 2, 3]);
2747 Note that if you were to simply say:
2753 the result would probably not be what you wanted:
2755 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2760 Finally, sometimes only literal SQL will do. To include a random snippet
2761 of SQL verbatim, you specify it as a scalar reference. Consider this only
2762 as a last resort. Usually there is a better way. For example:
2765 priority => { '<', 2 },
2766 requestor => { -in => \'(SELECT name FROM hitmen)' },
2771 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2774 Note that in this example, you only get one bind parameter back, since
2775 the verbatim SQL is passed as part of the statement.
2779 Never use untrusted input as a literal SQL argument - this is a massive
2780 security risk (there is no way to check literal snippets for SQL
2781 injections and other nastyness). If you need to deal with untrusted input
2782 use literal SQL with placeholders as described next.
2784 =head3 Literal SQL with placeholders and bind values (subqueries)
2786 If the literal SQL to be inserted has placeholders and bind values,
2787 use a reference to an arrayref (yes this is a double reference --
2788 not so common, but perfectly legal Perl). For example, to find a date
2789 in Postgres you can use something like this:
2792 date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
2797 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2800 Note that you must pass the bind values in the same format as they are returned
2801 by L<where|/where(\%where, $order)>. This means that if you set L</bindtype>
2802 to C<columns>, you must provide the bind values in the
2803 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
2804 scalar value; most commonly the column name, but you can use any scalar value
2805 (including references and blessed references), L<SQL::Abstract> will simply
2806 pass it through intact. So if C<bindtype> is set to C<columns> the above
2807 example will look like:
2810 date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
2813 Literal SQL is especially useful for nesting parenthesized clauses in the
2814 main SQL query. Here is a first example:
2816 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2820 bar => \["IN ($sub_stmt)" => @sub_bind],
2825 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2826 WHERE c2 < ? AND c3 LIKE ?))";
2827 @bind = (1234, 100, "foo%");
2829 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2830 are expressed in the same way. Of course the C<$sub_stmt> and
2831 its associated bind values can be generated through a former call
2834 my ($sub_stmt, @sub_bind)
2835 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2836 c3 => {-like => "foo%"}});
2839 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2842 In the examples above, the subquery was used as an operator on a column;
2843 but the same principle also applies for a clause within the main C<%where>
2844 hash, like an EXISTS subquery:
2846 my ($sub_stmt, @sub_bind)
2847 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2848 my %where = ( -and => [
2850 \["EXISTS ($sub_stmt)" => @sub_bind],
2855 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2856 WHERE c1 = ? AND c2 > t0.c0))";
2860 Observe that the condition on C<c2> in the subquery refers to
2861 column C<t0.c0> of the main query: this is I<not> a bind
2862 value, so we have to express it through a scalar ref.
2863 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2864 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2865 what we wanted here.
2867 Finally, here is an example where a subquery is used
2868 for expressing unary negation:
2870 my ($sub_stmt, @sub_bind)
2871 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2872 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2874 lname => {like => '%son%'},
2875 \["NOT ($sub_stmt)" => @sub_bind],
2880 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2881 @bind = ('%son%', 10, 20)
2883 =head3 Deprecated usage of Literal SQL
2885 Below are some examples of archaic use of literal SQL. It is shown only as
2886 reference for those who deal with legacy code. Each example has a much
2887 better, cleaner and safer alternative that users should opt for in new code.
2893 my %where = ( requestor => \'IS NOT NULL' )
2895 $stmt = "WHERE requestor IS NOT NULL"
2897 This used to be the way of generating NULL comparisons, before the handling
2898 of C<undef> got formalized. For new code please use the superior syntax as
2899 described in L</Tests for NULL values>.
2903 my %where = ( requestor => \'= submitter' )
2905 $stmt = "WHERE requestor = submitter"
2907 This used to be the only way to compare columns. Use the superior L</-ident>
2908 method for all new code. For example an identifier declared in such a way
2909 will be properly quoted if L</quote_char> is properly set, while the legacy
2910 form will remain as supplied.
2914 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2916 $stmt = "WHERE completed > ? AND is_ready"
2917 @bind = ('2012-12-21')
2919 Using an empty string literal used to be the only way to express a boolean.
2920 For all new code please use the much more readable
2921 L<-bool|/Unary operators: bool> operator.
2927 These pages could go on for a while, since the nesting of the data
2928 structures this module can handle are pretty much unlimited (the
2929 module implements the C<WHERE> expansion as a recursive function
2930 internally). Your best bet is to "play around" with the module a
2931 little to see how the data structures behave, and choose the best
2932 format for your data based on that.
2934 And of course, all the values above will probably be replaced with
2935 variables gotten from forms or the command line. After all, if you
2936 knew everything ahead of time, you wouldn't have to worry about
2937 dynamically-generating SQL and could just hardwire it into your
2940 =head1 ORDER BY CLAUSES
2942 Some functions take an order by clause. This can either be a scalar (just a
2943 column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' }
2944 >>, a scalarref, an arrayref-ref, or an arrayref of any of the previous
2947 Given | Will Generate
2948 ---------------------------------------------------------------
2950 'colA' | ORDER BY colA
2952 [qw/colA colB/] | ORDER BY colA, colB
2954 {-asc => 'colA'} | ORDER BY colA ASC
2956 {-desc => 'colB'} | ORDER BY colB DESC
2958 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2960 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2962 \'colA DESC' | ORDER BY colA DESC
2964 \[ 'FUNC(colA, ?)', $x ] | ORDER BY FUNC(colA, ?)
2965 | /* ...with $x bound to ? */
2968 { -asc => 'colA' }, | colA ASC,
2969 { -desc => [qw/colB/] }, | colB DESC,
2970 { -asc => [qw/colC colD/] },| colC ASC, colD ASC,
2971 \'colE DESC', | colE DESC,
2972 \[ 'FUNC(colF, ?)', $x ], | FUNC(colF, ?)
2973 ] | /* ...with $x bound to ? */
2974 ===============================================================
2978 =head1 SPECIAL OPERATORS
2980 my $sqlmaker = SQL::Abstract->new(special_ops => [
2984 my ($self, $field, $op, $arg) = @_;
2990 handler => 'method_name',
2994 A "special operator" is a SQL syntactic clause that can be
2995 applied to a field, instead of a usual binary operator.
2998 WHERE field IN (?, ?, ?)
2999 WHERE field BETWEEN ? AND ?
3000 WHERE MATCH(field) AGAINST (?, ?)
3002 Special operators IN and BETWEEN are fairly standard and therefore
3003 are builtin within C<SQL::Abstract> (as the overridable methods
3004 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
3005 like the MATCH .. AGAINST example above which is specific to MySQL,
3006 you can write your own operator handlers - supply a C<special_ops>
3007 argument to the C<new> method. That argument takes an arrayref of
3008 operator definitions; each operator definition is a hashref with two
3015 the regular expression to match the operator
3019 Either a coderef or a plain scalar method name. In both cases
3020 the expected return is C<< ($sql, @bind) >>.
3022 When supplied with a method name, it is simply called on the
3023 L<SQL::Abstract> object as:
3025 $self->$method_name($field, $op, $arg)
3029 $field is the LHS of the operator
3030 $op is the part that matched the handler regex
3033 When supplied with a coderef, it is called as:
3035 $coderef->($self, $field, $op, $arg)
3040 For example, here is an implementation
3041 of the MATCH .. AGAINST syntax for MySQL
3043 my $sqlmaker = SQL::Abstract->new(special_ops => [
3045 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
3046 {regex => qr/^match$/i,
3048 my ($self, $field, $op, $arg) = @_;
3049 $arg = [$arg] if not ref $arg;
3050 my $label = $self->_quote($field);
3051 my ($placeholder) = $self->_convert('?');
3052 my $placeholders = join ", ", (($placeholder) x @$arg);
3053 my $sql = $self->_sqlcase('match') . " ($label) "
3054 . $self->_sqlcase('against') . " ($placeholders) ";
3055 my @bind = $self->_bindtype($field, @$arg);
3056 return ($sql, @bind);
3063 =head1 UNARY OPERATORS
3065 my $sqlmaker = SQL::Abstract->new(unary_ops => [
3069 my ($self, $op, $arg) = @_;
3075 handler => 'method_name',
3079 A "unary operator" is a SQL syntactic clause that can be
3080 applied to a field - the operator goes before the field
3082 You can write your own operator handlers - supply a C<unary_ops>
3083 argument to the C<new> method. That argument takes an arrayref of
3084 operator definitions; each operator definition is a hashref with two
3091 the regular expression to match the operator
3095 Either a coderef or a plain scalar method name. In both cases
3096 the expected return is C<< $sql >>.
3098 When supplied with a method name, it is simply called on the
3099 L<SQL::Abstract> object as:
3101 $self->$method_name($op, $arg)
3105 $op is the part that matched the handler regex
3106 $arg is the RHS or argument of the operator
3108 When supplied with a coderef, it is called as:
3110 $coderef->($self, $op, $arg)
3118 Thanks to some benchmarking by Mark Stosberg, it turns out that
3119 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3120 I must admit this wasn't an intentional design issue, but it's a
3121 byproduct of the fact that you get to control your C<DBI> handles
3124 To maximize performance, use a code snippet like the following:
3126 # prepare a statement handle using the first row
3127 # and then reuse it for the rest of the rows
3129 for my $href (@array_of_hashrefs) {
3130 $stmt ||= $sql->insert('table', $href);
3131 $sth ||= $dbh->prepare($stmt);
3132 $sth->execute($sql->values($href));
3135 The reason this works is because the keys in your C<$href> are sorted
3136 internally by B<SQL::Abstract>. Thus, as long as your data retains
3137 the same structure, you only have to generate the SQL the first time
3138 around. On subsequent queries, simply use the C<values> function provided
3139 by this module to return your values in the correct order.
3141 However this depends on the values having the same type - if, for
3142 example, the values of a where clause may either have values
3143 (resulting in sql of the form C<column = ?> with a single bind
3144 value), or alternatively the values might be C<undef> (resulting in
3145 sql of the form C<column IS NULL> with no bind value) then the
3146 caching technique suggested will not work.
3150 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3151 really like this part (I do, at least). Building up a complex query
3152 can be as simple as the following:
3159 use CGI::FormBuilder;
3162 my $form = CGI::FormBuilder->new(...);
3163 my $sql = SQL::Abstract->new;
3165 if ($form->submitted) {
3166 my $field = $form->field;
3167 my $id = delete $field->{id};
3168 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3171 Of course, you would still have to connect using C<DBI> to run the
3172 query, but the point is that if you make your form look like your
3173 table, the actual query script can be extremely simplistic.
3175 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3176 a fast interface to returning and formatting data. I frequently
3177 use these three modules together to write complex database query
3178 apps in under 50 lines.
3180 =head1 HOW TO CONTRIBUTE
3182 Contributions are always welcome, in all usable forms (we especially
3183 welcome documentation improvements). The delivery methods include git-
3184 or unified-diff formatted patches, GitHub pull requests, or plain bug
3185 reports either via RT or the Mailing list. Contributors are generally
3186 granted full access to the official repository after their first several
3187 patches pass successful review.
3189 This project is maintained in a git repository. The code and related tools are
3190 accessible at the following locations:
3194 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3196 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3198 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3200 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3206 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3207 Great care has been taken to preserve the I<published> behavior
3208 documented in previous versions in the 1.* family; however,
3209 some features that were previously undocumented, or behaved
3210 differently from the documentation, had to be changed in order
3211 to clarify the semantics. Hence, client code that was relying
3212 on some dark areas of C<SQL::Abstract> v1.*
3213 B<might behave differently> in v1.50.
3215 The main changes are:
3221 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3225 support for the { operator => \"..." } construct (to embed literal SQL)
3229 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3233 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3237 defensive programming: check arguments
3241 fixed bug with global logic, which was previously implemented
3242 through global variables yielding side-effects. Prior versions would
3243 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3244 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3245 Now this is interpreted
3246 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3251 fixed semantics of _bindtype on array args
3255 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3256 we just avoid shifting arrays within that tree.
3260 dropped the C<_modlogic> function
3264 =head1 ACKNOWLEDGEMENTS
3266 There are a number of individuals that have really helped out with
3267 this module. Unfortunately, most of them submitted bugs via CPAN
3268 so I have no idea who they are! But the people I do know are:
3270 Ash Berlin (order_by hash term support)
3271 Matt Trout (DBIx::Class support)
3272 Mark Stosberg (benchmarking)
3273 Chas Owens (initial "IN" operator support)
3274 Philip Collins (per-field SQL functions)
3275 Eric Kolve (hashref "AND" support)
3276 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3277 Dan Kubb (support for "quote_char" and "name_sep")
3278 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3279 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3280 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3281 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3282 Oliver Charles (support for "RETURNING" after "INSERT")
3288 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3292 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3294 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3296 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3297 While not an official support venue, C<DBIx::Class> makes heavy use of
3298 C<SQL::Abstract>, and as such list members there are very familiar with
3299 how to create queries.
3303 This module is free software; you may copy this under the same
3304 terms as perl itself (either the GNU General Public License or
3305 the Artistic License)