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 # simply using ->can('(""') can leave behind stub methods that
102 # break actually using the overload later (see L<perldiag/Stub
103 # found while resolving method "%s" overloading "%s" in package
104 # "%s"> and the source of overload::mycan())
106 # either has stringification which DBI SHOULD prefer out of the box
107 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
109 # has nummification or boolification, AND fallback is *not* disabled
112 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
114 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
118 # no fallback specified at all
119 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
121 # fallback explicitly undef
122 ! defined ${"$_[3]::()"}
135 #======================================================================
137 #======================================================================
141 my $class = ref($self) || $self;
142 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
144 # choose our case by keeping an option around
145 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
147 # default logic for interpreting arrayrefs
148 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
150 # how to return bind vars
151 $opt{bindtype} ||= 'normal';
153 # default comparison is "=", but can be overridden
156 # try to recognize which are the 'equality' and 'inequality' ops
157 # (temporary quickfix (in 2007), should go through a more seasoned API)
158 $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
159 $opt{inequality_op} = qr/^( != | <> )$/ix;
161 $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
162 $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
165 $opt{sqltrue} ||= '1=1';
166 $opt{sqlfalse} ||= '0=1';
169 $opt{special_ops} ||= [];
170 # regexes are applied in order, thus push after user-defines
171 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
174 $opt{unary_ops} ||= [];
175 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
177 # rudimentary sanity-check for user supplied bits treated as functions/operators
178 # If a purported function matches this regular expression, an exception is thrown.
179 # Literal SQL is *NOT* subject to this check, only functions (and column names
180 # when quoting is not in effect)
183 # need to guard against ()'s in column names too, but this will break tons of
184 # hacks... ideas anyone?
185 $opt{injection_guard} ||= qr/
191 return bless \%opt, $class;
195 sub _assert_pass_injection_guard {
196 if ($_[1] =~ $_[0]->{injection_guard}) {
197 my $class = ref $_[0];
198 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
199 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
200 . "{injection_guard} attribute to ${class}->new()"
205 #======================================================================
207 #======================================================================
211 my $table = $self->_table(shift);
212 my $data = shift || return;
215 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
216 my ($sql, @bind) = $self->$method($data);
217 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
219 if ($options->{returning}) {
220 my ($s, @b) = $self->_insert_returning ($options);
225 return wantarray ? ($sql, @bind) : $sql;
228 sub _insert_returning {
229 my ($self, $options) = @_;
231 my $f = $options->{returning};
233 my $fieldlist = $self->_SWITCH_refkind($f, {
234 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
235 SCALAR => sub {$self->_quote($f)},
236 SCALARREF => sub {$$f},
238 return $self->_sqlcase(' returning ') . $fieldlist;
241 sub _insert_HASHREF { # explicit list of fields and then values
242 my ($self, $data) = @_;
244 my @fields = sort keys %$data;
246 my ($sql, @bind) = $self->_insert_values($data);
249 $_ = $self->_quote($_) foreach @fields;
250 $sql = "( ".join(", ", @fields).") ".$sql;
252 return ($sql, @bind);
255 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
256 my ($self, $data) = @_;
258 # no names (arrayref) so can't generate bindtype
259 $self->{bindtype} ne 'columns'
260 or belch "can't do 'columns' bindtype when called with arrayref";
262 # fold the list of values into a hash of column name - value pairs
263 # (where the column names are artificially generated, and their
264 # lexicographical ordering keep the ordering of the original list)
265 my $i = "a"; # incremented values will be in lexicographical order
266 my $data_in_hash = { map { ($i++ => $_) } @$data };
268 return $self->_insert_values($data_in_hash);
271 sub _insert_ARRAYREFREF { # literal SQL with bind
272 my ($self, $data) = @_;
274 my ($sql, @bind) = @${$data};
275 $self->_assert_bindval_matches_bindtype(@bind);
277 return ($sql, @bind);
281 sub _insert_SCALARREF { # literal SQL without bind
282 my ($self, $data) = @_;
288 my ($self, $data) = @_;
290 my (@values, @all_bind);
291 foreach my $column (sort keys %$data) {
292 my $v = $data->{$column};
294 $self->_SWITCH_refkind($v, {
297 if ($self->{array_datatypes}) { # if array datatype are activated
299 push @all_bind, $self->_bindtype($column, $v);
301 else { # else literal SQL with bind
302 my ($sql, @bind) = @$v;
303 $self->_assert_bindval_matches_bindtype(@bind);
305 push @all_bind, @bind;
309 ARRAYREFREF => sub { # literal SQL with bind
310 my ($sql, @bind) = @${$v};
311 $self->_assert_bindval_matches_bindtype(@bind);
313 push @all_bind, @bind;
316 # THINK : anything useful to do with a HASHREF ?
317 HASHREF => sub { # (nothing, but old SQLA passed it through)
318 #TODO in SQLA >= 2.0 it will die instead
319 belch "HASH ref as bind value in insert is not supported";
321 push @all_bind, $self->_bindtype($column, $v);
324 SCALARREF => sub { # literal SQL without bind
328 SCALAR_or_UNDEF => sub {
330 push @all_bind, $self->_bindtype($column, $v);
337 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
338 return ($sql, @all_bind);
343 #======================================================================
345 #======================================================================
350 my $table = $self->_table(shift);
351 my $data = shift || return;
354 # first build the 'SET' part of the sql statement
355 my (@set, @all_bind);
356 puke "Unsupported data type specified to \$sql->update"
357 unless ref $data eq 'HASH';
359 for my $k (sort keys %$data) {
362 my $label = $self->_quote($k);
364 $self->_SWITCH_refkind($v, {
366 if ($self->{array_datatypes}) { # array datatype
367 push @set, "$label = ?";
368 push @all_bind, $self->_bindtype($k, $v);
370 else { # literal SQL with bind
371 my ($sql, @bind) = @$v;
372 $self->_assert_bindval_matches_bindtype(@bind);
373 push @set, "$label = $sql";
374 push @all_bind, @bind;
377 ARRAYREFREF => sub { # literal SQL with bind
378 my ($sql, @bind) = @${$v};
379 $self->_assert_bindval_matches_bindtype(@bind);
380 push @set, "$label = $sql";
381 push @all_bind, @bind;
383 SCALARREF => sub { # literal SQL without bind
384 push @set, "$label = $$v";
387 my ($op, $arg, @rest) = %$v;
389 puke 'Operator calls in update must be in the form { -op => $arg }'
390 if (@rest or not $op =~ /^\-(.+)/);
392 local $self->{_nested_func_lhs} = $k;
393 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
395 push @set, "$label = $sql";
396 push @all_bind, @bind;
398 SCALAR_or_UNDEF => sub {
399 push @set, "$label = ?";
400 push @all_bind, $self->_bindtype($k, $v);
406 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
410 my($where_sql, @where_bind) = $self->where($where);
412 push @all_bind, @where_bind;
415 return wantarray ? ($sql, @all_bind) : $sql;
421 #======================================================================
423 #======================================================================
428 my $table = $self->_table(shift);
429 my $fields = shift || '*';
433 my($where_sql, @bind) = $self->where($where, $order);
435 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
437 my $sql = join(' ', $self->_sqlcase('select'), $f,
438 $self->_sqlcase('from'), $table)
441 return wantarray ? ($sql, @bind) : $sql;
444 #======================================================================
446 #======================================================================
451 my $table = $self->_table(shift);
455 my($where_sql, @bind) = $self->where($where);
456 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
458 return wantarray ? ($sql, @bind) : $sql;
462 #======================================================================
464 #======================================================================
468 # Finally, a separate routine just to handle WHERE clauses
470 my ($self, $where, $order) = @_;
473 my ($sql, @bind) = $self->_recurse_where($where);
474 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
478 $sql .= $self->_order_by($order);
481 return wantarray ? ($sql, @bind) : $sql;
486 my ($self, $where, $logic) = @_;
488 # dispatch on appropriate method according to refkind of $where
489 my $method = $self->_METHOD_FOR_refkind("_where", $where);
491 my ($sql, @bind) = $self->$method($where, $logic);
493 # DBIx::Class directly calls _recurse_where in scalar context, so
494 # we must implement it, even if not in the official API
495 return wantarray ? ($sql, @bind) : $sql;
500 #======================================================================
501 # WHERE: top-level ARRAYREF
502 #======================================================================
505 sub _where_ARRAYREF {
506 my ($self, $where, $logic) = @_;
508 $logic = uc($logic || $self->{logic});
509 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
511 my @clauses = @$where;
513 my (@sql_clauses, @all_bind);
514 # need to use while() so can shift() for pairs
515 while (my $el = shift @clauses) {
517 # switch according to kind of $el and get corresponding ($sql, @bind)
518 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
520 # skip empty elements, otherwise get invalid trailing AND stuff
521 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
525 $self->_assert_bindval_matches_bindtype(@b);
529 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
531 SCALARREF => sub { ($$el); },
533 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
534 $self->_recurse_where({$el => shift(@clauses)})},
536 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
540 push @sql_clauses, $sql;
541 push @all_bind, @bind;
545 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
548 #======================================================================
549 # WHERE: top-level ARRAYREFREF
550 #======================================================================
552 sub _where_ARRAYREFREF {
553 my ($self, $where) = @_;
554 my ($sql, @bind) = @$$where;
555 $self->_assert_bindval_matches_bindtype(@bind);
556 return ($sql, @bind);
559 #======================================================================
560 # WHERE: top-level HASHREF
561 #======================================================================
564 my ($self, $where) = @_;
565 my (@sql_clauses, @all_bind);
567 for my $k (sort keys %$where) {
568 my $v = $where->{$k};
570 # ($k => $v) is either a special unary op or a regular hashpair
571 my ($sql, @bind) = do {
573 # put the operator in canonical form
575 $op = substr $op, 1; # remove initial dash
576 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
577 $op =~ s/\s+/ /g; # compress whitespace
579 # so that -not_foo works correctly
580 $op =~ s/^not_/NOT /i;
582 $self->_debug("Unary OP(-$op) within hashref, recursing...");
583 my ($s, @b) = $self->_where_unary_op ($op, $v);
585 # top level vs nested
586 # we assume that handled unary ops will take care of their ()s
588 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
590 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
595 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
596 $self->$method($k, $v);
600 push @sql_clauses, $sql;
601 push @all_bind, @bind;
604 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
607 sub _where_unary_op {
608 my ($self, $op, $rhs) = @_;
610 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
611 my $handler = $op_entry->{handler};
613 if (not ref $handler) {
614 if ($op =~ s/ [_\s]? \d+ $//x ) {
615 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
616 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
618 return $self->$handler ($op, $rhs);
620 elsif (ref $handler eq 'CODE') {
621 return $handler->($self, $op, $rhs);
624 puke "Illegal handler for operator $op - expecting a method name or a coderef";
628 $self->_debug("Generic unary OP: $op - recursing as function");
630 $self->_assert_pass_injection_guard($op);
632 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
634 puke "Illegal use of top-level '$op'"
635 unless $self->{_nested_func_lhs};
638 $self->_convert('?'),
639 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
643 $self->_recurse_where ($rhs)
647 $sql = sprintf ('%s %s',
648 $self->_sqlcase($op),
652 return ($sql, @bind);
655 sub _where_op_ANDOR {
656 my ($self, $op, $v) = @_;
658 $self->_SWITCH_refkind($v, {
660 return $self->_where_ARRAYREF($v, $op);
664 return ( $op =~ /^or/i )
665 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
666 : $self->_where_HASHREF($v);
670 puke "-$op => \\\$scalar makes little sense, use " .
672 ? '[ \$scalar, \%rest_of_conditions ] instead'
673 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
678 puke "-$op => \\[...] makes little sense, use " .
680 ? '[ \[...], \%rest_of_conditions ] instead'
681 : '-and => [ \[...], \%rest_of_conditions ] instead'
685 SCALAR => sub { # permissively interpreted as SQL
686 puke "-$op => \$value makes little sense, use -bool => \$value instead";
690 puke "-$op => undef not supported";
696 my ($self, $op, $v) = @_;
698 $self->_SWITCH_refkind($v, {
700 SCALAR => sub { # permissively interpreted as SQL
701 belch "literal SQL should be -nest => \\'scalar' "
702 . "instead of -nest => 'scalar' ";
707 puke "-$op => undef not supported";
711 $self->_recurse_where ($v);
719 my ($self, $op, $v) = @_;
721 my ($s, @b) = $self->_SWITCH_refkind($v, {
722 SCALAR => sub { # interpreted as SQL column
723 $self->_convert($self->_quote($v));
727 puke "-$op => undef not supported";
731 $self->_recurse_where ($v);
735 $s = "(NOT $s)" if $op =~ /^not/i;
740 sub _where_op_IDENT {
742 my ($op, $rhs) = splice @_, -2;
743 if (! defined $rhs or length ref $rhs) {
744 puke "-$op requires a single plain scalar argument (a quotable identifier)";
747 # in case we are called as a top level special op (no '=')
750 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
758 sub _where_op_VALUE {
760 my ($op, $rhs) = splice @_, -2;
762 # in case we are called as a top level special op (no '=')
766 if (! defined $rhs) {
768 ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
775 ($lhs || $self->{_nested_func_lhs}),
782 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
786 $self->_convert('?'),
792 sub _where_hashpair_ARRAYREF {
793 my ($self, $k, $v) = @_;
796 my @v = @$v; # need copy because of shift below
797 $self->_debug("ARRAY($k) means distribute over elements");
799 # put apart first element if it is an operator (-and, -or)
801 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
805 my @distributed = map { {$k => $_} } @v;
808 $self->_debug("OP($op) reinjected into the distributed array");
809 unshift @distributed, $op;
812 my $logic = $op ? substr($op, 1) : '';
814 return $self->_recurse_where(\@distributed, $logic);
817 $self->_debug("empty ARRAY($k) means 0=1");
818 return ($self->{sqlfalse});
822 sub _where_hashpair_HASHREF {
823 my ($self, $k, $v, $logic) = @_;
826 local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
828 my ($all_sql, @all_bind);
830 for my $orig_op (sort keys %$v) {
831 my $val = $v->{$orig_op};
833 # put the operator in canonical form
836 # FIXME - we need to phase out dash-less ops
837 $op =~ s/^-//; # remove possible initial dash
838 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
839 $op =~ s/\s+/ /g; # compress whitespace
841 $self->_assert_pass_injection_guard($op);
844 $op =~ s/^is_not/IS NOT/i;
846 # so that -not_foo works correctly
847 $op =~ s/^not_/NOT /i;
849 # another retarded special case: foo => { $op => { -value => undef } }
850 if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
856 # CASE: col-value logic modifiers
857 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
858 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
860 # CASE: special operators like -in or -between
861 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
862 my $handler = $special_op->{handler};
864 puke "No handler supplied for special operator $orig_op";
866 elsif (not ref $handler) {
867 ($sql, @bind) = $self->$handler ($k, $op, $val);
869 elsif (ref $handler eq 'CODE') {
870 ($sql, @bind) = $handler->($self, $k, $op, $val);
873 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
877 $self->_SWITCH_refkind($val, {
879 ARRAYREF => sub { # CASE: col => {op => \@vals}
880 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
883 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
884 my ($sub_sql, @sub_bind) = @$$val;
885 $self->_assert_bindval_matches_bindtype(@sub_bind);
886 $sql = join ' ', $self->_convert($self->_quote($k)),
887 $self->_sqlcase($op),
892 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
894 $op =~ /^not$/i ? 'is not' # legacy
895 : $op =~ $self->{equality_op} ? 'is'
896 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
897 : $op =~ $self->{inequality_op} ? 'is not'
898 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
899 : puke "unexpected operator '$orig_op' with undef operand";
901 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
904 FALLBACK => sub { # CASE: col => {op/func => $stuff}
906 # retain for proper column type bind
907 $self->{_nested_func_lhs} ||= $k;
909 ($sql, @bind) = $self->_where_unary_op ($op, $val);
912 $self->_convert($self->_quote($k)),
913 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
919 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
920 push @all_bind, @bind;
922 return ($all_sql, @all_bind);
925 sub _where_field_IS {
926 my ($self, $k, $op, $v) = @_;
928 my ($s) = $self->_SWITCH_refkind($v, {
931 $self->_convert($self->_quote($k)),
932 map { $self->_sqlcase($_)} ($op, 'null')
935 puke "$op can only take undef as argument";
942 sub _where_field_op_ARRAYREF {
943 my ($self, $k, $op, $vals) = @_;
945 my @vals = @$vals; #always work on a copy
948 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
950 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
953 # see if the first element is an -and/-or op
955 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
960 # a long standing API wart - an attempt to change this behavior during
961 # the 1.50 series failed *spectacularly*. Warn instead and leave the
966 (!$logic or $logic eq 'OR')
968 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
971 belch "A multi-element arrayref as an argument to the inequality op '$o' "
972 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
973 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
977 # distribute $op over each remaining member of @vals, append logic if exists
978 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
982 # try to DWIM on equality operators
984 $op =~ $self->{equality_op} ? $self->{sqlfalse}
985 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
986 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
987 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
988 : puke "operator '$op' applied on an empty array (field '$k')";
993 sub _where_hashpair_SCALARREF {
994 my ($self, $k, $v) = @_;
995 $self->_debug("SCALAR($k) means literal SQL: $$v");
996 my $sql = $self->_quote($k) . " " . $$v;
1000 # literal SQL with bind
1001 sub _where_hashpair_ARRAYREFREF {
1002 my ($self, $k, $v) = @_;
1003 $self->_debug("REF($k) means literal SQL: @${$v}");
1004 my ($sql, @bind) = @$$v;
1005 $self->_assert_bindval_matches_bindtype(@bind);
1006 $sql = $self->_quote($k) . " " . $sql;
1007 return ($sql, @bind );
1010 # literal SQL without bind
1011 sub _where_hashpair_SCALAR {
1012 my ($self, $k, $v) = @_;
1013 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1014 my $sql = join ' ', $self->_convert($self->_quote($k)),
1015 $self->_sqlcase($self->{cmp}),
1016 $self->_convert('?');
1017 my @bind = $self->_bindtype($k, $v);
1018 return ( $sql, @bind);
1022 sub _where_hashpair_UNDEF {
1023 my ($self, $k, $v) = @_;
1024 $self->_debug("UNDEF($k) means IS NULL");
1025 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
1029 #======================================================================
1030 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1031 #======================================================================
1034 sub _where_SCALARREF {
1035 my ($self, $where) = @_;
1038 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1044 my ($self, $where) = @_;
1047 $self->_debug("NOREF(*top) means literal SQL: $where");
1058 #======================================================================
1059 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1060 #======================================================================
1063 sub _where_field_BETWEEN {
1064 my ($self, $k, $op, $vals) = @_;
1066 my ($label, $and, $placeholder);
1067 $label = $self->_convert($self->_quote($k));
1068 $and = ' ' . $self->_sqlcase('and') . ' ';
1069 $placeholder = $self->_convert('?');
1070 $op = $self->_sqlcase($op);
1072 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1074 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1075 ARRAYREFREF => sub {
1076 my ($s, @b) = @$$vals;
1077 $self->_assert_bindval_matches_bindtype(@b);
1084 puke $invalid_args if @$vals != 2;
1086 my (@all_sql, @all_bind);
1087 foreach my $val (@$vals) {
1088 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1090 return ($placeholder, $self->_bindtype($k, $val) );
1095 ARRAYREFREF => sub {
1096 my ($sql, @bind) = @$$val;
1097 $self->_assert_bindval_matches_bindtype(@bind);
1098 return ($sql, @bind);
1101 my ($func, $arg, @rest) = %$val;
1102 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1103 if (@rest or $func !~ /^ \- (.+)/x);
1104 local $self->{_nested_func_lhs} = $k;
1105 $self->_where_unary_op ($1 => $arg);
1111 push @all_sql, $sql;
1112 push @all_bind, @bind;
1116 (join $and, @all_sql),
1125 my $sql = "( $label $op $clause )";
1126 return ($sql, @bind)
1130 sub _where_field_IN {
1131 my ($self, $k, $op, $vals) = @_;
1133 # backwards compatibility : if scalar, force into an arrayref
1134 $vals = [$vals] if defined $vals && ! ref $vals;
1136 my ($label) = $self->_convert($self->_quote($k));
1137 my ($placeholder) = $self->_convert('?');
1138 $op = $self->_sqlcase($op);
1140 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1141 ARRAYREF => sub { # list of choices
1142 if (@$vals) { # nonempty list
1143 my (@all_sql, @all_bind);
1145 for my $val (@$vals) {
1146 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1148 return ($placeholder, $val);
1153 ARRAYREFREF => sub {
1154 my ($sql, @bind) = @$$val;
1155 $self->_assert_bindval_matches_bindtype(@bind);
1156 return ($sql, @bind);
1159 my ($func, $arg, @rest) = %$val;
1160 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1161 if (@rest or $func !~ /^ \- (.+)/x);
1162 local $self->{_nested_func_lhs} = $k;
1163 $self->_where_unary_op ($1 => $arg);
1167 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1168 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1169 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1170 . 'will emit the logically correct SQL instead of raising this exception)'
1174 push @all_sql, $sql;
1175 push @all_bind, @bind;
1179 sprintf ('%s %s ( %s )',
1182 join (', ', @all_sql)
1184 $self->_bindtype($k, @all_bind),
1187 else { # empty list : some databases won't understand "IN ()", so DWIM
1188 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1193 SCALARREF => sub { # literal SQL
1194 my $sql = $self->_open_outer_paren ($$vals);
1195 return ("$label $op ( $sql )");
1197 ARRAYREFREF => sub { # literal SQL with bind
1198 my ($sql, @bind) = @$$vals;
1199 $self->_assert_bindval_matches_bindtype(@bind);
1200 $sql = $self->_open_outer_paren ($sql);
1201 return ("$label $op ( $sql )", @bind);
1205 puke "Argument passed to the '$op' operator can not be undefined";
1209 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1213 return ($sql, @bind);
1216 # Some databases (SQLite) treat col IN (1, 2) different from
1217 # col IN ( (1, 2) ). Use this to strip all outer parens while
1218 # adding them back in the corresponding method
1219 sub _open_outer_paren {
1220 my ($self, $sql) = @_;
1221 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1226 #======================================================================
1228 #======================================================================
1231 my ($self, $arg) = @_;
1234 for my $c ($self->_order_by_chunks ($arg) ) {
1235 $self->_SWITCH_refkind ($c, {
1236 SCALAR => sub { push @sql, $c },
1237 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1243 $self->_sqlcase(' order by'),
1249 return wantarray ? ($sql, @bind) : $sql;
1252 sub _order_by_chunks {
1253 my ($self, $arg) = @_;
1255 return $self->_SWITCH_refkind($arg, {
1258 map { $self->_order_by_chunks ($_ ) } @$arg;
1261 ARRAYREFREF => sub {
1262 my ($s, @b) = @$$arg;
1263 $self->_assert_bindval_matches_bindtype(@b);
1267 SCALAR => sub {$self->_quote($arg)},
1269 UNDEF => sub {return () },
1271 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1274 # get first pair in hash
1275 my ($key, $val, @rest) = %$arg;
1277 return () unless $key;
1279 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1280 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1286 for my $c ($self->_order_by_chunks ($val)) {
1289 $self->_SWITCH_refkind ($c, {
1294 ($sql, @bind) = @$c;
1298 $sql = $sql . ' ' . $self->_sqlcase($direction);
1300 push @ret, [ $sql, @bind];
1309 #======================================================================
1310 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1311 #======================================================================
1316 $self->_SWITCH_refkind($from, {
1317 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1318 SCALAR => sub {$self->_quote($from)},
1319 SCALARREF => sub {$$from},
1324 #======================================================================
1326 #======================================================================
1328 # highly optimized, as it's called way too often
1330 # my ($self, $label) = @_;
1332 return '' unless defined $_[1];
1333 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1335 unless ($_[0]->{quote_char}) {
1336 $_[0]->_assert_pass_injection_guard($_[1]);
1340 my $qref = ref $_[0]->{quote_char};
1343 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1345 elsif ($qref eq 'ARRAY') {
1346 ($l, $r) = @{$_[0]->{quote_char}};
1349 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1351 my $esc = $_[0]->{escape_char} || $r;
1353 # parts containing * are naturally unquoted
1354 return join( $_[0]->{name_sep}||'', map
1355 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1356 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1361 # Conversion, if applicable
1363 #my ($self, $arg) = @_;
1364 if ($_[0]->{convert}) {
1365 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1372 #my ($self, $col, @vals) = @_;
1373 # called often - tighten code
1374 return $_[0]->{bindtype} eq 'columns'
1375 ? map {[$_[1], $_]} @_[2 .. $#_]
1380 # Dies if any element of @bind is not in [colname => value] format
1381 # if bindtype is 'columns'.
1382 sub _assert_bindval_matches_bindtype {
1383 # my ($self, @bind) = @_;
1385 if ($self->{bindtype} eq 'columns') {
1387 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1388 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1394 sub _join_sql_clauses {
1395 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1397 if (@$clauses_aref > 1) {
1398 my $join = " " . $self->_sqlcase($logic) . " ";
1399 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1400 return ($sql, @$bind_aref);
1402 elsif (@$clauses_aref) {
1403 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1406 return (); # if no SQL, ignore @$bind_aref
1411 # Fix SQL case, if so requested
1413 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1414 # don't touch the argument ... crooked logic, but let's not change it!
1415 return $_[0]->{case} ? $_[1] : uc($_[1]);
1419 #======================================================================
1420 # DISPATCHING FROM REFKIND
1421 #======================================================================
1424 my ($self, $data) = @_;
1426 return 'UNDEF' unless defined $data;
1428 # blessed objects are treated like scalars
1429 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1431 return 'SCALAR' unless $ref;
1434 while ($ref eq 'REF') {
1436 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1440 return ($ref||'SCALAR') . ('REF' x $n_steps);
1444 my ($self, $data) = @_;
1445 my @try = ($self->_refkind($data));
1446 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1447 push @try, 'FALLBACK';
1451 sub _METHOD_FOR_refkind {
1452 my ($self, $meth_prefix, $data) = @_;
1455 for (@{$self->_try_refkind($data)}) {
1456 $method = $self->can($meth_prefix."_".$_)
1460 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1464 sub _SWITCH_refkind {
1465 my ($self, $data, $dispatch_table) = @_;
1468 for (@{$self->_try_refkind($data)}) {
1469 $coderef = $dispatch_table->{$_}
1473 puke "no dispatch entry for ".$self->_refkind($data)
1482 #======================================================================
1483 # VALUES, GENERATE, AUTOLOAD
1484 #======================================================================
1486 # LDNOTE: original code from nwiger, didn't touch code in that section
1487 # I feel the AUTOLOAD stuff should not be the default, it should
1488 # only be activated on explicit demand by user.
1492 my $data = shift || return;
1493 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1494 unless ref $data eq 'HASH';
1497 foreach my $k ( sort keys %$data ) {
1498 my $v = $data->{$k};
1499 $self->_SWITCH_refkind($v, {
1501 if ($self->{array_datatypes}) { # array datatype
1502 push @all_bind, $self->_bindtype($k, $v);
1504 else { # literal SQL with bind
1505 my ($sql, @bind) = @$v;
1506 $self->_assert_bindval_matches_bindtype(@bind);
1507 push @all_bind, @bind;
1510 ARRAYREFREF => sub { # literal SQL with bind
1511 my ($sql, @bind) = @${$v};
1512 $self->_assert_bindval_matches_bindtype(@bind);
1513 push @all_bind, @bind;
1515 SCALARREF => sub { # literal SQL without bind
1517 SCALAR_or_UNDEF => sub {
1518 push @all_bind, $self->_bindtype($k, $v);
1529 my(@sql, @sqlq, @sqlv);
1533 if ($ref eq 'HASH') {
1534 for my $k (sort keys %$_) {
1537 my $label = $self->_quote($k);
1538 if ($r eq 'ARRAY') {
1539 # literal SQL with bind
1540 my ($sql, @bind) = @$v;
1541 $self->_assert_bindval_matches_bindtype(@bind);
1542 push @sqlq, "$label = $sql";
1544 } elsif ($r eq 'SCALAR') {
1545 # literal SQL without bind
1546 push @sqlq, "$label = $$v";
1548 push @sqlq, "$label = ?";
1549 push @sqlv, $self->_bindtype($k, $v);
1552 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1553 } elsif ($ref eq 'ARRAY') {
1554 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1557 if ($r eq 'ARRAY') { # literal SQL with bind
1558 my ($sql, @bind) = @$v;
1559 $self->_assert_bindval_matches_bindtype(@bind);
1562 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1563 # embedded literal SQL
1570 push @sql, '(' . join(', ', @sqlq) . ')';
1571 } elsif ($ref eq 'SCALAR') {
1575 # strings get case twiddled
1576 push @sql, $self->_sqlcase($_);
1580 my $sql = join ' ', @sql;
1582 # this is pretty tricky
1583 # if ask for an array, return ($stmt, @bind)
1584 # otherwise, s/?/shift @sqlv/ to put it inline
1586 return ($sql, @sqlv);
1588 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1589 ref $d ? $d->[1] : $d/e;
1598 # This allows us to check for a local, then _form, attr
1600 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1601 return $self->generate($name, @_);
1612 SQL::Abstract - Generate SQL from Perl data structures
1618 my $sql = SQL::Abstract->new;
1620 my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
1622 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1624 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1626 my($stmt, @bind) = $sql->delete($table, \%where);
1628 # Then, use these in your DBI statements
1629 my $sth = $dbh->prepare($stmt);
1630 $sth->execute(@bind);
1632 # Just generate the WHERE clause
1633 my($stmt, @bind) = $sql->where(\%where, \@order);
1635 # Return values in the same order, for hashed queries
1636 # See PERFORMANCE section for more details
1637 my @bind = $sql->values(\%fieldvals);
1641 This module was inspired by the excellent L<DBIx::Abstract>.
1642 However, in using that module I found that what I really wanted
1643 to do was generate SQL, but still retain complete control over my
1644 statement handles and use the DBI interface. So, I set out to
1645 create an abstract SQL generation module.
1647 While based on the concepts used by L<DBIx::Abstract>, there are
1648 several important differences, especially when it comes to WHERE
1649 clauses. I have modified the concepts used to make the SQL easier
1650 to generate from Perl data structures and, IMO, more intuitive.
1651 The underlying idea is for this module to do what you mean, based
1652 on the data structures you provide it. The big advantage is that
1653 you don't have to modify your code every time your data changes,
1654 as this module figures it out.
1656 To begin with, an SQL INSERT is as easy as just specifying a hash
1657 of C<key=value> pairs:
1660 name => 'Jimbo Bobson',
1661 phone => '123-456-7890',
1662 address => '42 Sister Lane',
1663 city => 'St. Louis',
1664 state => 'Louisiana',
1667 The SQL can then be generated with this:
1669 my($stmt, @bind) = $sql->insert('people', \%data);
1671 Which would give you something like this:
1673 $stmt = "INSERT INTO people
1674 (address, city, name, phone, state)
1675 VALUES (?, ?, ?, ?, ?)";
1676 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1677 '123-456-7890', 'Louisiana');
1679 These are then used directly in your DBI code:
1681 my $sth = $dbh->prepare($stmt);
1682 $sth->execute(@bind);
1684 =head2 Inserting and Updating Arrays
1686 If your database has array types (like for example Postgres),
1687 activate the special option C<< array_datatypes => 1 >>
1688 when creating the C<SQL::Abstract> object.
1689 Then you may use an arrayref to insert and update database array types:
1691 my $sql = SQL::Abstract->new(array_datatypes => 1);
1693 planets => [qw/Mercury Venus Earth Mars/]
1696 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1700 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1702 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1705 =head2 Inserting and Updating SQL
1707 In order to apply SQL functions to elements of your C<%data> you may
1708 specify a reference to an arrayref for the given hash value. For example,
1709 if you need to execute the Oracle C<to_date> function on a value, you can
1710 say something like this:
1714 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1717 The first value in the array is the actual SQL. Any other values are
1718 optional and would be included in the bind values array. This gives
1721 my($stmt, @bind) = $sql->insert('people', \%data);
1723 $stmt = "INSERT INTO people (name, date_entered)
1724 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1725 @bind = ('Bill', '03/02/2003');
1727 An UPDATE is just as easy, all you change is the name of the function:
1729 my($stmt, @bind) = $sql->update('people', \%data);
1731 Notice that your C<%data> isn't touched; the module will generate
1732 the appropriately quirky SQL for you automatically. Usually you'll
1733 want to specify a WHERE clause for your UPDATE, though, which is
1734 where handling C<%where> hashes comes in handy...
1736 =head2 Complex where statements
1738 This module can generate pretty complicated WHERE statements
1739 easily. For example, simple C<key=value> pairs are taken to mean
1740 equality, and if you want to see if a field is within a set
1741 of values, you can use an arrayref. Let's say we wanted to
1742 SELECT some data based on this criteria:
1745 requestor => 'inna',
1746 worker => ['nwiger', 'rcwe', 'sfz'],
1747 status => { '!=', 'completed' }
1750 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1752 The above would give you something like this:
1754 $stmt = "SELECT * FROM tickets WHERE
1755 ( requestor = ? ) AND ( status != ? )
1756 AND ( worker = ? OR worker = ? OR worker = ? )";
1757 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1759 Which you could then use in DBI code like so:
1761 my $sth = $dbh->prepare($stmt);
1762 $sth->execute(@bind);
1768 The methods are simple. There's one for each major SQL operation,
1769 and a constructor you use first. The arguments are specified in a
1770 similar order to each method (table, then fields, then a where
1771 clause) to try and simplify things.
1773 =head2 new(option => 'value')
1775 The C<new()> function takes a list of options and values, and returns
1776 a new B<SQL::Abstract> object which can then be used to generate SQL
1777 through the methods below. The options accepted are:
1783 If set to 'lower', then SQL will be generated in all lowercase. By
1784 default SQL is generated in "textbook" case meaning something like:
1786 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1788 Any setting other than 'lower' is ignored.
1792 This determines what the default comparison operator is. By default
1793 it is C<=>, meaning that a hash like this:
1795 %where = (name => 'nwiger', email => 'nate@wiger.org');
1797 Will generate SQL like this:
1799 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1801 However, you may want loose comparisons by default, so if you set
1802 C<cmp> to C<like> you would get SQL such as:
1804 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1806 You can also override the comparison on an individual basis - see
1807 the huge section on L</"WHERE CLAUSES"> at the bottom.
1809 =item sqltrue, sqlfalse
1811 Expressions for inserting boolean values within SQL statements.
1812 By default these are C<1=1> and C<1=0>. They are used
1813 by the special operators C<-in> and C<-not_in> for generating
1814 correct SQL even when the argument is an empty array (see below).
1818 This determines the default logical operator for multiple WHERE
1819 statements in arrays or hashes. If absent, the default logic is "or"
1820 for arrays, and "and" for hashes. This means that a WHERE
1824 event_date => {'>=', '2/13/99'},
1825 event_date => {'<=', '4/24/03'},
1828 will generate SQL like this:
1830 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1832 This is probably not what you want given this query, though (look
1833 at the dates). To change the "OR" to an "AND", simply specify:
1835 my $sql = SQL::Abstract->new(logic => 'and');
1837 Which will change the above C<WHERE> to:
1839 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1841 The logic can also be changed locally by inserting
1842 a modifier in front of an arrayref :
1844 @where = (-and => [event_date => {'>=', '2/13/99'},
1845 event_date => {'<=', '4/24/03'} ]);
1847 See the L</"WHERE CLAUSES"> section for explanations.
1851 This will automatically convert comparisons using the specified SQL
1852 function for both column and value. This is mostly used with an argument
1853 of C<upper> or C<lower>, so that the SQL will have the effect of
1854 case-insensitive "searches". For example, this:
1856 $sql = SQL::Abstract->new(convert => 'upper');
1857 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1859 Will turn out the following SQL:
1861 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1863 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1864 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1865 not validate this option; it will just pass through what you specify verbatim).
1869 This is a kludge because many databases suck. For example, you can't
1870 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1871 Instead, you have to use C<bind_param()>:
1873 $sth->bind_param(1, 'reg data');
1874 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1876 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1877 which loses track of which field each slot refers to. Fear not.
1879 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1880 Currently, you can specify either C<normal> (default) or C<columns>. If you
1881 specify C<columns>, you will get an array that looks like this:
1883 my $sql = SQL::Abstract->new(bindtype => 'columns');
1884 my($stmt, @bind) = $sql->insert(...);
1887 [ 'column1', 'value1' ],
1888 [ 'column2', 'value2' ],
1889 [ 'column3', 'value3' ],
1892 You can then iterate through this manually, using DBI's C<bind_param()>.
1894 $sth->prepare($stmt);
1897 my($col, $data) = @$_;
1898 if ($col eq 'details' || $col eq 'comments') {
1899 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1900 } elsif ($col eq 'image') {
1901 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1903 $sth->bind_param($i, $data);
1907 $sth->execute; # execute without @bind now
1909 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1910 Basically, the advantage is still that you don't have to care which fields
1911 are or are not included. You could wrap that above C<for> loop in a simple
1912 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1913 get a layer of abstraction over manual SQL specification.
1915 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1916 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1917 will expect the bind values in this format.
1921 This is the character that a table or column name will be quoted
1922 with. By default this is an empty string, but you could set it to
1923 the character C<`>, to generate SQL like this:
1925 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1927 Alternatively, you can supply an array ref of two items, the first being the left
1928 hand quote character, and the second the right hand quote character. For
1929 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1930 that generates SQL like this:
1932 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1934 Quoting is useful if you have tables or columns names that are reserved
1935 words in your database's SQL dialect.
1939 This is the character that will be used to escape L</quote_char>s appearing
1940 in an identifier before it has been quoted.
1942 The paramter default in case of a single L</quote_char> character is the quote
1945 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
1946 this parameter defaults to the B<closing (right)> L</quote_char>. Occurences
1947 of the B<opening (left)> L</quote_char> within the identifier are currently left
1948 untouched. The default for opening-closing-style quotes may change in future
1949 versions, thus you are B<strongly encouraged> to specify the escape character
1954 This is the character that separates a table and column name. It is
1955 necessary to specify this when the C<quote_char> option is selected,
1956 so that tables and column names can be individually quoted like this:
1958 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1960 =item injection_guard
1962 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1963 column name specified in a query structure. This is a safety mechanism to avoid
1964 injection attacks when mishandling user input e.g.:
1966 my %condition_as_column_value_pairs = get_values_from_user();
1967 $sqla->select( ... , \%condition_as_column_value_pairs );
1969 If the expression matches an exception is thrown. Note that literal SQL
1970 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1972 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1974 =item array_datatypes
1976 When this option is true, arrayrefs in INSERT or UPDATE are
1977 interpreted as array datatypes and are passed directly
1979 When this option is false, arrayrefs are interpreted
1980 as literal SQL, just like refs to arrayrefs
1981 (but this behavior is for backwards compatibility; when writing
1982 new queries, use the "reference to arrayref" syntax
1988 Takes a reference to a list of "special operators"
1989 to extend the syntax understood by L<SQL::Abstract>.
1990 See section L</"SPECIAL OPERATORS"> for details.
1994 Takes a reference to a list of "unary operators"
1995 to extend the syntax understood by L<SQL::Abstract>.
1996 See section L</"UNARY OPERATORS"> for details.
2002 =head2 insert($table, \@values || \%fieldvals, \%options)
2004 This is the simplest function. You simply give it a table name
2005 and either an arrayref of values or hashref of field/value pairs.
2006 It returns an SQL INSERT statement and a list of bind values.
2007 See the sections on L</"Inserting and Updating Arrays"> and
2008 L</"Inserting and Updating SQL"> for information on how to insert
2009 with those data types.
2011 The optional C<\%options> hash reference may contain additional
2012 options to generate the insert SQL. Currently supported options
2019 Takes either a scalar of raw SQL fields, or an array reference of
2020 field names, and adds on an SQL C<RETURNING> statement at the end.
2021 This allows you to return data generated by the insert statement
2022 (such as row IDs) without performing another C<SELECT> statement.
2023 Note, however, this is not part of the SQL standard and may not
2024 be supported by all database engines.
2028 =head2 update($table, \%fieldvals, \%where)
2030 This takes a table, hashref of field/value pairs, and an optional
2031 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2033 See the sections on L</"Inserting and Updating Arrays"> and
2034 L</"Inserting and Updating SQL"> for information on how to insert
2035 with those data types.
2037 =head2 select($source, $fields, $where, $order)
2039 This returns a SQL SELECT statement and associated list of bind values, as
2040 specified by the arguments :
2046 Specification of the 'FROM' part of the statement.
2047 The argument can be either a plain scalar (interpreted as a table
2048 name, will be quoted), or an arrayref (interpreted as a list
2049 of table names, joined by commas, quoted), or a scalarref
2050 (literal table name, not quoted), or a ref to an arrayref
2051 (list of literal table names, joined by commas, not quoted).
2055 Specification of the list of fields to retrieve from
2057 The argument can be either an arrayref (interpreted as a list
2058 of field names, will be joined by commas and quoted), or a
2059 plain scalar (literal SQL, not quoted).
2060 Please observe that this API is not as flexible as that of
2061 the first argument C<$source>, for backwards compatibility reasons.
2065 Optional argument to specify the WHERE part of the query.
2066 The argument is most often a hashref, but can also be
2067 an arrayref or plain scalar --
2068 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2072 Optional argument to specify the ORDER BY part of the query.
2073 The argument can be a scalar, a hashref or an arrayref
2074 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2080 =head2 delete($table, \%where)
2082 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2083 It returns an SQL DELETE statement and list of bind values.
2085 =head2 where(\%where, \@order)
2087 This is used to generate just the WHERE clause. For example,
2088 if you have an arbitrary data structure and know what the
2089 rest of your SQL is going to look like, but want an easy way
2090 to produce a WHERE clause, use this. It returns an SQL WHERE
2091 clause and list of bind values.
2094 =head2 values(\%data)
2096 This just returns the values from the hash C<%data>, in the same
2097 order that would be returned from any of the other above queries.
2098 Using this allows you to markedly speed up your queries if you
2099 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2101 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2103 Warning: This is an experimental method and subject to change.
2105 This returns arbitrarily generated SQL. It's a really basic shortcut.
2106 It will return two different things, depending on return context:
2108 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2109 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2111 These would return the following:
2113 # First calling form
2114 $stmt = "CREATE TABLE test (?, ?)";
2115 @bind = (field1, field2);
2117 # Second calling form
2118 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2120 Depending on what you're trying to do, it's up to you to choose the correct
2121 format. In this example, the second form is what you would want.
2125 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2129 ALTER SESSION SET nls_date_format = 'MM/YY'
2131 You get the idea. Strings get their case twiddled, but everything
2132 else remains verbatim.
2134 =head1 EXPORTABLE FUNCTIONS
2136 =head2 is_plain_value
2138 Determines if the supplied argument is a plain value as understood by this
2143 =item * The value is C<undef>
2145 =item * The value is a non-reference
2147 =item * The value is an object with stringification overloading
2149 =item * The value is of the form C<< { -value => $anything } >>
2153 On failure returns C<undef>, on sucess returns a B<scalar> reference
2154 to the original supplied argument.
2156 =head2 is_literal_value
2158 Determines if the supplied argument is a literal value as understood by this
2163 =item * C<\$sql_string>
2165 =item * C<\[ $sql_string, @bind_values ]>
2167 =item * C<< { -ident => $plain_defined_string } >>
2171 On failure returns C<undef>, on sucess returns an B<array> reference
2172 containing the unpacked version of the supplied literal SQL and bind values.
2174 =head1 WHERE CLAUSES
2178 This module uses a variation on the idea from L<DBIx::Abstract>. It
2179 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2180 module is that things in arrays are OR'ed, and things in hashes
2183 The easiest way to explain is to show lots of examples. After
2184 each C<%where> hash shown, it is assumed you used:
2186 my($stmt, @bind) = $sql->where(\%where);
2188 However, note that the C<%where> hash can be used directly in any
2189 of the other functions as well, as described above.
2191 =head2 Key-value pairs
2193 So, let's get started. To begin, a simple hash:
2197 status => 'completed'
2200 Is converted to SQL C<key = val> statements:
2202 $stmt = "WHERE user = ? AND status = ?";
2203 @bind = ('nwiger', 'completed');
2205 One common thing I end up doing is having a list of values that
2206 a field can be in. To do this, simply specify a list inside of
2211 status => ['assigned', 'in-progress', 'pending'];
2214 This simple code will create the following:
2216 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2217 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2219 A field associated to an empty arrayref will be considered a
2220 logical false and will generate 0=1.
2222 =head2 Tests for NULL values
2224 If the value part is C<undef> then this is converted to SQL <IS NULL>
2233 $stmt = "WHERE user = ? AND status IS NULL";
2236 To test if a column IS NOT NULL:
2240 status => { '!=', undef },
2243 =head2 Specific comparison operators
2245 If you want to specify a different type of operator for your comparison,
2246 you can use a hashref for a given column:
2250 status => { '!=', 'completed' }
2253 Which would generate:
2255 $stmt = "WHERE user = ? AND status != ?";
2256 @bind = ('nwiger', 'completed');
2258 To test against multiple values, just enclose the values in an arrayref:
2260 status => { '=', ['assigned', 'in-progress', 'pending'] };
2262 Which would give you:
2264 "WHERE status = ? OR status = ? OR status = ?"
2267 The hashref can also contain multiple pairs, in which case it is expanded
2268 into an C<AND> of its elements:
2272 status => { '!=', 'completed', -not_like => 'pending%' }
2275 # Or more dynamically, like from a form
2276 $where{user} = 'nwiger';
2277 $where{status}{'!='} = 'completed';
2278 $where{status}{'-not_like'} = 'pending%';
2280 # Both generate this
2281 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2282 @bind = ('nwiger', 'completed', 'pending%');
2285 To get an OR instead, you can combine it with the arrayref idea:
2289 priority => [ { '=', 2 }, { '>', 5 } ]
2292 Which would generate:
2294 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2295 @bind = ('2', '5', 'nwiger');
2297 If you want to include literal SQL (with or without bind values), just use a
2298 scalar reference or array reference as the value:
2301 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2302 date_expires => { '<' => \"now()" }
2305 Which would generate:
2307 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2308 @bind = ('11/26/2008');
2311 =head2 Logic and nesting operators
2313 In the example above,
2314 there is a subtle trap if you want to say something like
2315 this (notice the C<AND>):
2317 WHERE priority != ? AND priority != ?
2319 Because, in Perl you I<can't> do this:
2321 priority => { '!=', 2, '!=', 1 }
2323 As the second C<!=> key will obliterate the first. The solution
2324 is to use the special C<-modifier> form inside an arrayref:
2326 priority => [ -and => {'!=', 2},
2330 Normally, these would be joined by C<OR>, but the modifier tells it
2331 to use C<AND> instead. (Hint: You can use this in conjunction with the
2332 C<logic> option to C<new()> in order to change the way your queries
2333 work by default.) B<Important:> Note that the C<-modifier> goes
2334 B<INSIDE> the arrayref, as an extra first element. This will
2335 B<NOT> do what you think it might:
2337 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2339 Here is a quick list of equivalencies, since there is some overlap:
2342 status => {'!=', 'completed', 'not like', 'pending%' }
2343 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2346 status => {'=', ['assigned', 'in-progress']}
2347 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2348 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2352 =head2 Special operators : IN, BETWEEN, etc.
2354 You can also use the hashref format to compare a list of fields using the
2355 C<IN> comparison operator, by specifying the list as an arrayref:
2358 status => 'completed',
2359 reportid => { -in => [567, 2335, 2] }
2362 Which would generate:
2364 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2365 @bind = ('completed', '567', '2335', '2');
2367 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2370 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2371 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2372 'sqltrue' (by default : C<1=1>).
2374 In addition to the array you can supply a chunk of literal sql or
2375 literal sql with bind:
2378 customer => { -in => \[
2379 'SELECT cust_id FROM cust WHERE balance > ?',
2382 status => { -in => \'SELECT status_codes FROM states' },
2388 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2389 AND status IN ( SELECT status_codes FROM states )
2393 Finally, if the argument to C<-in> is not a reference, it will be
2394 treated as a single-element array.
2396 Another pair of operators is C<-between> and C<-not_between>,
2397 used with an arrayref of two values:
2401 completion_date => {
2402 -not_between => ['2002-10-01', '2003-02-06']
2408 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2410 Just like with C<-in> all plausible combinations of literal SQL
2414 start0 => { -between => [ 1, 2 ] },
2415 start1 => { -between => \["? AND ?", 1, 2] },
2416 start2 => { -between => \"lower(x) AND upper(y)" },
2417 start3 => { -between => [
2419 \["upper(?)", 'stuff' ],
2426 ( start0 BETWEEN ? AND ? )
2427 AND ( start1 BETWEEN ? AND ? )
2428 AND ( start2 BETWEEN lower(x) AND upper(y) )
2429 AND ( start3 BETWEEN lower(x) AND upper(?) )
2431 @bind = (1, 2, 1, 2, 'stuff');
2434 These are the two builtin "special operators"; but the
2435 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2437 =head2 Unary operators: bool
2439 If you wish to test against boolean columns or functions within your
2440 database you can use the C<-bool> and C<-not_bool> operators. For
2441 example to test the column C<is_user> being true and the column
2442 C<is_enabled> being false you would use:-
2446 -not_bool => 'is_enabled',
2451 WHERE is_user AND NOT is_enabled
2453 If a more complex combination is required, testing more conditions,
2454 then you should use the and/or operators:-
2459 -not_bool => { two=> { -rlike => 'bar' } },
2460 -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
2471 (NOT ( three = ? OR three > ? ))
2474 =head2 Nested conditions, -and/-or prefixes
2476 So far, we've seen how multiple conditions are joined with a top-level
2477 C<AND>. We can change this by putting the different conditions we want in
2478 hashes and then putting those hashes in an array. For example:
2483 status => { -like => ['pending%', 'dispatched'] },
2487 status => 'unassigned',
2491 This data structure would create the following:
2493 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2494 OR ( user = ? AND status = ? ) )";
2495 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2498 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2499 to change the logic inside :
2505 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2506 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2513 WHERE ( user = ? AND (
2514 ( workhrs > ? AND geo = ? )
2515 OR ( workhrs < ? OR geo = ? )
2518 =head3 Algebraic inconsistency, for historical reasons
2520 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2521 operator goes C<outside> of the nested structure; whereas when connecting
2522 several constraints on one column, the C<-and> operator goes
2523 C<inside> the arrayref. Here is an example combining both features :
2526 -and => [a => 1, b => 2],
2527 -or => [c => 3, d => 4],
2528 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2533 WHERE ( ( ( a = ? AND b = ? )
2534 OR ( c = ? OR d = ? )
2535 OR ( e LIKE ? AND e LIKE ? ) ) )
2537 This difference in syntax is unfortunate but must be preserved for
2538 historical reasons. So be careful : the two examples below would
2539 seem algebraically equivalent, but they are not
2541 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2542 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2544 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2545 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2548 =head2 Literal SQL and value type operators
2550 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2551 side" is a column name and the "right side" is a value (normally rendered as
2552 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2553 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2554 alter this behavior. There are several ways of doing so.
2558 This is a virtual operator that signals the string to its right side is an
2559 identifier (a column name) and not a value. For example to compare two
2560 columns you would write:
2563 priority => { '<', 2 },
2564 requestor => { -ident => 'submitter' },
2569 $stmt = "WHERE priority < ? AND requestor = submitter";
2572 If you are maintaining legacy code you may see a different construct as
2573 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2578 This is a virtual operator that signals that the construct to its right side
2579 is a value to be passed to DBI. This is for example necessary when you want
2580 to write a where clause against an array (for RDBMS that support such
2581 datatypes). For example:
2584 array => { -value => [1, 2, 3] }
2589 $stmt = 'WHERE array = ?';
2590 @bind = ([1, 2, 3]);
2592 Note that if you were to simply say:
2598 the result would probably not be what you wanted:
2600 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2605 Finally, sometimes only literal SQL will do. To include a random snippet
2606 of SQL verbatim, you specify it as a scalar reference. Consider this only
2607 as a last resort. Usually there is a better way. For example:
2610 priority => { '<', 2 },
2611 requestor => { -in => \'(SELECT name FROM hitmen)' },
2616 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2619 Note that in this example, you only get one bind parameter back, since
2620 the verbatim SQL is passed as part of the statement.
2624 Never use untrusted input as a literal SQL argument - this is a massive
2625 security risk (there is no way to check literal snippets for SQL
2626 injections and other nastyness). If you need to deal with untrusted input
2627 use literal SQL with placeholders as described next.
2629 =head3 Literal SQL with placeholders and bind values (subqueries)
2631 If the literal SQL to be inserted has placeholders and bind values,
2632 use a reference to an arrayref (yes this is a double reference --
2633 not so common, but perfectly legal Perl). For example, to find a date
2634 in Postgres you can use something like this:
2637 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2642 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2645 Note that you must pass the bind values in the same format as they are returned
2646 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2647 provide the bind values in the C<< [ column_meta => value ] >> format, where
2648 C<column_meta> is an opaque scalar value; most commonly the column name, but
2649 you can use any scalar value (including references and blessed references),
2650 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2651 to C<columns> the above example will look like:
2654 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2657 Literal SQL is especially useful for nesting parenthesized clauses in the
2658 main SQL query. Here is a first example :
2660 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2664 bar => \["IN ($sub_stmt)" => @sub_bind],
2669 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2670 WHERE c2 < ? AND c3 LIKE ?))";
2671 @bind = (1234, 100, "foo%");
2673 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2674 are expressed in the same way. Of course the C<$sub_stmt> and
2675 its associated bind values can be generated through a former call
2678 my ($sub_stmt, @sub_bind)
2679 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2680 c3 => {-like => "foo%"}});
2683 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2686 In the examples above, the subquery was used as an operator on a column;
2687 but the same principle also applies for a clause within the main C<%where>
2688 hash, like an EXISTS subquery :
2690 my ($sub_stmt, @sub_bind)
2691 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2692 my %where = ( -and => [
2694 \["EXISTS ($sub_stmt)" => @sub_bind],
2699 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2700 WHERE c1 = ? AND c2 > t0.c0))";
2704 Observe that the condition on C<c2> in the subquery refers to
2705 column C<t0.c0> of the main query : this is I<not> a bind
2706 value, so we have to express it through a scalar ref.
2707 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2708 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2709 what we wanted here.
2711 Finally, here is an example where a subquery is used
2712 for expressing unary negation:
2714 my ($sub_stmt, @sub_bind)
2715 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2716 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2718 lname => {like => '%son%'},
2719 \["NOT ($sub_stmt)" => @sub_bind],
2724 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2725 @bind = ('%son%', 10, 20)
2727 =head3 Deprecated usage of Literal SQL
2729 Below are some examples of archaic use of literal SQL. It is shown only as
2730 reference for those who deal with legacy code. Each example has a much
2731 better, cleaner and safer alternative that users should opt for in new code.
2737 my %where = ( requestor => \'IS NOT NULL' )
2739 $stmt = "WHERE requestor IS NOT NULL"
2741 This used to be the way of generating NULL comparisons, before the handling
2742 of C<undef> got formalized. For new code please use the superior syntax as
2743 described in L</Tests for NULL values>.
2747 my %where = ( requestor => \'= submitter' )
2749 $stmt = "WHERE requestor = submitter"
2751 This used to be the only way to compare columns. Use the superior L</-ident>
2752 method for all new code. For example an identifier declared in such a way
2753 will be properly quoted if L</quote_char> is properly set, while the legacy
2754 form will remain as supplied.
2758 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2760 $stmt = "WHERE completed > ? AND is_ready"
2761 @bind = ('2012-12-21')
2763 Using an empty string literal used to be the only way to express a boolean.
2764 For all new code please use the much more readable
2765 L<-bool|/Unary operators: bool> operator.
2771 These pages could go on for a while, since the nesting of the data
2772 structures this module can handle are pretty much unlimited (the
2773 module implements the C<WHERE> expansion as a recursive function
2774 internally). Your best bet is to "play around" with the module a
2775 little to see how the data structures behave, and choose the best
2776 format for your data based on that.
2778 And of course, all the values above will probably be replaced with
2779 variables gotten from forms or the command line. After all, if you
2780 knew everything ahead of time, you wouldn't have to worry about
2781 dynamically-generating SQL and could just hardwire it into your
2784 =head1 ORDER BY CLAUSES
2786 Some functions take an order by clause. This can either be a scalar (just a
2787 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2788 or an array of either of the two previous forms. Examples:
2790 Given | Will Generate
2791 ----------------------------------------------------------
2793 \'colA DESC' | ORDER BY colA DESC
2795 'colA' | ORDER BY colA
2797 [qw/colA colB/] | ORDER BY colA, colB
2799 {-asc => 'colA'} | ORDER BY colA ASC
2801 {-desc => 'colB'} | ORDER BY colB DESC
2803 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2805 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2808 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2809 { -desc => [qw/colB/], | colC ASC, colD ASC
2810 { -asc => [qw/colC colD/],|
2812 ===========================================================
2816 =head1 SPECIAL OPERATORS
2818 my $sqlmaker = SQL::Abstract->new(special_ops => [
2822 my ($self, $field, $op, $arg) = @_;
2828 handler => 'method_name',
2832 A "special operator" is a SQL syntactic clause that can be
2833 applied to a field, instead of a usual binary operator.
2836 WHERE field IN (?, ?, ?)
2837 WHERE field BETWEEN ? AND ?
2838 WHERE MATCH(field) AGAINST (?, ?)
2840 Special operators IN and BETWEEN are fairly standard and therefore
2841 are builtin within C<SQL::Abstract> (as the overridable methods
2842 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2843 like the MATCH .. AGAINST example above which is specific to MySQL,
2844 you can write your own operator handlers - supply a C<special_ops>
2845 argument to the C<new> method. That argument takes an arrayref of
2846 operator definitions; each operator definition is a hashref with two
2853 the regular expression to match the operator
2857 Either a coderef or a plain scalar method name. In both cases
2858 the expected return is C<< ($sql, @bind) >>.
2860 When supplied with a method name, it is simply called on the
2861 L<SQL::Abstract/> object as:
2863 $self->$method_name ($field, $op, $arg)
2867 $op is the part that matched the handler regex
2868 $field is the LHS of the operator
2871 When supplied with a coderef, it is called as:
2873 $coderef->($self, $field, $op, $arg)
2878 For example, here is an implementation
2879 of the MATCH .. AGAINST syntax for MySQL
2881 my $sqlmaker = SQL::Abstract->new(special_ops => [
2883 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2884 {regex => qr/^match$/i,
2886 my ($self, $field, $op, $arg) = @_;
2887 $arg = [$arg] if not ref $arg;
2888 my $label = $self->_quote($field);
2889 my ($placeholder) = $self->_convert('?');
2890 my $placeholders = join ", ", (($placeholder) x @$arg);
2891 my $sql = $self->_sqlcase('match') . " ($label) "
2892 . $self->_sqlcase('against') . " ($placeholders) ";
2893 my @bind = $self->_bindtype($field, @$arg);
2894 return ($sql, @bind);
2901 =head1 UNARY OPERATORS
2903 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2907 my ($self, $op, $arg) = @_;
2913 handler => 'method_name',
2917 A "unary operator" is a SQL syntactic clause that can be
2918 applied to a field - the operator goes before the field
2920 You can write your own operator handlers - supply a C<unary_ops>
2921 argument to the C<new> method. That argument takes an arrayref of
2922 operator definitions; each operator definition is a hashref with two
2929 the regular expression to match the operator
2933 Either a coderef or a plain scalar method name. In both cases
2934 the expected return is C<< $sql >>.
2936 When supplied with a method name, it is simply called on the
2937 L<SQL::Abstract/> object as:
2939 $self->$method_name ($op, $arg)
2943 $op is the part that matched the handler regex
2944 $arg is the RHS or argument of the operator
2946 When supplied with a coderef, it is called as:
2948 $coderef->($self, $op, $arg)
2956 Thanks to some benchmarking by Mark Stosberg, it turns out that
2957 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2958 I must admit this wasn't an intentional design issue, but it's a
2959 byproduct of the fact that you get to control your C<DBI> handles
2962 To maximize performance, use a code snippet like the following:
2964 # prepare a statement handle using the first row
2965 # and then reuse it for the rest of the rows
2967 for my $href (@array_of_hashrefs) {
2968 $stmt ||= $sql->insert('table', $href);
2969 $sth ||= $dbh->prepare($stmt);
2970 $sth->execute($sql->values($href));
2973 The reason this works is because the keys in your C<$href> are sorted
2974 internally by B<SQL::Abstract>. Thus, as long as your data retains
2975 the same structure, you only have to generate the SQL the first time
2976 around. On subsequent queries, simply use the C<values> function provided
2977 by this module to return your values in the correct order.
2979 However this depends on the values having the same type - if, for
2980 example, the values of a where clause may either have values
2981 (resulting in sql of the form C<column = ?> with a single bind
2982 value), or alternatively the values might be C<undef> (resulting in
2983 sql of the form C<column IS NULL> with no bind value) then the
2984 caching technique suggested will not work.
2988 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2989 really like this part (I do, at least). Building up a complex query
2990 can be as simple as the following:
2997 use CGI::FormBuilder;
3000 my $form = CGI::FormBuilder->new(...);
3001 my $sql = SQL::Abstract->new;
3003 if ($form->submitted) {
3004 my $field = $form->field;
3005 my $id = delete $field->{id};
3006 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3009 Of course, you would still have to connect using C<DBI> to run the
3010 query, but the point is that if you make your form look like your
3011 table, the actual query script can be extremely simplistic.
3013 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3014 a fast interface to returning and formatting data. I frequently
3015 use these three modules together to write complex database query
3016 apps in under 50 lines.
3022 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3024 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3030 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3031 Great care has been taken to preserve the I<published> behavior
3032 documented in previous versions in the 1.* family; however,
3033 some features that were previously undocumented, or behaved
3034 differently from the documentation, had to be changed in order
3035 to clarify the semantics. Hence, client code that was relying
3036 on some dark areas of C<SQL::Abstract> v1.*
3037 B<might behave differently> in v1.50.
3039 The main changes are :
3045 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
3049 support for the { operator => \"..." } construct (to embed literal SQL)
3053 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3057 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3061 defensive programming : check arguments
3065 fixed bug with global logic, which was previously implemented
3066 through global variables yielding side-effects. Prior versions would
3067 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3068 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3069 Now this is interpreted
3070 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3075 fixed semantics of _bindtype on array args
3079 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3080 we just avoid shifting arrays within that tree.
3084 dropped the C<_modlogic> function
3088 =head1 ACKNOWLEDGEMENTS
3090 There are a number of individuals that have really helped out with
3091 this module. Unfortunately, most of them submitted bugs via CPAN
3092 so I have no idea who they are! But the people I do know are:
3094 Ash Berlin (order_by hash term support)
3095 Matt Trout (DBIx::Class support)
3096 Mark Stosberg (benchmarking)
3097 Chas Owens (initial "IN" operator support)
3098 Philip Collins (per-field SQL functions)
3099 Eric Kolve (hashref "AND" support)
3100 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3101 Dan Kubb (support for "quote_char" and "name_sep")
3102 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3103 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3104 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3105 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3106 Oliver Charles (support for "RETURNING" after "INSERT")
3112 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3116 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3118 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3120 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3121 While not an official support venue, C<DBIx::Class> makes heavy use of
3122 C<SQL::Abstract>, and as such list members there are very familiar with
3123 how to create queries.
3127 This module is free software; you may copy this under the same
3128 terms as perl itself (either the GNU General Public License or
3129 the Artistic License)