1 package SQL::Abstract; # see doc at end of file
10 our @EXPORT_OK = qw(is_plain_value is_literal_value);
21 #======================================================================
23 #======================================================================
25 our $VERSION = '1.78';
27 # This would confuse some packagers
28 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
32 # special operators (-in, -between). May be extended/overridden by user.
33 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
34 my @BUILTIN_SPECIAL_OPS = (
35 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
36 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
37 {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
38 {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
39 {regex => qr/^ is (?: \s+ not )? $/ix, handler => '_where_field_IS'},
42 # unaryish operators - key maps to handler
43 my @BUILTIN_UNARY_OPS = (
44 # the digits are backcompat stuff
45 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
46 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
47 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
48 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
49 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
50 { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
53 #======================================================================
54 # DEBUGGING AND ERROR REPORTING
55 #======================================================================
58 return unless $_[0]->{debug}; shift; # a little faster
59 my $func = (caller(1))[3];
60 warn "[$func] ", @_, "\n";
64 my($func) = (caller(1))[3];
65 Carp::carp "[$func] Warning: ", @_;
69 my($func) = (caller(1))[3];
70 Carp::croak "[$func] Fatal: ", @_;
73 sub is_literal_value ($) {
74 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
75 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
77 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
79 defined $_[0]->{-ident} and ! length ref $_[0]->{-ident}
80 ) ? [ $_[0]->{-ident} ]
84 # FIXME XSify - this can be done so much more efficiently
85 sub is_plain_value ($) {
87 ! length ref $_[0] ? [ $_[0] ]
89 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
91 exists $_[0]->{-value}
92 ) ? [ $_[0]->{-value} ]
94 Scalar::Util::blessed $_[0]
96 # deliberately not using Devel::OverloadInfo - the checks we are
97 # intersted in are much more limited than the fullblown thing, and
98 # this is a very hot piece of code
100 # FIXME - DBI needs fixing to stringify regardless of DBD
102 # simply using ->can('(""') can leave behind stub methods that
103 # break actually using the overload later (see L<perldiag/Stub
104 # found while resolving method "%s" overloading "%s" in package
105 # "%s"> and the source of overload::mycan())
107 # either has stringification which DBI SHOULD prefer out of the box
108 grep { *{ (qq[${_}::(""]) }{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
110 # has nummification and fallback is *not* disabled
111 # reuse @_ for even moar speedz
113 grep { *{"${_}::(0+"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
116 # no fallback specified at all
117 ! ( ($_[1]) = grep { *{"${_}::()"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) } )
119 # fallback explicitly undef
120 ! defined ${"$_[1]::()"}
133 #======================================================================
135 #======================================================================
139 my $class = ref($self) || $self;
140 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
142 # choose our case by keeping an option around
143 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
145 # default logic for interpreting arrayrefs
146 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
148 # how to return bind vars
149 $opt{bindtype} ||= 'normal';
151 # default comparison is "=", but can be overridden
154 # try to recognize which are the 'equality' and 'inequality' ops
155 # (temporary quickfix (in 2007), should go through a more seasoned API)
156 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
157 $opt{inequality_op} = qr/^( != | <> )$/ix;
159 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
160 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
163 $opt{sqltrue} ||= '1=1';
164 $opt{sqlfalse} ||= '0=1';
167 $opt{special_ops} ||= [];
168 # regexes are applied in order, thus push after user-defines
169 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
172 $opt{unary_ops} ||= [];
173 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
175 # rudimentary sanity-check for user supplied bits treated as functions/operators
176 # If a purported function matches this regular expression, an exception is thrown.
177 # Literal SQL is *NOT* subject to this check, only functions (and column names
178 # when quoting is not in effect)
181 # need to guard against ()'s in column names too, but this will break tons of
182 # hacks... ideas anyone?
183 $opt{injection_guard} ||= qr/
189 return bless \%opt, $class;
193 sub _assert_pass_injection_guard {
194 if ($_[1] =~ $_[0]->{injection_guard}) {
195 my $class = ref $_[0];
196 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
197 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
198 . "{injection_guard} attribute to ${class}->new()"
203 #======================================================================
205 #======================================================================
209 my $table = $self->_table(shift);
210 my $data = shift || return;
213 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
214 my ($sql, @bind) = $self->$method($data);
215 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
217 if ($options->{returning}) {
218 my ($s, @b) = $self->_insert_returning ($options);
223 return wantarray ? ($sql, @bind) : $sql;
226 sub _insert_returning {
227 my ($self, $options) = @_;
229 my $f = $options->{returning};
231 my $fieldlist = $self->_SWITCH_refkind($f, {
232 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
233 SCALAR => sub {$self->_quote($f)},
234 SCALARREF => sub {$$f},
236 return $self->_sqlcase(' returning ') . $fieldlist;
239 sub _insert_HASHREF { # explicit list of fields and then values
240 my ($self, $data) = @_;
242 my @fields = sort keys %$data;
244 my ($sql, @bind) = $self->_insert_values($data);
247 $_ = $self->_quote($_) foreach @fields;
248 $sql = "( ".join(", ", @fields).") ".$sql;
250 return ($sql, @bind);
253 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
254 my ($self, $data) = @_;
256 # no names (arrayref) so can't generate bindtype
257 $self->{bindtype} ne 'columns'
258 or belch "can't do 'columns' bindtype when called with arrayref";
260 # fold the list of values into a hash of column name - value pairs
261 # (where the column names are artificially generated, and their
262 # lexicographical ordering keep the ordering of the original list)
263 my $i = "a"; # incremented values will be in lexicographical order
264 my $data_in_hash = { map { ($i++ => $_) } @$data };
266 return $self->_insert_values($data_in_hash);
269 sub _insert_ARRAYREFREF { # literal SQL with bind
270 my ($self, $data) = @_;
272 my ($sql, @bind) = @${$data};
273 $self->_assert_bindval_matches_bindtype(@bind);
275 return ($sql, @bind);
279 sub _insert_SCALARREF { # literal SQL without bind
280 my ($self, $data) = @_;
286 my ($self, $data) = @_;
288 my (@values, @all_bind);
289 foreach my $column (sort keys %$data) {
290 my $v = $data->{$column};
292 $self->_SWITCH_refkind($v, {
295 if ($self->{array_datatypes}) { # if array datatype are activated
297 push @all_bind, $self->_bindtype($column, $v);
299 else { # else literal SQL with bind
300 my ($sql, @bind) = @$v;
301 $self->_assert_bindval_matches_bindtype(@bind);
303 push @all_bind, @bind;
307 ARRAYREFREF => sub { # literal SQL with bind
308 my ($sql, @bind) = @${$v};
309 $self->_assert_bindval_matches_bindtype(@bind);
311 push @all_bind, @bind;
314 # THINK : anything useful to do with a HASHREF ?
315 HASHREF => sub { # (nothing, but old SQLA passed it through)
316 #TODO in SQLA >= 2.0 it will die instead
317 belch "HASH ref as bind value in insert is not supported";
319 push @all_bind, $self->_bindtype($column, $v);
322 SCALARREF => sub { # literal SQL without bind
326 SCALAR_or_UNDEF => sub {
328 push @all_bind, $self->_bindtype($column, $v);
335 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
336 return ($sql, @all_bind);
341 #======================================================================
343 #======================================================================
348 my $table = $self->_table(shift);
349 my $data = shift || return;
352 # first build the 'SET' part of the sql statement
353 my (@set, @all_bind);
354 puke "Unsupported data type specified to \$sql->update"
355 unless ref $data eq 'HASH';
357 for my $k (sort keys %$data) {
360 my $label = $self->_quote($k);
362 $self->_SWITCH_refkind($v, {
364 if ($self->{array_datatypes}) { # array datatype
365 push @set, "$label = ?";
366 push @all_bind, $self->_bindtype($k, $v);
368 else { # literal SQL with bind
369 my ($sql, @bind) = @$v;
370 $self->_assert_bindval_matches_bindtype(@bind);
371 push @set, "$label = $sql";
372 push @all_bind, @bind;
375 ARRAYREFREF => sub { # literal SQL with bind
376 my ($sql, @bind) = @${$v};
377 $self->_assert_bindval_matches_bindtype(@bind);
378 push @set, "$label = $sql";
379 push @all_bind, @bind;
381 SCALARREF => sub { # literal SQL without bind
382 push @set, "$label = $$v";
385 my ($op, $arg, @rest) = %$v;
387 puke 'Operator calls in update must be in the form { -op => $arg }'
388 if (@rest or not $op =~ /^\-(.+)/);
390 local $self->{_nested_func_lhs} = $k;
391 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
393 push @set, "$label = $sql";
394 push @all_bind, @bind;
396 SCALAR_or_UNDEF => sub {
397 push @set, "$label = ?";
398 push @all_bind, $self->_bindtype($k, $v);
404 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
408 my($where_sql, @where_bind) = $self->where($where);
410 push @all_bind, @where_bind;
413 return wantarray ? ($sql, @all_bind) : $sql;
419 #======================================================================
421 #======================================================================
426 my $table = $self->_table(shift);
427 my $fields = shift || '*';
431 my($where_sql, @bind) = $self->where($where, $order);
433 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
435 my $sql = join(' ', $self->_sqlcase('select'), $f,
436 $self->_sqlcase('from'), $table)
439 return wantarray ? ($sql, @bind) : $sql;
442 #======================================================================
444 #======================================================================
449 my $table = $self->_table(shift);
453 my($where_sql, @bind) = $self->where($where);
454 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
456 return wantarray ? ($sql, @bind) : $sql;
460 #======================================================================
462 #======================================================================
466 # Finally, a separate routine just to handle WHERE clauses
468 my ($self, $where, $order) = @_;
471 my ($sql, @bind) = $self->_recurse_where($where);
472 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
476 $sql .= $self->_order_by($order);
479 return wantarray ? ($sql, @bind) : $sql;
484 my ($self, $where, $logic) = @_;
486 # dispatch on appropriate method according to refkind of $where
487 my $method = $self->_METHOD_FOR_refkind("_where", $where);
489 my ($sql, @bind) = $self->$method($where, $logic);
491 # DBIx::Class directly calls _recurse_where in scalar context, so
492 # we must implement it, even if not in the official API
493 return wantarray ? ($sql, @bind) : $sql;
498 #======================================================================
499 # WHERE: top-level ARRAYREF
500 #======================================================================
503 sub _where_ARRAYREF {
504 my ($self, $where, $logic) = @_;
506 $logic = uc($logic || $self->{logic});
507 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
509 my @clauses = @$where;
511 my (@sql_clauses, @all_bind);
512 # need to use while() so can shift() for pairs
513 while (my $el = shift @clauses) {
515 # switch according to kind of $el and get corresponding ($sql, @bind)
516 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
518 # skip empty elements, otherwise get invalid trailing AND stuff
519 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
523 $self->_assert_bindval_matches_bindtype(@b);
527 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
529 SCALARREF => sub { ($$el); },
531 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
532 $self->_recurse_where({$el => shift(@clauses)})},
534 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
538 push @sql_clauses, $sql;
539 push @all_bind, @bind;
543 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
546 #======================================================================
547 # WHERE: top-level ARRAYREFREF
548 #======================================================================
550 sub _where_ARRAYREFREF {
551 my ($self, $where) = @_;
552 my ($sql, @bind) = @$$where;
553 $self->_assert_bindval_matches_bindtype(@bind);
554 return ($sql, @bind);
557 #======================================================================
558 # WHERE: top-level HASHREF
559 #======================================================================
562 my ($self, $where) = @_;
563 my (@sql_clauses, @all_bind);
565 for my $k (sort keys %$where) {
566 my $v = $where->{$k};
568 # ($k => $v) is either a special unary op or a regular hashpair
569 my ($sql, @bind) = do {
571 # put the operator in canonical form
573 $op = substr $op, 1; # remove initial dash
574 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
575 $op =~ s/\s+/ /g; # compress whitespace
577 # so that -not_foo works correctly
578 $op =~ s/^not_/NOT /i;
580 $self->_debug("Unary OP(-$op) within hashref, recursing...");
581 my ($s, @b) = $self->_where_unary_op ($op, $v);
583 # top level vs nested
584 # we assume that handled unary ops will take care of their ()s
586 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
588 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
593 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
594 $self->$method($k, $v);
598 push @sql_clauses, $sql;
599 push @all_bind, @bind;
602 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
605 sub _where_unary_op {
606 my ($self, $op, $rhs) = @_;
608 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
609 my $handler = $op_entry->{handler};
611 if (not ref $handler) {
612 if ($op =~ 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 => [ -$op => COND1, -$op => COND2 ... ]";
616 return $self->$handler ($op, $rhs);
618 elsif (ref $handler eq 'CODE') {
619 return $handler->($self, $op, $rhs);
622 puke "Illegal handler for operator $op - expecting a method name or a coderef";
626 $self->_debug("Generic unary OP: $op - recursing as function");
628 $self->_assert_pass_injection_guard($op);
630 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
632 puke "Illegal use of top-level '$op'"
633 unless $self->{_nested_func_lhs};
636 $self->_convert('?'),
637 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
641 $self->_recurse_where ($rhs)
645 $sql = sprintf ('%s %s',
646 $self->_sqlcase($op),
650 return ($sql, @bind);
653 sub _where_op_ANDOR {
654 my ($self, $op, $v) = @_;
656 $self->_SWITCH_refkind($v, {
658 return $self->_where_ARRAYREF($v, $op);
662 return ( $op =~ /^or/i )
663 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
664 : $self->_where_HASHREF($v);
668 puke "-$op => \\\$scalar makes little sense, use " .
670 ? '[ \$scalar, \%rest_of_conditions ] instead'
671 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
676 puke "-$op => \\[...] makes little sense, use " .
678 ? '[ \[...], \%rest_of_conditions ] instead'
679 : '-and => [ \[...], \%rest_of_conditions ] instead'
683 SCALAR => sub { # permissively interpreted as SQL
684 puke "-$op => \$value makes little sense, use -bool => \$value instead";
688 puke "-$op => undef not supported";
694 my ($self, $op, $v) = @_;
696 $self->_SWITCH_refkind($v, {
698 SCALAR => sub { # permissively interpreted as SQL
699 belch "literal SQL should be -nest => \\'scalar' "
700 . "instead of -nest => 'scalar' ";
705 puke "-$op => undef not supported";
709 $self->_recurse_where ($v);
717 my ($self, $op, $v) = @_;
719 my ($s, @b) = $self->_SWITCH_refkind($v, {
720 SCALAR => sub { # interpreted as SQL column
721 $self->_convert($self->_quote($v));
725 puke "-$op => undef not supported";
729 $self->_recurse_where ($v);
733 $s = "(NOT $s)" if $op =~ /^not/i;
738 sub _where_op_IDENT {
740 my ($op, $rhs) = splice @_, -2;
741 if (! defined $rhs or length ref $rhs) {
742 puke "-$op requires a single plain scalar argument (a quotable identifier)";
745 # in case we are called as a top level special op (no '=')
748 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
756 sub _where_op_VALUE {
758 my ($op, $rhs) = splice @_, -2;
760 # in case we are called as a top level special op (no '=')
764 if (! defined $rhs) {
766 ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
773 ($lhs || $self->{_nested_func_lhs}),
780 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
784 $self->_convert('?'),
790 sub _where_hashpair_ARRAYREF {
791 my ($self, $k, $v) = @_;
794 my @v = @$v; # need copy because of shift below
795 $self->_debug("ARRAY($k) means distribute over elements");
797 # put apart first element if it is an operator (-and, -or)
799 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
803 my @distributed = map { {$k => $_} } @v;
806 $self->_debug("OP($op) reinjected into the distributed array");
807 unshift @distributed, $op;
810 my $logic = $op ? substr($op, 1) : '';
812 return $self->_recurse_where(\@distributed, $logic);
815 $self->_debug("empty ARRAY($k) means 0=1");
816 return ($self->{sqlfalse});
820 sub _where_hashpair_HASHREF {
821 my ($self, $k, $v, $logic) = @_;
824 local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
826 my ($all_sql, @all_bind);
828 for my $orig_op (sort keys %$v) {
829 my $val = $v->{$orig_op};
831 # put the operator in canonical form
834 # FIXME - we need to phase out dash-less ops
835 $op =~ s/^-//; # remove possible initial dash
836 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
837 $op =~ s/\s+/ /g; # compress whitespace
839 $self->_assert_pass_injection_guard($op);
842 $op =~ s/^is_not/IS NOT/i;
844 # so that -not_foo works correctly
845 $op =~ s/^not_/NOT /i;
847 # another retarded special case: foo => { $op => { -value => undef } }
848 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
854 # CASE: col-value logic modifiers
855 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
856 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
858 # CASE: special operators like -in or -between
859 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
860 my $handler = $special_op->{handler};
862 puke "No handler supplied for special operator $orig_op";
864 elsif (not ref $handler) {
865 ($sql, @bind) = $self->$handler ($k, $op, $val);
867 elsif (ref $handler eq 'CODE') {
868 ($sql, @bind) = $handler->($self, $k, $op, $val);
871 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
875 $self->_SWITCH_refkind($val, {
877 ARRAYREF => sub { # CASE: col => {op => \@vals}
878 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
881 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
882 my ($sub_sql, @sub_bind) = @$$val;
883 $self->_assert_bindval_matches_bindtype(@sub_bind);
884 $sql = join ' ', $self->_convert($self->_quote($k)),
885 $self->_sqlcase($op),
890 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
892 $op =~ /^not$/i ? 'is not' # legacy
893 : $op =~ $self->{equality_op} ? 'is'
894 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
895 : $op =~ $self->{inequality_op} ? 'is not'
896 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
897 : puke "unexpected operator '$orig_op' with undef operand";
899 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
902 FALLBACK => sub { # CASE: col => {op/func => $stuff}
904 # retain for proper column type bind
905 $self->{_nested_func_lhs} ||= $k;
907 ($sql, @bind) = $self->_where_unary_op ($op, $val);
910 $self->_convert($self->_quote($k)),
911 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
917 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
918 push @all_bind, @bind;
920 return ($all_sql, @all_bind);
923 sub _where_field_IS {
924 my ($self, $k, $op, $v) = @_;
926 my ($s) = $self->_SWITCH_refkind($v, {
929 $self->_convert($self->_quote($k)),
930 map { $self->_sqlcase($_)} ($op, 'null')
933 puke "$op can only take undef as argument";
940 sub _where_field_op_ARRAYREF {
941 my ($self, $k, $op, $vals) = @_;
943 my @vals = @$vals; #always work on a copy
946 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
948 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
951 # see if the first element is an -and/-or op
953 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
958 # a long standing API wart - an attempt to change this behavior during
959 # the 1.50 series failed *spectacularly*. Warn instead and leave the
964 (!$logic or $logic eq 'OR')
966 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
969 belch "A multi-element arrayref as an argument to the inequality op '$o' "
970 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
971 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
975 # distribute $op over each remaining member of @vals, append logic if exists
976 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
980 # try to DWIM on equality operators
982 $op =~ $self->{equality_op} ? $self->{sqlfalse}
983 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
984 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
985 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
986 : puke "operator '$op' applied on an empty array (field '$k')";
991 sub _where_hashpair_SCALARREF {
992 my ($self, $k, $v) = @_;
993 $self->_debug("SCALAR($k) means literal SQL: $$v");
994 my $sql = $self->_quote($k) . " " . $$v;
998 # literal SQL with bind
999 sub _where_hashpair_ARRAYREFREF {
1000 my ($self, $k, $v) = @_;
1001 $self->_debug("REF($k) means literal SQL: @${$v}");
1002 my ($sql, @bind) = @$$v;
1003 $self->_assert_bindval_matches_bindtype(@bind);
1004 $sql = $self->_quote($k) . " " . $sql;
1005 return ($sql, @bind );
1008 # literal SQL without bind
1009 sub _where_hashpair_SCALAR {
1010 my ($self, $k, $v) = @_;
1011 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1012 my $sql = join ' ', $self->_convert($self->_quote($k)),
1013 $self->_sqlcase($self->{cmp}),
1014 $self->_convert('?');
1015 my @bind = $self->_bindtype($k, $v);
1016 return ( $sql, @bind);
1020 sub _where_hashpair_UNDEF {
1021 my ($self, $k, $v) = @_;
1022 $self->_debug("UNDEF($k) means IS NULL");
1023 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
1027 #======================================================================
1028 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1029 #======================================================================
1032 sub _where_SCALARREF {
1033 my ($self, $where) = @_;
1036 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1042 my ($self, $where) = @_;
1045 $self->_debug("NOREF(*top) means literal SQL: $where");
1056 #======================================================================
1057 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1058 #======================================================================
1061 sub _where_field_BETWEEN {
1062 my ($self, $k, $op, $vals) = @_;
1064 my ($label, $and, $placeholder);
1065 $label = $self->_convert($self->_quote($k));
1066 $and = ' ' . $self->_sqlcase('and') . ' ';
1067 $placeholder = $self->_convert('?');
1068 $op = $self->_sqlcase($op);
1070 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1072 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1073 ARRAYREFREF => sub {
1074 my ($s, @b) = @$$vals;
1075 $self->_assert_bindval_matches_bindtype(@b);
1082 puke $invalid_args if @$vals != 2;
1084 my (@all_sql, @all_bind);
1085 foreach my $val (@$vals) {
1086 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1088 return ($placeholder, $self->_bindtype($k, $val) );
1093 ARRAYREFREF => sub {
1094 my ($sql, @bind) = @$$val;
1095 $self->_assert_bindval_matches_bindtype(@bind);
1096 return ($sql, @bind);
1099 my ($func, $arg, @rest) = %$val;
1100 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1101 if (@rest or $func !~ /^ \- (.+)/x);
1102 local $self->{_nested_func_lhs} = $k;
1103 $self->_where_unary_op ($1 => $arg);
1109 push @all_sql, $sql;
1110 push @all_bind, @bind;
1114 (join $and, @all_sql),
1123 my $sql = "( $label $op $clause )";
1124 return ($sql, @bind)
1128 sub _where_field_IN {
1129 my ($self, $k, $op, $vals) = @_;
1131 # backwards compatibility : if scalar, force into an arrayref
1132 $vals = [$vals] if defined $vals && ! ref $vals;
1134 my ($label) = $self->_convert($self->_quote($k));
1135 my ($placeholder) = $self->_convert('?');
1136 $op = $self->_sqlcase($op);
1138 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1139 ARRAYREF => sub { # list of choices
1140 if (@$vals) { # nonempty list
1141 my (@all_sql, @all_bind);
1143 for my $val (@$vals) {
1144 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1146 return ($placeholder, $val);
1151 ARRAYREFREF => sub {
1152 my ($sql, @bind) = @$$val;
1153 $self->_assert_bindval_matches_bindtype(@bind);
1154 return ($sql, @bind);
1157 my ($func, $arg, @rest) = %$val;
1158 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1159 if (@rest or $func !~ /^ \- (.+)/x);
1160 local $self->{_nested_func_lhs} = $k;
1161 $self->_where_unary_op ($1 => $arg);
1165 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1166 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1167 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1168 . 'will emit the logically correct SQL instead of raising this exception)'
1172 push @all_sql, $sql;
1173 push @all_bind, @bind;
1177 sprintf ('%s %s ( %s )',
1180 join (', ', @all_sql)
1182 $self->_bindtype($k, @all_bind),
1185 else { # empty list : some databases won't understand "IN ()", so DWIM
1186 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1191 SCALARREF => sub { # literal SQL
1192 my $sql = $self->_open_outer_paren ($$vals);
1193 return ("$label $op ( $sql )");
1195 ARRAYREFREF => sub { # literal SQL with bind
1196 my ($sql, @bind) = @$$vals;
1197 $self->_assert_bindval_matches_bindtype(@bind);
1198 $sql = $self->_open_outer_paren ($sql);
1199 return ("$label $op ( $sql )", @bind);
1203 puke "Argument passed to the '$op' operator can not be undefined";
1207 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1211 return ($sql, @bind);
1214 # Some databases (SQLite) treat col IN (1, 2) different from
1215 # col IN ( (1, 2) ). Use this to strip all outer parens while
1216 # adding them back in the corresponding method
1217 sub _open_outer_paren {
1218 my ($self, $sql) = @_;
1219 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1224 #======================================================================
1226 #======================================================================
1229 my ($self, $arg) = @_;
1232 for my $c ($self->_order_by_chunks ($arg) ) {
1233 $self->_SWITCH_refkind ($c, {
1234 SCALAR => sub { push @sql, $c },
1235 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1241 $self->_sqlcase(' order by'),
1247 return wantarray ? ($sql, @bind) : $sql;
1250 sub _order_by_chunks {
1251 my ($self, $arg) = @_;
1253 return $self->_SWITCH_refkind($arg, {
1256 map { $self->_order_by_chunks ($_ ) } @$arg;
1259 ARRAYREFREF => sub {
1260 my ($s, @b) = @$$arg;
1261 $self->_assert_bindval_matches_bindtype(@b);
1265 SCALAR => sub {$self->_quote($arg)},
1267 UNDEF => sub {return () },
1269 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1272 # get first pair in hash
1273 my ($key, $val, @rest) = %$arg;
1275 return () unless $key;
1277 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1278 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1284 for my $c ($self->_order_by_chunks ($val)) {
1287 $self->_SWITCH_refkind ($c, {
1292 ($sql, @bind) = @$c;
1296 $sql = $sql . ' ' . $self->_sqlcase($direction);
1298 push @ret, [ $sql, @bind];
1307 #======================================================================
1308 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1309 #======================================================================
1314 $self->_SWITCH_refkind($from, {
1315 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1316 SCALAR => sub {$self->_quote($from)},
1317 SCALARREF => sub {$$from},
1322 #======================================================================
1324 #======================================================================
1326 # highly optimized, as it's called way too often
1328 # my ($self, $label) = @_;
1330 return '' unless defined $_[1];
1331 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1333 unless ($_[0]->{quote_char}) {
1334 $_[0]->_assert_pass_injection_guard($_[1]);
1338 my $qref = ref $_[0]->{quote_char};
1341 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1343 elsif ($qref eq 'ARRAY') {
1344 ($l, $r) = @{$_[0]->{quote_char}};
1347 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1349 my $esc = $_[0]->{escape_char} || $r;
1351 # parts containing * are naturally unquoted
1352 return join( $_[0]->{name_sep}||'', map
1353 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1354 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1359 # Conversion, if applicable
1361 #my ($self, $arg) = @_;
1362 if ($_[0]->{convert}) {
1363 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1370 #my ($self, $col, @vals) = @_;
1371 # called often - tighten code
1372 return $_[0]->{bindtype} eq 'columns'
1373 ? map {[$_[1], $_]} @_[2 .. $#_]
1378 # Dies if any element of @bind is not in [colname => value] format
1379 # if bindtype is 'columns'.
1380 sub _assert_bindval_matches_bindtype {
1381 # my ($self, @bind) = @_;
1383 if ($self->{bindtype} eq 'columns') {
1385 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1386 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1392 sub _join_sql_clauses {
1393 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1395 if (@$clauses_aref > 1) {
1396 my $join = " " . $self->_sqlcase($logic) . " ";
1397 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1398 return ($sql, @$bind_aref);
1400 elsif (@$clauses_aref) {
1401 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1404 return (); # if no SQL, ignore @$bind_aref
1409 # Fix SQL case, if so requested
1411 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1412 # don't touch the argument ... crooked logic, but let's not change it!
1413 return $_[0]->{case} ? $_[1] : uc($_[1]);
1417 #======================================================================
1418 # DISPATCHING FROM REFKIND
1419 #======================================================================
1422 my ($self, $data) = @_;
1424 return 'UNDEF' unless defined $data;
1426 # blessed objects are treated like scalars
1427 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1429 return 'SCALAR' unless $ref;
1432 while ($ref eq 'REF') {
1434 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1438 return ($ref||'SCALAR') . ('REF' x $n_steps);
1442 my ($self, $data) = @_;
1443 my @try = ($self->_refkind($data));
1444 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1445 push @try, 'FALLBACK';
1449 sub _METHOD_FOR_refkind {
1450 my ($self, $meth_prefix, $data) = @_;
1453 for (@{$self->_try_refkind($data)}) {
1454 $method = $self->can($meth_prefix."_".$_)
1458 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1462 sub _SWITCH_refkind {
1463 my ($self, $data, $dispatch_table) = @_;
1466 for (@{$self->_try_refkind($data)}) {
1467 $coderef = $dispatch_table->{$_}
1471 puke "no dispatch entry for ".$self->_refkind($data)
1480 #======================================================================
1481 # VALUES, GENERATE, AUTOLOAD
1482 #======================================================================
1484 # LDNOTE: original code from nwiger, didn't touch code in that section
1485 # I feel the AUTOLOAD stuff should not be the default, it should
1486 # only be activated on explicit demand by user.
1490 my $data = shift || return;
1491 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1492 unless ref $data eq 'HASH';
1495 foreach my $k ( sort keys %$data ) {
1496 my $v = $data->{$k};
1497 $self->_SWITCH_refkind($v, {
1499 if ($self->{array_datatypes}) { # array datatype
1500 push @all_bind, $self->_bindtype($k, $v);
1502 else { # literal SQL with bind
1503 my ($sql, @bind) = @$v;
1504 $self->_assert_bindval_matches_bindtype(@bind);
1505 push @all_bind, @bind;
1508 ARRAYREFREF => sub { # literal SQL with bind
1509 my ($sql, @bind) = @${$v};
1510 $self->_assert_bindval_matches_bindtype(@bind);
1511 push @all_bind, @bind;
1513 SCALARREF => sub { # literal SQL without bind
1515 SCALAR_or_UNDEF => sub {
1516 push @all_bind, $self->_bindtype($k, $v);
1527 my(@sql, @sqlq, @sqlv);
1531 if ($ref eq 'HASH') {
1532 for my $k (sort keys %$_) {
1535 my $label = $self->_quote($k);
1536 if ($r eq 'ARRAY') {
1537 # literal SQL with bind
1538 my ($sql, @bind) = @$v;
1539 $self->_assert_bindval_matches_bindtype(@bind);
1540 push @sqlq, "$label = $sql";
1542 } elsif ($r eq 'SCALAR') {
1543 # literal SQL without bind
1544 push @sqlq, "$label = $$v";
1546 push @sqlq, "$label = ?";
1547 push @sqlv, $self->_bindtype($k, $v);
1550 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1551 } elsif ($ref eq 'ARRAY') {
1552 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1555 if ($r eq 'ARRAY') { # literal SQL with bind
1556 my ($sql, @bind) = @$v;
1557 $self->_assert_bindval_matches_bindtype(@bind);
1560 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1561 # embedded literal SQL
1568 push @sql, '(' . join(', ', @sqlq) . ')';
1569 } elsif ($ref eq 'SCALAR') {
1573 # strings get case twiddled
1574 push @sql, $self->_sqlcase($_);
1578 my $sql = join ' ', @sql;
1580 # this is pretty tricky
1581 # if ask for an array, return ($stmt, @bind)
1582 # otherwise, s/?/shift @sqlv/ to put it inline
1584 return ($sql, @sqlv);
1586 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1587 ref $d ? $d->[1] : $d/e;
1596 # This allows us to check for a local, then _form, attr
1598 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1599 return $self->generate($name, @_);
1610 SQL::Abstract - Generate SQL from Perl data structures
1616 my $sql = SQL::Abstract->new;
1618 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1620 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1622 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1624 my($stmt, @bind) = $sql->delete($table, \%where);
1626 # Then, use these in your DBI statements
1627 my $sth = $dbh->prepare($stmt);
1628 $sth->execute(@bind);
1630 # Just generate the WHERE clause
1631 my($stmt, @bind) = $sql->where(\%where, \@order);
1633 # Return values in the same order, for hashed queries
1634 # See PERFORMANCE section for more details
1635 my @bind = $sql->values(\%fieldvals);
1639 This module was inspired by the excellent L<DBIx::Abstract>.
1640 However, in using that module I found that what I really wanted
1641 to do was generate SQL, but still retain complete control over my
1642 statement handles and use the DBI interface. So, I set out to
1643 create an abstract SQL generation module.
1645 While based on the concepts used by L<DBIx::Abstract>, there are
1646 several important differences, especially when it comes to WHERE
1647 clauses. I have modified the concepts used to make the SQL easier
1648 to generate from Perl data structures and, IMO, more intuitive.
1649 The underlying idea is for this module to do what you mean, based
1650 on the data structures you provide it. The big advantage is that
1651 you don't have to modify your code every time your data changes,
1652 as this module figures it out.
1654 To begin with, an SQL INSERT is as easy as just specifying a hash
1655 of C<key=value> pairs:
1658 name => 'Jimbo Bobson',
1659 phone => '123-456-7890',
1660 address => '42 Sister Lane',
1661 city => 'St. Louis',
1662 state => 'Louisiana',
1665 The SQL can then be generated with this:
1667 my($stmt, @bind) = $sql->insert('people', \%data);
1669 Which would give you something like this:
1671 $stmt = "INSERT INTO people
1672 (address, city, name, phone, state)
1673 VALUES (?, ?, ?, ?, ?)";
1674 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1675 '123-456-7890', 'Louisiana');
1677 These are then used directly in your DBI code:
1679 my $sth = $dbh->prepare($stmt);
1680 $sth->execute(@bind);
1682 =head2 Inserting and Updating Arrays
1684 If your database has array types (like for example Postgres),
1685 activate the special option C<< array_datatypes => 1 >>
1686 when creating the C<SQL::Abstract> object.
1687 Then you may use an arrayref to insert and update database array types:
1689 my $sql = SQL::Abstract->new(array_datatypes => 1);
1691 planets => [qw/Mercury Venus Earth Mars/]
1694 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1698 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1700 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1703 =head2 Inserting and Updating SQL
1705 In order to apply SQL functions to elements of your C<%data> you may
1706 specify a reference to an arrayref for the given hash value. For example,
1707 if you need to execute the Oracle C<to_date> function on a value, you can
1708 say something like this:
1712 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1715 The first value in the array is the actual SQL. Any other values are
1716 optional and would be included in the bind values array. This gives
1719 my($stmt, @bind) = $sql->insert('people', \%data);
1721 $stmt = "INSERT INTO people (name, date_entered)
1722 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1723 @bind = ('Bill', '03/02/2003');
1725 An UPDATE is just as easy, all you change is the name of the function:
1727 my($stmt, @bind) = $sql->update('people', \%data);
1729 Notice that your C<%data> isn't touched; the module will generate
1730 the appropriately quirky SQL for you automatically. Usually you'll
1731 want to specify a WHERE clause for your UPDATE, though, which is
1732 where handling C<%where> hashes comes in handy...
1734 =head2 Complex where statements
1736 This module can generate pretty complicated WHERE statements
1737 easily. For example, simple C<key=value> pairs are taken to mean
1738 equality, and if you want to see if a field is within a set
1739 of values, you can use an arrayref. Let's say we wanted to
1740 SELECT some data based on this criteria:
1743 requestor => 'inna',
1744 worker => ['nwiger', 'rcwe', 'sfz'],
1745 status => { '!=', 'completed' }
1748 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1750 The above would give you something like this:
1752 $stmt = "SELECT * FROM tickets WHERE
1753 ( requestor = ? ) AND ( status != ? )
1754 AND ( worker = ? OR worker = ? OR worker = ? )";
1755 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1757 Which you could then use in DBI code like so:
1759 my $sth = $dbh->prepare($stmt);
1760 $sth->execute(@bind);
1766 The methods are simple. There's one for each major SQL operation,
1767 and a constructor you use first. The arguments are specified in a
1768 similar order to each method (table, then fields, then a where
1769 clause) to try and simplify things.
1771 =head2 new(option => 'value')
1773 The C<new()> function takes a list of options and values, and returns
1774 a new B<SQL::Abstract> object which can then be used to generate SQL
1775 through the methods below. The options accepted are:
1781 If set to 'lower', then SQL will be generated in all lowercase. By
1782 default SQL is generated in "textbook" case meaning something like:
1784 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1786 Any setting other than 'lower' is ignored.
1790 This determines what the default comparison operator is. By default
1791 it is C<=>, meaning that a hash like this:
1793 %where = (name => 'nwiger', email => 'nate@wiger.org');
1795 Will generate SQL like this:
1797 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1799 However, you may want loose comparisons by default, so if you set
1800 C<cmp> to C<like> you would get SQL such as:
1802 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1804 You can also override the comparison on an individual basis - see
1805 the huge section on L</"WHERE CLAUSES"> at the bottom.
1807 =item sqltrue, sqlfalse
1809 Expressions for inserting boolean values within SQL statements.
1810 By default these are C<1=1> and C<1=0>. They are used
1811 by the special operators C<-in> and C<-not_in> for generating
1812 correct SQL even when the argument is an empty array (see below).
1816 This determines the default logical operator for multiple WHERE
1817 statements in arrays or hashes. If absent, the default logic is "or"
1818 for arrays, and "and" for hashes. This means that a WHERE
1822 event_date => {'>=', '2/13/99'},
1823 event_date => {'<=', '4/24/03'},
1826 will generate SQL like this:
1828 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1830 This is probably not what you want given this query, though (look
1831 at the dates). To change the "OR" to an "AND", simply specify:
1833 my $sql = SQL::Abstract->new(logic => 'and');
1835 Which will change the above C<WHERE> to:
1837 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1839 The logic can also be changed locally by inserting
1840 a modifier in front of an arrayref :
1842 @where = (-and => [event_date => {'>=', '2/13/99'},
1843 event_date => {'<=', '4/24/03'} ]);
1845 See the L</"WHERE CLAUSES"> section for explanations.
1849 This will automatically convert comparisons using the specified SQL
1850 function for both column and value. This is mostly used with an argument
1851 of C<upper> or C<lower>, so that the SQL will have the effect of
1852 case-insensitive "searches". For example, this:
1854 $sql = SQL::Abstract->new(convert => 'upper');
1855 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1857 Will turn out the following SQL:
1859 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1861 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1862 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1863 not validate this option; it will just pass through what you specify verbatim).
1867 This is a kludge because many databases suck. For example, you can't
1868 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1869 Instead, you have to use C<bind_param()>:
1871 $sth->bind_param(1, 'reg data');
1872 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1874 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1875 which loses track of which field each slot refers to. Fear not.
1877 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1878 Currently, you can specify either C<normal> (default) or C<columns>. If you
1879 specify C<columns>, you will get an array that looks like this:
1881 my $sql = SQL::Abstract->new(bindtype => 'columns');
1882 my($stmt, @bind) = $sql->insert(...);
1885 [ 'column1', 'value1' ],
1886 [ 'column2', 'value2' ],
1887 [ 'column3', 'value3' ],
1890 You can then iterate through this manually, using DBI's C<bind_param()>.
1892 $sth->prepare($stmt);
1895 my($col, $data) = @$_;
1896 if ($col eq 'details' || $col eq 'comments') {
1897 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1898 } elsif ($col eq 'image') {
1899 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1901 $sth->bind_param($i, $data);
1905 $sth->execute; # execute without @bind now
1907 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1908 Basically, the advantage is still that you don't have to care which fields
1909 are or are not included. You could wrap that above C<for> loop in a simple
1910 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1911 get a layer of abstraction over manual SQL specification.
1913 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1914 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1915 will expect the bind values in this format.
1919 This is the character that a table or column name will be quoted
1920 with. By default this is an empty string, but you could set it to
1921 the character C<`>, to generate SQL like this:
1923 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1925 Alternatively, you can supply an array ref of two items, the first being the left
1926 hand quote character, and the second the right hand quote character. For
1927 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1928 that generates SQL like this:
1930 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1932 Quoting is useful if you have tables or columns names that are reserved
1933 words in your database's SQL dialect.
1937 This is the character that will be used to escape L</quote_char>s appearing
1938 in an identifier before it has been quoted.
1940 The paramter default in case of a single L</quote_char> character is the quote
1943 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1944 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
1945 of the B<opening (left)> L</quote_char> within the identifier are currently left
1946 untouched. The default for opening-closing-style quotes may change in future
1947 versions, thus you are B<strongly encouraged> to specify the escape character
1952 This is the character that separates a table and column name. It is
1953 necessary to specify this when the C<quote_char> option is selected,
1954 so that tables and column names can be individually quoted like this:
1956 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1958 =item injection_guard
1960 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1961 column name specified in a query structure. This is a safety mechanism to avoid
1962 injection attacks when mishandling user input e.g.:
1964 my %condition_as_column_value_pairs = get_values_from_user();
1965 $sqla->select( ... , \%condition_as_column_value_pairs );
1967 If the expression matches an exception is thrown. Note that literal SQL
1968 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1970 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1972 =item array_datatypes
1974 When this option is true, arrayrefs in INSERT or UPDATE are
1975 interpreted as array datatypes and are passed directly
1977 When this option is false, arrayrefs are interpreted
1978 as literal SQL, just like refs to arrayrefs
1979 (but this behavior is for backwards compatibility; when writing
1980 new queries, use the "reference to arrayref" syntax
1986 Takes a reference to a list of "special operators"
1987 to extend the syntax understood by L<SQL::Abstract>.
1988 See section L</"SPECIAL OPERATORS"> for details.
1992 Takes a reference to a list of "unary operators"
1993 to extend the syntax understood by L<SQL::Abstract>.
1994 See section L</"UNARY OPERATORS"> for details.
2000 =head2 insert($table, \@values || \%fieldvals, \%options)
2002 This is the simplest function. You simply give it a table name
2003 and either an arrayref of values or hashref of field/value pairs.
2004 It returns an SQL INSERT statement and a list of bind values.
2005 See the sections on L</"Inserting and Updating Arrays"> and
2006 L</"Inserting and Updating SQL"> for information on how to insert
2007 with those data types.
2009 The optional C<\%options> hash reference may contain additional
2010 options to generate the insert SQL. Currently supported options
2017 Takes either a scalar of raw SQL fields, or an array reference of
2018 field names, and adds on an SQL C<RETURNING> statement at the end.
2019 This allows you to return data generated by the insert statement
2020 (such as row IDs) without performing another C<SELECT> statement.
2021 Note, however, this is not part of the SQL standard and may not
2022 be supported by all database engines.
2026 =head2 update($table, \%fieldvals, \%where)
2028 This takes a table, hashref of field/value pairs, and an optional
2029 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2031 See the sections on L</"Inserting and Updating Arrays"> and
2032 L</"Inserting and Updating SQL"> for information on how to insert
2033 with those data types.
2035 =head2 select($source, $fields, $where, $order)
2037 This returns a SQL SELECT statement and associated list of bind values, as
2038 specified by the arguments :
2044 Specification of the 'FROM' part of the statement.
2045 The argument can be either a plain scalar (interpreted as a table
2046 name, will be quoted), or an arrayref (interpreted as a list
2047 of table names, joined by commas, quoted), or a scalarref
2048 (literal table name, not quoted), or a ref to an arrayref
2049 (list of literal table names, joined by commas, not quoted).
2053 Specification of the list of fields to retrieve from
2055 The argument can be either an arrayref (interpreted as a list
2056 of field names, will be joined by commas and quoted), or a
2057 plain scalar (literal SQL, not quoted).
2058 Please observe that this API is not as flexible as that of
2059 the first argument C<$source>, for backwards compatibility reasons.
2063 Optional argument to specify the WHERE part of the query.
2064 The argument is most often a hashref, but can also be
2065 an arrayref or plain scalar --
2066 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2070 Optional argument to specify the ORDER BY part of the query.
2071 The argument can be a scalar, a hashref or an arrayref
2072 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2078 =head2 delete($table, \%where)
2080 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2081 It returns an SQL DELETE statement and list of bind values.
2083 =head2 where(\%where, \@order)
2085 This is used to generate just the WHERE clause. For example,
2086 if you have an arbitrary data structure and know what the
2087 rest of your SQL is going to look like, but want an easy way
2088 to produce a WHERE clause, use this. It returns an SQL WHERE
2089 clause and list of bind values.
2092 =head2 values(\%data)
2094 This just returns the values from the hash C<%data>, in the same
2095 order that would be returned from any of the other above queries.
2096 Using this allows you to markedly speed up your queries if you
2097 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2099 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2101 Warning: This is an experimental method and subject to change.
2103 This returns arbitrarily generated SQL. It's a really basic shortcut.
2104 It will return two different things, depending on return context:
2106 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2107 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2109 These would return the following:
2111 # First calling form
2112 $stmt = "CREATE TABLE test (?, ?)";
2113 @bind = (field1, field2);
2115 # Second calling form
2116 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2118 Depending on what you're trying to do, it's up to you to choose the correct
2119 format. In this example, the second form is what you would want.
2123 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2127 ALTER SESSION SET nls_date_format = 'MM/YY'
2129 You get the idea. Strings get their case twiddled, but everything
2130 else remains verbatim.
2132 =head1 EXPORTABLE FUNCTIONS
2134 =head2 is_plain_value
2136 Determines if the supplied argument is a plain value as understood by this
2141 =item * The value is C<undef>
2143 =item * The value is a non-reference
2145 =item * The value is an object with stringification overloading
2147 =item * The value is of the form C<< { -value => $anything } >>
2151 On failure returns C<undef>, on sucess returns a reference to a single
2152 element array containing the string-version of the supplied argument or
2153 C<[ undef ]> in case of an undefined initial argument.
2155 =head2 is_literal_value
2157 Determines if the supplied argument is a literal value as understood by this
2162 =item * C<\$sql_string>
2164 =item * C<\[ $sql_string, @bind_values ]>
2166 =item * C<< { -ident => $plain_defined_string } >>
2170 On failure returns C<undef>, on sucess returns a reference to an array
2171 cotaining the unpacked version of the supplied literal SQL and bind values.
2173 =head1 WHERE CLAUSES
2177 This module uses a variation on the idea from L<DBIx::Abstract>. It
2178 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2179 module is that things in arrays are OR'ed, and things in hashes
2182 The easiest way to explain is to show lots of examples. After
2183 each C<%where> hash shown, it is assumed you used:
2185 my($stmt, @bind) = $sql->where(\%where);
2187 However, note that the C<%where> hash can be used directly in any
2188 of the other functions as well, as described above.
2190 =head2 Key-value pairs
2192 So, let's get started. To begin, a simple hash:
2196 status => 'completed'
2199 Is converted to SQL C<key = val> statements:
2201 $stmt = "WHERE user = ? AND status = ?";
2202 @bind = ('nwiger', 'completed');
2204 One common thing I end up doing is having a list of values that
2205 a field can be in. To do this, simply specify a list inside of
2210 status => ['assigned', 'in-progress', 'pending'];
2213 This simple code will create the following:
2215 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2216 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2218 A field associated to an empty arrayref will be considered a
2219 logical false and will generate 0=1.
2221 =head2 Tests for NULL values
2223 If the value part is C<undef> then this is converted to SQL <IS NULL>
2232 $stmt = "WHERE user = ? AND status IS NULL";
2235 To test if a column IS NOT NULL:
2239 status => { '!=', undef },
2242 =head2 Specific comparison operators
2244 If you want to specify a different type of operator for your comparison,
2245 you can use a hashref for a given column:
2249 status => { '!=', 'completed' }
2252 Which would generate:
2254 $stmt = "WHERE user = ? AND status != ?";
2255 @bind = ('nwiger', 'completed');
2257 To test against multiple values, just enclose the values in an arrayref:
2259 status => { '=', ['assigned', 'in-progress', 'pending'] };
2261 Which would give you:
2263 "WHERE status = ? OR status = ? OR status = ?"
2266 The hashref can also contain multiple pairs, in which case it is expanded
2267 into an C<AND> of its elements:
2271 status => { '!=', 'completed', -not_like => 'pending%' }
2274 # Or more dynamically, like from a form
2275 $where{user} = 'nwiger';
2276 $where{status}{'!='} = 'completed';
2277 $where{status}{'-not_like'} = 'pending%';
2279 # Both generate this
2280 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2281 @bind = ('nwiger', 'completed', 'pending%');
2284 To get an OR instead, you can combine it with the arrayref idea:
2288 priority => [ { '=', 2 }, { '>', 5 } ]
2291 Which would generate:
2293 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2294 @bind = ('2', '5', 'nwiger');
2296 If you want to include literal SQL (with or without bind values), just use a
2297 scalar reference or array reference as the value:
2300 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2301 date_expires => { '<' => \"now()" }
2304 Which would generate:
2306 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2307 @bind = ('11/26/2008');
2310 =head2 Logic and nesting operators
2312 In the example above,
2313 there is a subtle trap if you want to say something like
2314 this (notice the C<AND>):
2316 WHERE priority != ? AND priority != ?
2318 Because, in Perl you I<can't> do this:
2320 priority => { '!=', 2, '!=', 1 }
2322 As the second C<!=> key will obliterate the first. The solution
2323 is to use the special C<-modifier> form inside an arrayref:
2325 priority => [ -and => {'!=', 2},
2329 Normally, these would be joined by C<OR>, but the modifier tells it
2330 to use C<AND> instead. (Hint: You can use this in conjunction with the
2331 C<logic> option to C<new()> in order to change the way your queries
2332 work by default.) B<Important:> Note that the C<-modifier> goes
2333 B<INSIDE> the arrayref, as an extra first element. This will
2334 B<NOT> do what you think it might:
2336 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2338 Here is a quick list of equivalencies, since there is some overlap:
2341 status => {'!=', 'completed', 'not like', 'pending%' }
2342 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2345 status => {'=', ['assigned', 'in-progress']}
2346 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2347 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2351 =head2 Special operators : IN, BETWEEN, etc.
2353 You can also use the hashref format to compare a list of fields using the
2354 C<IN> comparison operator, by specifying the list as an arrayref:
2357 status => 'completed',
2358 reportid => { -in => [567, 2335, 2] }
2361 Which would generate:
2363 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2364 @bind = ('completed', '567', '2335', '2');
2366 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2369 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2370 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2371 'sqltrue' (by default : C<1=1>).
2373 In addition to the array you can supply a chunk of literal sql or
2374 literal sql with bind:
2377 customer => { -in => \[
2378 'SELECT cust_id FROM cust WHERE balance > ?',
2381 status => { -in => \'SELECT status_codes FROM states' },
2387 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2388 AND status IN ( SELECT status_codes FROM states )
2392 Finally, if the argument to C<-in> is not a reference, it will be
2393 treated as a single-element array.
2395 Another pair of operators is C<-between> and C<-not_between>,
2396 used with an arrayref of two values:
2400 completion_date => {
2401 -not_between => ['2002-10-01', '2003-02-06']
2407 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2409 Just like with C<-in> all plausible combinations of literal SQL
2413 start0 => { -between => [ 1, 2 ] },
2414 start1 => { -between => \["? AND ?", 1, 2] },
2415 start2 => { -between => \"lower(x) AND upper(y)" },
2416 start3 => { -between => [
2418 \["upper(?)", 'stuff' ],
2425 ( start0 BETWEEN ? AND ? )
2426 AND ( start1 BETWEEN ? AND ? )
2427 AND ( start2 BETWEEN lower(x) AND upper(y) )
2428 AND ( start3 BETWEEN lower(x) AND upper(?) )
2430 @bind = (1, 2, 1, 2, 'stuff');
2433 These are the two builtin "special operators"; but the
2434 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2436 =head2 Unary operators: bool
2438 If you wish to test against boolean columns or functions within your
2439 database you can use the C<-bool> and C<-not_bool> operators. For
2440 example to test the column C<is_user> being true and the column
2441 C<is_enabled> being false you would use:-
2445 -not_bool => 'is_enabled',
2450 WHERE is_user AND NOT is_enabled
2452 If a more complex combination is required, testing more conditions,
2453 then you should use the and/or operators:-
2458 -not_bool => { two=> { -rlike => 'bar' } },
2459 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2470 (NOT ( three = ? OR three > ? ))
2473 =head2 Nested conditions, -and/-or prefixes
2475 So far, we've seen how multiple conditions are joined with a top-level
2476 C<AND>. We can change this by putting the different conditions we want in
2477 hashes and then putting those hashes in an array. For example:
2482 status => { -like => ['pending%', 'dispatched'] },
2486 status => 'unassigned',
2490 This data structure would create the following:
2492 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2493 OR ( user = ? AND status = ? ) )";
2494 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2497 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2498 to change the logic inside :
2504 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2505 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2512 WHERE ( user = ? AND (
2513 ( workhrs > ? AND geo = ? )
2514 OR ( workhrs < ? OR geo = ? )
2517 =head3 Algebraic inconsistency, for historical reasons
2519 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2520 operator goes C<outside> of the nested structure; whereas when connecting
2521 several constraints on one column, the C<-and> operator goes
2522 C<inside> the arrayref. Here is an example combining both features :
2525 -and => [a => 1, b => 2],
2526 -or => [c => 3, d => 4],
2527 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2532 WHERE ( ( ( a = ? AND b = ? )
2533 OR ( c = ? OR d = ? )
2534 OR ( e LIKE ? AND e LIKE ? ) ) )
2536 This difference in syntax is unfortunate but must be preserved for
2537 historical reasons. So be careful : the two examples below would
2538 seem algebraically equivalent, but they are not
2540 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2541 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2543 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2544 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2547 =head2 Literal SQL and value type operators
2549 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2550 side" is a column name and the "right side" is a value (normally rendered as
2551 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2552 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2553 alter this behavior. There are several ways of doing so.
2557 This is a virtual operator that signals the string to its right side is an
2558 identifier (a column name) and not a value. For example to compare two
2559 columns you would write:
2562 priority => { '<', 2 },
2563 requestor => { -ident => 'submitter' },
2568 $stmt = "WHERE priority < ? AND requestor = submitter";
2571 If you are maintaining legacy code you may see a different construct as
2572 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2577 This is a virtual operator that signals that the construct to its right side
2578 is a value to be passed to DBI. This is for example necessary when you want
2579 to write a where clause against an array (for RDBMS that support such
2580 datatypes). For example:
2583 array => { -value => [1, 2, 3] }
2588 $stmt = 'WHERE array = ?';
2589 @bind = ([1, 2, 3]);
2591 Note that if you were to simply say:
2597 the result would probably not be what you wanted:
2599 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2604 Finally, sometimes only literal SQL will do. To include a random snippet
2605 of SQL verbatim, you specify it as a scalar reference. Consider this only
2606 as a last resort. Usually there is a better way. For example:
2609 priority => { '<', 2 },
2610 requestor => { -in => \'(SELECT name FROM hitmen)' },
2615 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2618 Note that in this example, you only get one bind parameter back, since
2619 the verbatim SQL is passed as part of the statement.
2623 Never use untrusted input as a literal SQL argument - this is a massive
2624 security risk (there is no way to check literal snippets for SQL
2625 injections and other nastyness). If you need to deal with untrusted input
2626 use literal SQL with placeholders as described next.
2628 =head3 Literal SQL with placeholders and bind values (subqueries)
2630 If the literal SQL to be inserted has placeholders and bind values,
2631 use a reference to an arrayref (yes this is a double reference --
2632 not so common, but perfectly legal Perl). For example, to find a date
2633 in Postgres you can use something like this:
2636 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2641 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2644 Note that you must pass the bind values in the same format as they are returned
2645 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2646 provide the bind values in the C<< [ column_meta => value ] >> format, where
2647 C<column_meta> is an opaque scalar value; most commonly the column name, but
2648 you can use any scalar value (including references and blessed references),
2649 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2650 to C<columns> the above example will look like:
2653 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2656 Literal SQL is especially useful for nesting parenthesized clauses in the
2657 main SQL query. Here is a first example :
2659 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2663 bar => \["IN ($sub_stmt)" => @sub_bind],
2668 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2669 WHERE c2 < ? AND c3 LIKE ?))";
2670 @bind = (1234, 100, "foo%");
2672 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2673 are expressed in the same way. Of course the C<$sub_stmt> and
2674 its associated bind values can be generated through a former call
2677 my ($sub_stmt, @sub_bind)
2678 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2679 c3 => {-like => "foo%"}});
2682 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2685 In the examples above, the subquery was used as an operator on a column;
2686 but the same principle also applies for a clause within the main C<%where>
2687 hash, like an EXISTS subquery :
2689 my ($sub_stmt, @sub_bind)
2690 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2691 my %where = ( -and => [
2693 \["EXISTS ($sub_stmt)" => @sub_bind],
2698 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2699 WHERE c1 = ? AND c2 > t0.c0))";
2703 Observe that the condition on C<c2> in the subquery refers to
2704 column C<t0.c0> of the main query : this is I<not> a bind
2705 value, so we have to express it through a scalar ref.
2706 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2707 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2708 what we wanted here.
2710 Finally, here is an example where a subquery is used
2711 for expressing unary negation:
2713 my ($sub_stmt, @sub_bind)
2714 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2715 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2717 lname => {like => '%son%'},
2718 \["NOT ($sub_stmt)" => @sub_bind],
2723 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2724 @bind = ('%son%', 10, 20)
2726 =head3 Deprecated usage of Literal SQL
2728 Below are some examples of archaic use of literal SQL. It is shown only as
2729 reference for those who deal with legacy code. Each example has a much
2730 better, cleaner and safer alternative that users should opt for in new code.
2736 my %where = ( requestor => \'IS NOT NULL' )
2738 $stmt = "WHERE requestor IS NOT NULL"
2740 This used to be the way of generating NULL comparisons, before the handling
2741 of C<undef> got formalized. For new code please use the superior syntax as
2742 described in L</Tests for NULL values>.
2746 my %where = ( requestor => \'= submitter' )
2748 $stmt = "WHERE requestor = submitter"
2750 This used to be the only way to compare columns. Use the superior L</-ident>
2751 method for all new code. For example an identifier declared in such a way
2752 will be properly quoted if L</quote_char> is properly set, while the legacy
2753 form will remain as supplied.
2757 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2759 $stmt = "WHERE completed > ? AND is_ready"
2760 @bind = ('2012-12-21')
2762 Using an empty string literal used to be the only way to express a boolean.
2763 For all new code please use the much more readable
2764 L<-bool|/Unary operators: bool> operator.
2770 These pages could go on for a while, since the nesting of the data
2771 structures this module can handle are pretty much unlimited (the
2772 module implements the C<WHERE> expansion as a recursive function
2773 internally). Your best bet is to "play around" with the module a
2774 little to see how the data structures behave, and choose the best
2775 format for your data based on that.
2777 And of course, all the values above will probably be replaced with
2778 variables gotten from forms or the command line. After all, if you
2779 knew everything ahead of time, you wouldn't have to worry about
2780 dynamically-generating SQL and could just hardwire it into your
2783 =head1 ORDER BY CLAUSES
2785 Some functions take an order by clause. This can either be a scalar (just a
2786 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2787 or an array of either of the two previous forms. Examples:
2789 Given | Will Generate
2790 ----------------------------------------------------------
2792 \'colA DESC' | ORDER BY colA DESC
2794 'colA' | ORDER BY colA
2796 [qw/colA colB/] | ORDER BY colA, colB
2798 {-asc => 'colA'} | ORDER BY colA ASC
2800 {-desc => 'colB'} | ORDER BY colB DESC
2802 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2804 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2807 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2808 { -desc => [qw/colB/], | colC ASC, colD ASC
2809 { -asc => [qw/colC colD/],|
2811 ===========================================================
2815 =head1 SPECIAL OPERATORS
2817 my $sqlmaker = SQL::Abstract->new(special_ops => [
2821 my ($self, $field, $op, $arg) = @_;
2827 handler => 'method_name',
2831 A "special operator" is a SQL syntactic clause that can be
2832 applied to a field, instead of a usual binary operator.
2835 WHERE field IN (?, ?, ?)
2836 WHERE field BETWEEN ? AND ?
2837 WHERE MATCH(field) AGAINST (?, ?)
2839 Special operators IN and BETWEEN are fairly standard and therefore
2840 are builtin within C<SQL::Abstract> (as the overridable methods
2841 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2842 like the MATCH .. AGAINST example above which is specific to MySQL,
2843 you can write your own operator handlers - supply a C<special_ops>
2844 argument to the C<new> method. That argument takes an arrayref of
2845 operator definitions; each operator definition is a hashref with two
2852 the regular expression to match the operator
2856 Either a coderef or a plain scalar method name. In both cases
2857 the expected return is C<< ($sql, @bind) >>.
2859 When supplied with a method name, it is simply called on the
2860 L<SQL::Abstract/> object as:
2862 $self->$method_name ($field, $op, $arg)
2866 $op is the part that matched the handler regex
2867 $field is the LHS of the operator
2870 When supplied with a coderef, it is called as:
2872 $coderef->($self, $field, $op, $arg)
2877 For example, here is an implementation
2878 of the MATCH .. AGAINST syntax for MySQL
2880 my $sqlmaker = SQL::Abstract->new(special_ops => [
2882 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2883 {regex => qr/^match$/i,
2885 my ($self, $field, $op, $arg) = @_;
2886 $arg = [$arg] if not ref $arg;
2887 my $label = $self->_quote($field);
2888 my ($placeholder) = $self->_convert('?');
2889 my $placeholders = join ", ", (($placeholder) x @$arg);
2890 my $sql = $self->_sqlcase('match') . " ($label) "
2891 . $self->_sqlcase('against') . " ($placeholders) ";
2892 my @bind = $self->_bindtype($field, @$arg);
2893 return ($sql, @bind);
2900 =head1 UNARY OPERATORS
2902 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2906 my ($self, $op, $arg) = @_;
2912 handler => 'method_name',
2916 A "unary operator" is a SQL syntactic clause that can be
2917 applied to a field - the operator goes before the field
2919 You can write your own operator handlers - supply a C<unary_ops>
2920 argument to the C<new> method. That argument takes an arrayref of
2921 operator definitions; each operator definition is a hashref with two
2928 the regular expression to match the operator
2932 Either a coderef or a plain scalar method name. In both cases
2933 the expected return is C<< $sql >>.
2935 When supplied with a method name, it is simply called on the
2936 L<SQL::Abstract/> object as:
2938 $self->$method_name ($op, $arg)
2942 $op is the part that matched the handler regex
2943 $arg is the RHS or argument of the operator
2945 When supplied with a coderef, it is called as:
2947 $coderef->($self, $op, $arg)
2955 Thanks to some benchmarking by Mark Stosberg, it turns out that
2956 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2957 I must admit this wasn't an intentional design issue, but it's a
2958 byproduct of the fact that you get to control your C<DBI> handles
2961 To maximize performance, use a code snippet like the following:
2963 # prepare a statement handle using the first row
2964 # and then reuse it for the rest of the rows
2966 for my $href (@array_of_hashrefs) {
2967 $stmt ||= $sql->insert('table', $href);
2968 $sth ||= $dbh->prepare($stmt);
2969 $sth->execute($sql->values($href));
2972 The reason this works is because the keys in your C<$href> are sorted
2973 internally by B<SQL::Abstract>. Thus, as long as your data retains
2974 the same structure, you only have to generate the SQL the first time
2975 around. On subsequent queries, simply use the C<values> function provided
2976 by this module to return your values in the correct order.
2978 However this depends on the values having the same type - if, for
2979 example, the values of a where clause may either have values
2980 (resulting in sql of the form C<column = ?> with a single bind
2981 value), or alternatively the values might be C<undef> (resulting in
2982 sql of the form C<column IS NULL> with no bind value) then the
2983 caching technique suggested will not work.
2987 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2988 really like this part (I do, at least). Building up a complex query
2989 can be as simple as the following:
2996 use CGI::FormBuilder;
2999 my $form = CGI::FormBuilder->new(...);
3000 my $sql = SQL::Abstract->new;
3002 if ($form->submitted) {
3003 my $field = $form->field;
3004 my $id = delete $field->{id};
3005 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3008 Of course, you would still have to connect using C<DBI> to run the
3009 query, but the point is that if you make your form look like your
3010 table, the actual query script can be extremely simplistic.
3012 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3013 a fast interface to returning and formatting data. I frequently
3014 use these three modules together to write complex database query
3015 apps in under 50 lines.
3021 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3023 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3029 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3030 Great care has been taken to preserve the I<published> behavior
3031 documented in previous versions in the 1.* family; however,
3032 some features that were previously undocumented, or behaved
3033 differently from the documentation, had to be changed in order
3034 to clarify the semantics. Hence, client code that was relying
3035 on some dark areas of C<SQL::Abstract> v1.*
3036 B<might behave differently> in v1.50.
3038 The main changes are :
3044 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
3048 support for the { operator => \"..." } construct (to embed literal SQL)
3052 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3056 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3060 defensive programming : check arguments
3064 fixed bug with global logic, which was previously implemented
3065 through global variables yielding side-effects. Prior versions would
3066 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3067 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3068 Now this is interpreted
3069 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3074 fixed semantics of _bindtype on array args
3078 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3079 we just avoid shifting arrays within that tree.
3083 dropped the C<_modlogic> function
3087 =head1 ACKNOWLEDGEMENTS
3089 There are a number of individuals that have really helped out with
3090 this module. Unfortunately, most of them submitted bugs via CPAN
3091 so I have no idea who they are! But the people I do know are:
3093 Ash Berlin (order_by hash term support)
3094 Matt Trout (DBIx::Class support)
3095 Mark Stosberg (benchmarking)
3096 Chas Owens (initial "IN" operator support)
3097 Philip Collins (per-field SQL functions)
3098 Eric Kolve (hashref "AND" support)
3099 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3100 Dan Kubb (support for "quote_char" and "name_sep")
3101 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3102 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3103 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3104 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3105 Oliver Charles (support for "RETURNING" after "INSERT")
3111 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3115 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3117 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3119 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3120 While not an official support venue, C<DBIx::Class> makes heavy use of
3121 C<SQL::Abstract>, and as such list members there are very familiar with
3122 how to create queries.
3126 This module is free software; you may copy this under the same
3127 terms as perl itself (either the GNU General Public License or
3128 the Artistic License)