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 # reuse @_ for even moar speedz
95 defined ( $_[1] = Scalar::Util::blessed $_[0] )
97 # deliberately not using Devel::OverloadInfo - the checks we are
98 # intersted in are much more limited than the fullblown thing, and
99 # this is a very hot piece of code
101 # FIXME - DBI needs fixing to stringify regardless of DBD
103 # simply using ->can('(""') can leave behind stub methods that
104 # break actually using the overload later (see L<perldiag/Stub
105 # found while resolving method "%s" overloading "%s" in package
106 # "%s"> and the source of overload::mycan())
108 # either has stringification which DBI SHOULD prefer out of the box
109 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
111 # has nummification and fallback is *not* disabled
113 grep { *{"${_}::(0+"}{CODE} } @{ mro::get_linear_isa( $_[1] ) }
116 # no fallback specified at all
117 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
119 # fallback explicitly undef
120 ! defined ${"$_[3]::()"}
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 B<scalar> reference
2152 to the original supplied argument.
2154 =head2 is_literal_value
2156 Determines if the supplied argument is a literal value as understood by this
2161 =item * C<\$sql_string>
2163 =item * C<\[ $sql_string, @bind_values ]>
2165 =item * C<< { -ident => $plain_defined_string } >>
2169 On failure returns C<undef>, on sucess returns an B<array> reference
2170 containing the unpacked version of the supplied literal SQL and bind values.
2172 =head1 WHERE CLAUSES
2176 This module uses a variation on the idea from L<DBIx::Abstract>. It
2177 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2178 module is that things in arrays are OR'ed, and things in hashes
2181 The easiest way to explain is to show lots of examples. After
2182 each C<%where> hash shown, it is assumed you used:
2184 my($stmt, @bind) = $sql->where(\%where);
2186 However, note that the C<%where> hash can be used directly in any
2187 of the other functions as well, as described above.
2189 =head2 Key-value pairs
2191 So, let's get started. To begin, a simple hash:
2195 status => 'completed'
2198 Is converted to SQL C<key = val> statements:
2200 $stmt = "WHERE user = ? AND status = ?";
2201 @bind = ('nwiger', 'completed');
2203 One common thing I end up doing is having a list of values that
2204 a field can be in. To do this, simply specify a list inside of
2209 status => ['assigned', 'in-progress', 'pending'];
2212 This simple code will create the following:
2214 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2215 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2217 A field associated to an empty arrayref will be considered a
2218 logical false and will generate 0=1.
2220 =head2 Tests for NULL values
2222 If the value part is C<undef> then this is converted to SQL <IS NULL>
2231 $stmt = "WHERE user = ? AND status IS NULL";
2234 To test if a column IS NOT NULL:
2238 status => { '!=', undef },
2241 =head2 Specific comparison operators
2243 If you want to specify a different type of operator for your comparison,
2244 you can use a hashref for a given column:
2248 status => { '!=', 'completed' }
2251 Which would generate:
2253 $stmt = "WHERE user = ? AND status != ?";
2254 @bind = ('nwiger', 'completed');
2256 To test against multiple values, just enclose the values in an arrayref:
2258 status => { '=', ['assigned', 'in-progress', 'pending'] };
2260 Which would give you:
2262 "WHERE status = ? OR status = ? OR status = ?"
2265 The hashref can also contain multiple pairs, in which case it is expanded
2266 into an C<AND> of its elements:
2270 status => { '!=', 'completed', -not_like => 'pending%' }
2273 # Or more dynamically, like from a form
2274 $where{user} = 'nwiger';
2275 $where{status}{'!='} = 'completed';
2276 $where{status}{'-not_like'} = 'pending%';
2278 # Both generate this
2279 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2280 @bind = ('nwiger', 'completed', 'pending%');
2283 To get an OR instead, you can combine it with the arrayref idea:
2287 priority => [ { '=', 2 }, { '>', 5 } ]
2290 Which would generate:
2292 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2293 @bind = ('2', '5', 'nwiger');
2295 If you want to include literal SQL (with or without bind values), just use a
2296 scalar reference or array reference as the value:
2299 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2300 date_expires => { '<' => \"now()" }
2303 Which would generate:
2305 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2306 @bind = ('11/26/2008');
2309 =head2 Logic and nesting operators
2311 In the example above,
2312 there is a subtle trap if you want to say something like
2313 this (notice the C<AND>):
2315 WHERE priority != ? AND priority != ?
2317 Because, in Perl you I<can't> do this:
2319 priority => { '!=', 2, '!=', 1 }
2321 As the second C<!=> key will obliterate the first. The solution
2322 is to use the special C<-modifier> form inside an arrayref:
2324 priority => [ -and => {'!=', 2},
2328 Normally, these would be joined by C<OR>, but the modifier tells it
2329 to use C<AND> instead. (Hint: You can use this in conjunction with the
2330 C<logic> option to C<new()> in order to change the way your queries
2331 work by default.) B<Important:> Note that the C<-modifier> goes
2332 B<INSIDE> the arrayref, as an extra first element. This will
2333 B<NOT> do what you think it might:
2335 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2337 Here is a quick list of equivalencies, since there is some overlap:
2340 status => {'!=', 'completed', 'not like', 'pending%' }
2341 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2344 status => {'=', ['assigned', 'in-progress']}
2345 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2346 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2350 =head2 Special operators : IN, BETWEEN, etc.
2352 You can also use the hashref format to compare a list of fields using the
2353 C<IN> comparison operator, by specifying the list as an arrayref:
2356 status => 'completed',
2357 reportid => { -in => [567, 2335, 2] }
2360 Which would generate:
2362 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2363 @bind = ('completed', '567', '2335', '2');
2365 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2368 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2369 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2370 'sqltrue' (by default : C<1=1>).
2372 In addition to the array you can supply a chunk of literal sql or
2373 literal sql with bind:
2376 customer => { -in => \[
2377 'SELECT cust_id FROM cust WHERE balance > ?',
2380 status => { -in => \'SELECT status_codes FROM states' },
2386 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2387 AND status IN ( SELECT status_codes FROM states )
2391 Finally, if the argument to C<-in> is not a reference, it will be
2392 treated as a single-element array.
2394 Another pair of operators is C<-between> and C<-not_between>,
2395 used with an arrayref of two values:
2399 completion_date => {
2400 -not_between => ['2002-10-01', '2003-02-06']
2406 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2408 Just like with C<-in> all plausible combinations of literal SQL
2412 start0 => { -between => [ 1, 2 ] },
2413 start1 => { -between => \["? AND ?", 1, 2] },
2414 start2 => { -between => \"lower(x) AND upper(y)" },
2415 start3 => { -between => [
2417 \["upper(?)", 'stuff' ],
2424 ( start0 BETWEEN ? AND ? )
2425 AND ( start1 BETWEEN ? AND ? )
2426 AND ( start2 BETWEEN lower(x) AND upper(y) )
2427 AND ( start3 BETWEEN lower(x) AND upper(?) )
2429 @bind = (1, 2, 1, 2, 'stuff');
2432 These are the two builtin "special operators"; but the
2433 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2435 =head2 Unary operators: bool
2437 If you wish to test against boolean columns or functions within your
2438 database you can use the C<-bool> and C<-not_bool> operators. For
2439 example to test the column C<is_user> being true and the column
2440 C<is_enabled> being false you would use:-
2444 -not_bool => 'is_enabled',
2449 WHERE is_user AND NOT is_enabled
2451 If a more complex combination is required, testing more conditions,
2452 then you should use the and/or operators:-
2457 -not_bool => { two=> { -rlike => 'bar' } },
2458 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2469 (NOT ( three = ? OR three > ? ))
2472 =head2 Nested conditions, -and/-or prefixes
2474 So far, we've seen how multiple conditions are joined with a top-level
2475 C<AND>. We can change this by putting the different conditions we want in
2476 hashes and then putting those hashes in an array. For example:
2481 status => { -like => ['pending%', 'dispatched'] },
2485 status => 'unassigned',
2489 This data structure would create the following:
2491 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2492 OR ( user = ? AND status = ? ) )";
2493 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2496 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2497 to change the logic inside :
2503 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2504 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2511 WHERE ( user = ? AND (
2512 ( workhrs > ? AND geo = ? )
2513 OR ( workhrs < ? OR geo = ? )
2516 =head3 Algebraic inconsistency, for historical reasons
2518 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2519 operator goes C<outside> of the nested structure; whereas when connecting
2520 several constraints on one column, the C<-and> operator goes
2521 C<inside> the arrayref. Here is an example combining both features :
2524 -and => [a => 1, b => 2],
2525 -or => [c => 3, d => 4],
2526 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2531 WHERE ( ( ( a = ? AND b = ? )
2532 OR ( c = ? OR d = ? )
2533 OR ( e LIKE ? AND e LIKE ? ) ) )
2535 This difference in syntax is unfortunate but must be preserved for
2536 historical reasons. So be careful : the two examples below would
2537 seem algebraically equivalent, but they are not
2539 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2540 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2542 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2543 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2546 =head2 Literal SQL and value type operators
2548 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2549 side" is a column name and the "right side" is a value (normally rendered as
2550 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2551 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2552 alter this behavior. There are several ways of doing so.
2556 This is a virtual operator that signals the string to its right side is an
2557 identifier (a column name) and not a value. For example to compare two
2558 columns you would write:
2561 priority => { '<', 2 },
2562 requestor => { -ident => 'submitter' },
2567 $stmt = "WHERE priority < ? AND requestor = submitter";
2570 If you are maintaining legacy code you may see a different construct as
2571 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2576 This is a virtual operator that signals that the construct to its right side
2577 is a value to be passed to DBI. This is for example necessary when you want
2578 to write a where clause against an array (for RDBMS that support such
2579 datatypes). For example:
2582 array => { -value => [1, 2, 3] }
2587 $stmt = 'WHERE array = ?';
2588 @bind = ([1, 2, 3]);
2590 Note that if you were to simply say:
2596 the result would probably not be what you wanted:
2598 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2603 Finally, sometimes only literal SQL will do. To include a random snippet
2604 of SQL verbatim, you specify it as a scalar reference. Consider this only
2605 as a last resort. Usually there is a better way. For example:
2608 priority => { '<', 2 },
2609 requestor => { -in => \'(SELECT name FROM hitmen)' },
2614 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2617 Note that in this example, you only get one bind parameter back, since
2618 the verbatim SQL is passed as part of the statement.
2622 Never use untrusted input as a literal SQL argument - this is a massive
2623 security risk (there is no way to check literal snippets for SQL
2624 injections and other nastyness). If you need to deal with untrusted input
2625 use literal SQL with placeholders as described next.
2627 =head3 Literal SQL with placeholders and bind values (subqueries)
2629 If the literal SQL to be inserted has placeholders and bind values,
2630 use a reference to an arrayref (yes this is a double reference --
2631 not so common, but perfectly legal Perl). For example, to find a date
2632 in Postgres you can use something like this:
2635 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2640 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2643 Note that you must pass the bind values in the same format as they are returned
2644 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2645 provide the bind values in the C<< [ column_meta => value ] >> format, where
2646 C<column_meta> is an opaque scalar value; most commonly the column name, but
2647 you can use any scalar value (including references and blessed references),
2648 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2649 to C<columns> the above example will look like:
2652 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2655 Literal SQL is especially useful for nesting parenthesized clauses in the
2656 main SQL query. Here is a first example :
2658 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2662 bar => \["IN ($sub_stmt)" => @sub_bind],
2667 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2668 WHERE c2 < ? AND c3 LIKE ?))";
2669 @bind = (1234, 100, "foo%");
2671 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2672 are expressed in the same way. Of course the C<$sub_stmt> and
2673 its associated bind values can be generated through a former call
2676 my ($sub_stmt, @sub_bind)
2677 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2678 c3 => {-like => "foo%"}});
2681 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2684 In the examples above, the subquery was used as an operator on a column;
2685 but the same principle also applies for a clause within the main C<%where>
2686 hash, like an EXISTS subquery :
2688 my ($sub_stmt, @sub_bind)
2689 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2690 my %where = ( -and => [
2692 \["EXISTS ($sub_stmt)" => @sub_bind],
2697 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2698 WHERE c1 = ? AND c2 > t0.c0))";
2702 Observe that the condition on C<c2> in the subquery refers to
2703 column C<t0.c0> of the main query : this is I<not> a bind
2704 value, so we have to express it through a scalar ref.
2705 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2706 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2707 what we wanted here.
2709 Finally, here is an example where a subquery is used
2710 for expressing unary negation:
2712 my ($sub_stmt, @sub_bind)
2713 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2714 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2716 lname => {like => '%son%'},
2717 \["NOT ($sub_stmt)" => @sub_bind],
2722 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2723 @bind = ('%son%', 10, 20)
2725 =head3 Deprecated usage of Literal SQL
2727 Below are some examples of archaic use of literal SQL. It is shown only as
2728 reference for those who deal with legacy code. Each example has a much
2729 better, cleaner and safer alternative that users should opt for in new code.
2735 my %where = ( requestor => \'IS NOT NULL' )
2737 $stmt = "WHERE requestor IS NOT NULL"
2739 This used to be the way of generating NULL comparisons, before the handling
2740 of C<undef> got formalized. For new code please use the superior syntax as
2741 described in L</Tests for NULL values>.
2745 my %where = ( requestor => \'= submitter' )
2747 $stmt = "WHERE requestor = submitter"
2749 This used to be the only way to compare columns. Use the superior L</-ident>
2750 method for all new code. For example an identifier declared in such a way
2751 will be properly quoted if L</quote_char> is properly set, while the legacy
2752 form will remain as supplied.
2756 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2758 $stmt = "WHERE completed > ? AND is_ready"
2759 @bind = ('2012-12-21')
2761 Using an empty string literal used to be the only way to express a boolean.
2762 For all new code please use the much more readable
2763 L<-bool|/Unary operators: bool> operator.
2769 These pages could go on for a while, since the nesting of the data
2770 structures this module can handle are pretty much unlimited (the
2771 module implements the C<WHERE> expansion as a recursive function
2772 internally). Your best bet is to "play around" with the module a
2773 little to see how the data structures behave, and choose the best
2774 format for your data based on that.
2776 And of course, all the values above will probably be replaced with
2777 variables gotten from forms or the command line. After all, if you
2778 knew everything ahead of time, you wouldn't have to worry about
2779 dynamically-generating SQL and could just hardwire it into your
2782 =head1 ORDER BY CLAUSES
2784 Some functions take an order by clause. This can either be a scalar (just a
2785 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2786 or an array of either of the two previous forms. Examples:
2788 Given | Will Generate
2789 ----------------------------------------------------------
2791 \'colA DESC' | ORDER BY colA DESC
2793 'colA' | ORDER BY colA
2795 [qw/colA colB/] | ORDER BY colA, colB
2797 {-asc => 'colA'} | ORDER BY colA ASC
2799 {-desc => 'colB'} | ORDER BY colB DESC
2801 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2803 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2806 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2807 { -desc => [qw/colB/], | colC ASC, colD ASC
2808 { -asc => [qw/colC colD/],|
2810 ===========================================================
2814 =head1 SPECIAL OPERATORS
2816 my $sqlmaker = SQL::Abstract->new(special_ops => [
2820 my ($self, $field, $op, $arg) = @_;
2826 handler => 'method_name',
2830 A "special operator" is a SQL syntactic clause that can be
2831 applied to a field, instead of a usual binary operator.
2834 WHERE field IN (?, ?, ?)
2835 WHERE field BETWEEN ? AND ?
2836 WHERE MATCH(field) AGAINST (?, ?)
2838 Special operators IN and BETWEEN are fairly standard and therefore
2839 are builtin within C<SQL::Abstract> (as the overridable methods
2840 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2841 like the MATCH .. AGAINST example above which is specific to MySQL,
2842 you can write your own operator handlers - supply a C<special_ops>
2843 argument to the C<new> method. That argument takes an arrayref of
2844 operator definitions; each operator definition is a hashref with two
2851 the regular expression to match the operator
2855 Either a coderef or a plain scalar method name. In both cases
2856 the expected return is C<< ($sql, @bind) >>.
2858 When supplied with a method name, it is simply called on the
2859 L<SQL::Abstract/> object as:
2861 $self->$method_name ($field, $op, $arg)
2865 $op is the part that matched the handler regex
2866 $field is the LHS of the operator
2869 When supplied with a coderef, it is called as:
2871 $coderef->($self, $field, $op, $arg)
2876 For example, here is an implementation
2877 of the MATCH .. AGAINST syntax for MySQL
2879 my $sqlmaker = SQL::Abstract->new(special_ops => [
2881 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2882 {regex => qr/^match$/i,
2884 my ($self, $field, $op, $arg) = @_;
2885 $arg = [$arg] if not ref $arg;
2886 my $label = $self->_quote($field);
2887 my ($placeholder) = $self->_convert('?');
2888 my $placeholders = join ", ", (($placeholder) x @$arg);
2889 my $sql = $self->_sqlcase('match') . " ($label) "
2890 . $self->_sqlcase('against') . " ($placeholders) ";
2891 my @bind = $self->_bindtype($field, @$arg);
2892 return ($sql, @bind);
2899 =head1 UNARY OPERATORS
2901 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2905 my ($self, $op, $arg) = @_;
2911 handler => 'method_name',
2915 A "unary operator" is a SQL syntactic clause that can be
2916 applied to a field - the operator goes before the field
2918 You can write your own operator handlers - supply a C<unary_ops>
2919 argument to the C<new> method. That argument takes an arrayref of
2920 operator definitions; each operator definition is a hashref with two
2927 the regular expression to match the operator
2931 Either a coderef or a plain scalar method name. In both cases
2932 the expected return is C<< $sql >>.
2934 When supplied with a method name, it is simply called on the
2935 L<SQL::Abstract/> object as:
2937 $self->$method_name ($op, $arg)
2941 $op is the part that matched the handler regex
2942 $arg is the RHS or argument of the operator
2944 When supplied with a coderef, it is called as:
2946 $coderef->($self, $op, $arg)
2954 Thanks to some benchmarking by Mark Stosberg, it turns out that
2955 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2956 I must admit this wasn't an intentional design issue, but it's a
2957 byproduct of the fact that you get to control your C<DBI> handles
2960 To maximize performance, use a code snippet like the following:
2962 # prepare a statement handle using the first row
2963 # and then reuse it for the rest of the rows
2965 for my $href (@array_of_hashrefs) {
2966 $stmt ||= $sql->insert('table', $href);
2967 $sth ||= $dbh->prepare($stmt);
2968 $sth->execute($sql->values($href));
2971 The reason this works is because the keys in your C<$href> are sorted
2972 internally by B<SQL::Abstract>. Thus, as long as your data retains
2973 the same structure, you only have to generate the SQL the first time
2974 around. On subsequent queries, simply use the C<values> function provided
2975 by this module to return your values in the correct order.
2977 However this depends on the values having the same type - if, for
2978 example, the values of a where clause may either have values
2979 (resulting in sql of the form C<column = ?> with a single bind
2980 value), or alternatively the values might be C<undef> (resulting in
2981 sql of the form C<column IS NULL> with no bind value) then the
2982 caching technique suggested will not work.
2986 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2987 really like this part (I do, at least). Building up a complex query
2988 can be as simple as the following:
2995 use CGI::FormBuilder;
2998 my $form = CGI::FormBuilder->new(...);
2999 my $sql = SQL::Abstract->new;
3001 if ($form->submitted) {
3002 my $field = $form->field;
3003 my $id = delete $field->{id};
3004 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3007 Of course, you would still have to connect using C<DBI> to run the
3008 query, but the point is that if you make your form look like your
3009 table, the actual query script can be extremely simplistic.
3011 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3012 a fast interface to returning and formatting data. I frequently
3013 use these three modules together to write complex database query
3014 apps in under 50 lines.
3020 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3022 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3028 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3029 Great care has been taken to preserve the I<published> behavior
3030 documented in previous versions in the 1.* family; however,
3031 some features that were previously undocumented, or behaved
3032 differently from the documentation, had to be changed in order
3033 to clarify the semantics. Hence, client code that was relying
3034 on some dark areas of C<SQL::Abstract> v1.*
3035 B<might behave differently> in v1.50.
3037 The main changes are :
3043 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
3047 support for the { operator => \"..." } construct (to embed literal SQL)
3051 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3055 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3059 defensive programming : check arguments
3063 fixed bug with global logic, which was previously implemented
3064 through global variables yielding side-effects. Prior versions would
3065 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3066 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3067 Now this is interpreted
3068 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3073 fixed semantics of _bindtype on array args
3077 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3078 we just avoid shifting arrays within that tree.
3082 dropped the C<_modlogic> function
3086 =head1 ACKNOWLEDGEMENTS
3088 There are a number of individuals that have really helped out with
3089 this module. Unfortunately, most of them submitted bugs via CPAN
3090 so I have no idea who they are! But the people I do know are:
3092 Ash Berlin (order_by hash term support)
3093 Matt Trout (DBIx::Class support)
3094 Mark Stosberg (benchmarking)
3095 Chas Owens (initial "IN" operator support)
3096 Philip Collins (per-field SQL functions)
3097 Eric Kolve (hashref "AND" support)
3098 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3099 Dan Kubb (support for "quote_char" and "name_sep")
3100 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3101 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3102 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3103 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3104 Oliver Charles (support for "RETURNING" after "INSERT")
3110 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3114 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3116 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3118 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3119 While not an official support venue, C<DBIx::Class> makes heavy use of
3120 C<SQL::Abstract>, and as such list members there are very familiar with
3121 how to create queries.
3125 This module is free software; you may copy this under the same
3126 terms as perl itself (either the GNU General Public License or
3127 the Artistic License)