1 package SQL::Abstract; # see doc at end of file
3 # LDNOTE : this code is heavy refactoring from original SQLA.
4 # Several design decisions will need discussion during
5 # the test / diffusion / acceptance phase; those are marked with flag
6 # 'LDNOTE' (note by laurent.dami AT free.fr)
13 use Data::Query::Constants qw(
14 DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_LITERAL DQ_JOIN DQ_SELECT
17 #======================================================================
19 #======================================================================
21 our $VERSION = '1.72';
23 # This would confuse some packagers
24 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
28 # special operators (-in, -between). May be extended/overridden by user.
29 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
30 my @BUILTIN_SPECIAL_OPS = (
31 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
32 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
33 {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
34 {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
37 # unaryish operators - key maps to handler
38 my @BUILTIN_UNARY_OPS = (
39 # the digits are backcompat stuff
40 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
41 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
42 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
43 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
44 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
45 { regex => qr/^ value $/ix, handler => '_where_op_VALUE' },
48 #======================================================================
49 # DEBUGGING AND ERROR REPORTING
50 #======================================================================
53 return unless $_[0]->{debug}; shift; # a little faster
54 my $func = (caller(1))[3];
55 warn "[$func] ", @_, "\n";
59 my($func) = (caller(1))[3];
60 Carp::carp "[$func] Warning: ", @_;
64 my($func) = (caller(1))[3];
65 Carp::croak "[$func] Fatal: ", @_;
69 #======================================================================
71 #======================================================================
75 my $class = ref($self) || $self;
76 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
78 # choose our case by keeping an option around
79 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
81 # default logic for interpreting arrayrefs
82 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
84 # how to return bind vars
85 # LDNOTE: changed nwiger code : why this 'delete' ??
86 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
87 $opt{bindtype} ||= 'normal';
89 # default comparison is "=", but can be overridden
92 # try to recognize which are the 'equality' and 'unequality' ops
93 # (temporary quickfix, should go through a more seasoned API)
94 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
95 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
98 $opt{sqltrue} ||= '1=1';
99 $opt{sqlfalse} ||= '0=1';
102 $opt{special_ops} ||= [];
103 # regexes are applied in order, thus push after user-defines
104 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
107 $opt{unary_ops} ||= [];
108 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
110 # rudimentary saniy-check for user supplied bits treated as functions/operators
111 # If a purported function matches this regular expression, an exception is thrown.
112 # Literal SQL is *NOT* subject to this check, only functions (and column names
113 # when quoting is not in effect)
116 # need to guard against ()'s in column names too, but this will break tons of
117 # hacks... ideas anyone?
118 $opt{injection_guard} ||= qr/
124 $opt{name_sep} ||= '.';
126 $opt{renderer} ||= do {
127 require Data::Query::Renderer::SQL::Naive;
128 my ($always, $chars);
129 for ($opt{quote_char}) {
130 $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
133 Data::Query::Renderer::SQL::Naive->new({
134 quote_chars => $chars, always_quote => $always,
138 return bless \%opt, $class;
142 my ($self, $dq) = @_;
143 my ($sql, @bind) = @{$self->{renderer}->render($dq)};
144 wantarray ? ($sql, map $_->{value}, @bind) : $sql;
147 sub _assert_pass_injection_guard {
148 if ($_[1] =~ $_[0]->{injection_guard}) {
149 my $class = ref $_[0];
150 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
151 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
152 . "{injection_guard} attribute to ${class}->new()"
157 #======================================================================
159 #======================================================================
163 my $table = $self->_table(shift);
164 my $data = shift || return;
167 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
168 my ($sql, @bind) = $self->$method($data);
169 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
171 if ($options->{returning}) {
172 my ($s, @b) = $self->_insert_returning ($options);
177 return wantarray ? ($sql, @bind) : $sql;
180 sub _insert_returning {
181 my ($self, $options) = @_;
183 my $f = $options->{returning};
185 my $fieldlist = $self->_SWITCH_refkind($f, {
186 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
187 SCALAR => sub {$self->_quote($f)},
188 SCALARREF => sub {$$f},
190 return $self->_sqlcase(' returning ') . $fieldlist;
193 sub _insert_HASHREF { # explicit list of fields and then values
194 my ($self, $data) = @_;
196 my @fields = sort keys %$data;
198 my ($sql, @bind) = $self->_insert_values($data);
201 $_ = $self->_quote($_) foreach @fields;
202 $sql = "( ".join(", ", @fields).") ".$sql;
204 return ($sql, @bind);
207 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
208 my ($self, $data) = @_;
210 # no names (arrayref) so can't generate bindtype
211 $self->{bindtype} ne 'columns'
212 or belch "can't do 'columns' bindtype when called with arrayref";
214 # fold the list of values into a hash of column name - value pairs
215 # (where the column names are artificially generated, and their
216 # lexicographical ordering keep the ordering of the original list)
217 my $i = "a"; # incremented values will be in lexicographical order
218 my $data_in_hash = { map { ($i++ => $_) } @$data };
220 return $self->_insert_values($data_in_hash);
223 sub _insert_ARRAYREFREF { # literal SQL with bind
224 my ($self, $data) = @_;
226 my ($sql, @bind) = @${$data};
227 $self->_assert_bindval_matches_bindtype(@bind);
229 return ($sql, @bind);
233 sub _insert_SCALARREF { # literal SQL without bind
234 my ($self, $data) = @_;
240 my ($self, $data) = @_;
242 my (@values, @all_bind);
243 foreach my $column (sort keys %$data) {
244 my $v = $data->{$column};
246 $self->_SWITCH_refkind($v, {
249 if ($self->{array_datatypes}) { # if array datatype are activated
251 push @all_bind, $self->_bindtype($column, $v);
253 else { # else literal SQL with bind
254 my ($sql, @bind) = @$v;
255 $self->_assert_bindval_matches_bindtype(@bind);
257 push @all_bind, @bind;
261 ARRAYREFREF => sub { # literal SQL with bind
262 my ($sql, @bind) = @${$v};
263 $self->_assert_bindval_matches_bindtype(@bind);
265 push @all_bind, @bind;
268 # THINK : anything useful to do with a HASHREF ?
269 HASHREF => sub { # (nothing, but old SQLA passed it through)
270 #TODO in SQLA >= 2.0 it will die instead
271 belch "HASH ref as bind value in insert is not supported";
273 push @all_bind, $self->_bindtype($column, $v);
276 SCALARREF => sub { # literal SQL without bind
280 SCALAR_or_UNDEF => sub {
282 push @all_bind, $self->_bindtype($column, $v);
289 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
290 return ($sql, @all_bind);
295 #======================================================================
297 #======================================================================
302 my $table = $self->_table(shift);
303 my $data = shift || return;
306 # first build the 'SET' part of the sql statement
307 my (@set, @all_bind);
308 puke "Unsupported data type specified to \$sql->update"
309 unless ref $data eq 'HASH';
311 for my $k (sort keys %$data) {
314 my $label = $self->_quote($k);
316 $self->_SWITCH_refkind($v, {
318 if ($self->{array_datatypes}) { # array datatype
319 push @set, "$label = ?";
320 push @all_bind, $self->_bindtype($k, $v);
322 else { # literal SQL with bind
323 my ($sql, @bind) = @$v;
324 $self->_assert_bindval_matches_bindtype(@bind);
325 push @set, "$label = $sql";
326 push @all_bind, @bind;
329 ARRAYREFREF => sub { # literal SQL with bind
330 my ($sql, @bind) = @${$v};
331 $self->_assert_bindval_matches_bindtype(@bind);
332 push @set, "$label = $sql";
333 push @all_bind, @bind;
335 SCALARREF => sub { # literal SQL without bind
336 push @set, "$label = $$v";
339 my ($op, $arg, @rest) = %$v;
341 puke 'Operator calls in update must be in the form { -op => $arg }'
342 if (@rest or not $op =~ /^\-(.+)/);
344 local $self->{_nested_func_lhs} = $k;
345 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
347 push @set, "$label = $sql";
348 push @all_bind, @bind;
350 SCALAR_or_UNDEF => sub {
351 push @set, "$label = ?";
352 push @all_bind, $self->_bindtype($k, $v);
358 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
362 my($where_sql, @where_bind) = $self->where($where);
364 push @all_bind, @where_bind;
367 return wantarray ? ($sql, @all_bind) : $sql;
373 #======================================================================
375 #======================================================================
380 my $table = $self->_table(shift);
381 my $fields = shift || '*';
385 my($where_sql, @bind) = $self->where($where, $order);
387 my $sql = $self->_render_dq({
391 type => DQ_IDENTIFIER,
392 elements => [ split /\Q$self->{name_sep}/, $_ ],
393 }, ref($fields) eq 'ARRAY' ? @$fields : $fields
398 literal => $table.$where_sql
402 return wantarray ? ($sql, @bind) : $sql;
405 #======================================================================
407 #======================================================================
412 my $table = $self->_table(shift);
416 my($where_sql, @bind) = $self->where($where);
417 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
419 return wantarray ? ($sql, @bind) : $sql;
423 #======================================================================
425 #======================================================================
429 # Finally, a separate routine just to handle WHERE clauses
431 my ($self, $where, $order) = @_;
434 my ($sql, @bind) = $self->_recurse_where($where);
435 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
439 $sql .= $self->_order_by($order);
442 return wantarray ? ($sql, @bind) : $sql;
447 my ($self, $where, $logic) = @_;
449 # dispatch on appropriate method according to refkind of $where
450 my $method = $self->_METHOD_FOR_refkind("_where", $where);
452 my ($sql, @bind) = $self->$method($where, $logic);
454 # DBIx::Class directly calls _recurse_where in scalar context, so
455 # we must implement it, even if not in the official API
456 return wantarray ? ($sql, @bind) : $sql;
461 #======================================================================
462 # WHERE: top-level ARRAYREF
463 #======================================================================
466 sub _where_ARRAYREF {
467 my ($self, $where, $logic) = @_;
469 $logic = uc($logic || $self->{logic});
470 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
472 my @clauses = @$where;
474 my (@sql_clauses, @all_bind);
475 # need to use while() so can shift() for pairs
476 while (my $el = shift @clauses) {
478 # switch according to kind of $el and get corresponding ($sql, @bind)
479 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
481 # skip empty elements, otherwise get invalid trailing AND stuff
482 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
486 $self->_assert_bindval_matches_bindtype(@b);
490 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
491 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
492 # side-effect: the first hashref within an array would change
493 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
494 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
495 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
497 SCALARREF => sub { ($$el); },
499 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
500 $self->_recurse_where({$el => shift(@clauses)})},
502 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
506 push @sql_clauses, $sql;
507 push @all_bind, @bind;
511 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
514 #======================================================================
515 # WHERE: top-level ARRAYREFREF
516 #======================================================================
518 sub _where_ARRAYREFREF {
519 my ($self, $where) = @_;
520 my ($sql, @bind) = @$$where;
521 $self->_assert_bindval_matches_bindtype(@bind);
522 return ($sql, @bind);
525 #======================================================================
526 # WHERE: top-level HASHREF
527 #======================================================================
530 my ($self, $where) = @_;
531 my (@sql_clauses, @all_bind);
533 for my $k (sort keys %$where) {
534 my $v = $where->{$k};
536 # ($k => $v) is either a special unary op or a regular hashpair
537 my ($sql, @bind) = do {
539 # put the operator in canonical form
541 $op = substr $op, 1; # remove initial dash
542 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
543 $op =~ s/\s+/ /g; # compress whitespace
545 # so that -not_foo works correctly
546 $op =~ s/^not_/NOT /i;
548 $self->_debug("Unary OP(-$op) within hashref, recursing...");
549 my ($s, @b) = $self->_where_unary_op ($op, $v);
551 # top level vs nested
552 # we assume that handled unary ops will take care of their ()s
554 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
556 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
561 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
562 $self->$method($k, $v);
566 push @sql_clauses, $sql;
567 push @all_bind, @bind;
570 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
573 sub _where_unary_op {
574 my ($self, $op, $rhs) = @_;
576 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
577 my $handler = $op_entry->{handler};
579 if (not ref $handler) {
580 if ($op =~ s/ [_\s]? \d+ $//x ) {
581 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
582 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
584 return $self->$handler ($op, $rhs);
586 elsif (ref $handler eq 'CODE') {
587 return $handler->($self, $op, $rhs);
590 puke "Illegal handler for operator $op - expecting a method name or a coderef";
594 $self->_debug("Generic unary OP: $op - recursing as function");
596 $self->_assert_pass_injection_guard($op);
598 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
600 puke "Illegal use of top-level '$op'"
601 unless $self->{_nested_func_lhs};
604 $self->_convert('?'),
605 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
609 $self->_recurse_where ($rhs)
613 $sql = sprintf ('%s %s',
614 $self->_sqlcase($op),
618 return ($sql, @bind);
621 sub _where_op_ANDOR {
622 my ($self, $op, $v) = @_;
624 $self->_SWITCH_refkind($v, {
626 return $self->_where_ARRAYREF($v, $op);
630 return ( $op =~ /^or/i )
631 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
632 : $self->_where_HASHREF($v);
636 puke "-$op => \\\$scalar makes little sense, use " .
638 ? '[ \$scalar, \%rest_of_conditions ] instead'
639 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
644 puke "-$op => \\[...] makes little sense, use " .
646 ? '[ \[...], \%rest_of_conditions ] instead'
647 : '-and => [ \[...], \%rest_of_conditions ] instead'
651 SCALAR => sub { # permissively interpreted as SQL
652 puke "-$op => \$value makes little sense, use -bool => \$value instead";
656 puke "-$op => undef not supported";
662 my ($self, $op, $v) = @_;
664 $self->_SWITCH_refkind($v, {
666 SCALAR => sub { # permissively interpreted as SQL
667 belch "literal SQL should be -nest => \\'scalar' "
668 . "instead of -nest => 'scalar' ";
673 puke "-$op => undef not supported";
677 $self->_recurse_where ($v);
685 my ($self, $op, $v) = @_;
687 my ($s, @b) = $self->_SWITCH_refkind($v, {
688 SCALAR => sub { # interpreted as SQL column
689 $self->_convert($self->_quote($v));
693 puke "-$op => undef not supported";
697 $self->_recurse_where ($v);
701 $s = "(NOT $s)" if $op =~ /^not/i;
706 sub _where_op_IDENT {
708 my ($op, $rhs) = splice @_, -2;
710 puke "-$op takes a single scalar argument (a quotable identifier)";
713 # in case we are called as a top level special op (no '=')
716 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
724 sub _where_op_VALUE {
726 my ($op, $rhs) = splice @_, -2;
728 # in case we are called as a top level special op (no '=')
733 ($lhs || $self->{_nested_func_lhs}),
740 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
744 $self->_convert('?'),
750 sub _where_hashpair_ARRAYREF {
751 my ($self, $k, $v) = @_;
754 my @v = @$v; # need copy because of shift below
755 $self->_debug("ARRAY($k) means distribute over elements");
757 # put apart first element if it is an operator (-and, -or)
759 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
763 my @distributed = map { {$k => $_} } @v;
766 $self->_debug("OP($op) reinjected into the distributed array");
767 unshift @distributed, $op;
770 my $logic = $op ? substr($op, 1) : '';
772 return $self->_recurse_where(\@distributed, $logic);
775 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
776 $self->_debug("empty ARRAY($k) means 0=1");
777 return ($self->{sqlfalse});
781 sub _where_hashpair_HASHREF {
782 my ($self, $k, $v, $logic) = @_;
785 local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
787 my ($all_sql, @all_bind);
789 for my $orig_op (sort keys %$v) {
790 my $val = $v->{$orig_op};
792 # put the operator in canonical form
795 # FIXME - we need to phase out dash-less ops
796 $op =~ s/^-//; # remove possible initial dash
797 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
798 $op =~ s/\s+/ /g; # compress whitespace
800 $self->_assert_pass_injection_guard($op);
802 # so that -not_foo works correctly
803 $op =~ s/^not_/NOT /i;
807 # CASE: col-value logic modifiers
808 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
809 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
811 # CASE: special operators like -in or -between
812 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
813 my $handler = $special_op->{handler};
815 puke "No handler supplied for special operator $orig_op";
817 elsif (not ref $handler) {
818 ($sql, @bind) = $self->$handler ($k, $op, $val);
820 elsif (ref $handler eq 'CODE') {
821 ($sql, @bind) = $handler->($self, $k, $op, $val);
824 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
828 $self->_SWITCH_refkind($val, {
830 ARRAYREF => sub { # CASE: col => {op => \@vals}
831 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
834 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
835 my ($sub_sql, @sub_bind) = @$$val;
836 $self->_assert_bindval_matches_bindtype(@sub_bind);
837 $sql = join ' ', $self->_convert($self->_quote($k)),
838 $self->_sqlcase($op),
843 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
844 my $is = ($op =~ $self->{equality_op}) ? 'is' :
845 ($op =~ $self->{inequality_op}) ? 'is not' :
846 puke "unexpected operator '$orig_op' with undef operand";
847 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
850 FALLBACK => sub { # CASE: col => {op/func => $stuff}
852 # retain for proper column type bind
853 $self->{_nested_func_lhs} ||= $k;
855 ($sql, @bind) = $self->_where_unary_op ($op, $val);
858 $self->_convert($self->_quote($k)),
859 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
865 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
866 push @all_bind, @bind;
868 return ($all_sql, @all_bind);
873 sub _where_field_op_ARRAYREF {
874 my ($self, $k, $op, $vals) = @_;
876 my @vals = @$vals; #always work on a copy
879 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
881 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
884 # see if the first element is an -and/-or op
886 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
891 # distribute $op over each remaining member of @vals, append logic if exists
892 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
894 # LDNOTE : had planned to change the distribution logic when
895 # $op =~ $self->{inequality_op}, because of Morgan laws :
896 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
897 # WHERE field != 22 OR field != 33 : the user probably means
898 # WHERE field != 22 AND field != 33.
899 # To do this, replace the above to roughly :
900 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
901 # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
905 # try to DWIM on equality operators
906 # LDNOTE : not 100% sure this is the correct thing to do ...
907 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
908 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
911 puke "operator '$op' applied on an empty array (field '$k')";
916 sub _where_hashpair_SCALARREF {
917 my ($self, $k, $v) = @_;
918 $self->_debug("SCALAR($k) means literal SQL: $$v");
919 my $sql = $self->_quote($k) . " " . $$v;
923 # literal SQL with bind
924 sub _where_hashpair_ARRAYREFREF {
925 my ($self, $k, $v) = @_;
926 $self->_debug("REF($k) means literal SQL: @${$v}");
927 my ($sql, @bind) = @$$v;
928 $self->_assert_bindval_matches_bindtype(@bind);
929 $sql = $self->_quote($k) . " " . $sql;
930 return ($sql, @bind );
933 # literal SQL without bind
934 sub _where_hashpair_SCALAR {
935 my ($self, $k, $v) = @_;
936 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
937 my $sql = join ' ', $self->_convert($self->_quote($k)),
938 $self->_sqlcase($self->{cmp}),
939 $self->_convert('?');
940 my @bind = $self->_bindtype($k, $v);
941 return ( $sql, @bind);
945 sub _where_hashpair_UNDEF {
946 my ($self, $k, $v) = @_;
947 $self->_debug("UNDEF($k) means IS NULL");
948 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
952 #======================================================================
953 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
954 #======================================================================
957 sub _where_SCALARREF {
958 my ($self, $where) = @_;
961 $self->_debug("SCALAR(*top) means literal SQL: $$where");
967 my ($self, $where) = @_;
970 $self->_debug("NOREF(*top) means literal SQL: $where");
981 #======================================================================
982 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
983 #======================================================================
986 sub _where_field_BETWEEN {
987 my ($self, $k, $op, $vals) = @_;
989 my ($label, $and, $placeholder);
990 $label = $self->_convert($self->_quote($k));
991 $and = ' ' . $self->_sqlcase('and') . ' ';
992 $placeholder = $self->_convert('?');
993 $op = $self->_sqlcase($op);
995 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
997 my ($s, @b) = @$$vals;
998 $self->_assert_bindval_matches_bindtype(@b);
1005 puke "special op 'between' accepts an arrayref with exactly two values"
1008 my (@all_sql, @all_bind);
1009 foreach my $val (@$vals) {
1010 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1012 return ($placeholder, $self->_bindtype($k, $val) );
1017 ARRAYREFREF => sub {
1018 my ($sql, @bind) = @$$val;
1019 $self->_assert_bindval_matches_bindtype(@bind);
1020 return ($sql, @bind);
1023 my ($func, $arg, @rest) = %$val;
1024 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1025 if (@rest or $func !~ /^ \- (.+)/x);
1026 local $self->{_nested_func_lhs} = $k;
1027 $self->_where_unary_op ($1 => $arg);
1030 push @all_sql, $sql;
1031 push @all_bind, @bind;
1035 (join $and, @all_sql),
1040 puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
1044 my $sql = "( $label $op $clause )";
1045 return ($sql, @bind)
1049 sub _where_field_IN {
1050 my ($self, $k, $op, $vals) = @_;
1052 # backwards compatibility : if scalar, force into an arrayref
1053 $vals = [$vals] if defined $vals && ! ref $vals;
1055 my ($label) = $self->_convert($self->_quote($k));
1056 my ($placeholder) = $self->_convert('?');
1057 $op = $self->_sqlcase($op);
1059 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1060 ARRAYREF => sub { # list of choices
1061 if (@$vals) { # nonempty list
1062 my (@all_sql, @all_bind);
1064 for my $val (@$vals) {
1065 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1067 return ($placeholder, $val);
1072 ARRAYREFREF => sub {
1073 my ($sql, @bind) = @$$val;
1074 $self->_assert_bindval_matches_bindtype(@bind);
1075 return ($sql, @bind);
1078 my ($func, $arg, @rest) = %$val;
1079 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1080 if (@rest or $func !~ /^ \- (.+)/x);
1081 local $self->{_nested_func_lhs} = $k;
1082 $self->_where_unary_op ($1 => $arg);
1085 return $self->_sqlcase('null');
1088 push @all_sql, $sql;
1089 push @all_bind, @bind;
1093 sprintf ('%s %s ( %s )',
1096 join (', ', @all_sql)
1098 $self->_bindtype($k, @all_bind),
1101 else { # empty list : some databases won't understand "IN ()", so DWIM
1102 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1107 SCALARREF => sub { # literal SQL
1108 my $sql = $self->_open_outer_paren ($$vals);
1109 return ("$label $op ( $sql )");
1111 ARRAYREFREF => sub { # literal SQL with bind
1112 my ($sql, @bind) = @$$vals;
1113 $self->_assert_bindval_matches_bindtype(@bind);
1114 $sql = $self->_open_outer_paren ($sql);
1115 return ("$label $op ( $sql )", @bind);
1119 puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)";
1123 return ($sql, @bind);
1126 # Some databases (SQLite) treat col IN (1, 2) different from
1127 # col IN ( (1, 2) ). Use this to strip all outer parens while
1128 # adding them back in the corresponding method
1129 sub _open_outer_paren {
1130 my ($self, $sql) = @_;
1131 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1136 #======================================================================
1138 #======================================================================
1141 my ($self, $arg) = @_;
1144 for my $c ($self->_order_by_chunks ($arg) ) {
1145 $self->_SWITCH_refkind ($c, {
1146 SCALAR => sub { push @sql, $c },
1147 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1153 $self->_sqlcase(' order by'),
1159 return wantarray ? ($sql, @bind) : $sql;
1162 sub _order_by_chunks {
1163 my ($self, $arg) = @_;
1165 return $self->_SWITCH_refkind($arg, {
1168 map { $self->_order_by_chunks ($_ ) } @$arg;
1171 ARRAYREFREF => sub {
1172 my ($s, @b) = @$$arg;
1173 $self->_assert_bindval_matches_bindtype(@b);
1177 SCALAR => sub {$self->_quote($arg)},
1179 UNDEF => sub {return () },
1181 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1184 # get first pair in hash
1185 my ($key, $val, @rest) = %$arg;
1187 return () unless $key;
1189 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1190 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1196 for my $c ($self->_order_by_chunks ($val)) {
1199 $self->_SWITCH_refkind ($c, {
1204 ($sql, @bind) = @$c;
1208 $sql = $sql . ' ' . $self->_sqlcase($direction);
1210 push @ret, [ $sql, @bind];
1219 #======================================================================
1220 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1221 #======================================================================
1227 $self->_SWITCH_refkind($from, {
1229 die "Empty FROM list" unless my @f = @$from;
1231 type => DQ_IDENTIFIER,
1232 elements => [ split /\Q$self->{name_sep}/, shift @f ],
1234 while (my $x = shift @f) {
1238 type => DQ_IDENTIFIER,
1239 elements => [ split /\Q$self->{name_sep}/, $x ],
1247 type => DQ_IDENTIFIER,
1248 elements => [ split /\Q$self->{name_sep}/, $from ],
1263 #======================================================================
1265 #======================================================================
1267 # highly optimized, as it's called way too often
1269 # my ($self, $label) = @_;
1271 return '' unless defined $_[1];
1272 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1274 unless ($_[0]->{quote_char}) {
1275 $_[0]->_assert_pass_injection_guard($_[1]);
1279 my $qref = ref $_[0]->{quote_char};
1282 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1284 elsif ($qref eq 'ARRAY') {
1285 ($l, $r) = @{$_[0]->{quote_char}};
1288 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1291 # parts containing * are naturally unquoted
1292 return join( $_[0]->{name_sep}||'', map
1293 { $_ eq '*' ? $_ : $l . $_ . $r }
1294 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1299 # Conversion, if applicable
1301 #my ($self, $arg) = @_;
1303 # LDNOTE : modified the previous implementation below because
1304 # it was not consistent : the first "return" is always an array,
1305 # the second "return" is context-dependent. Anyway, _convert
1306 # seems always used with just a single argument, so make it a
1308 # return @_ unless $self->{convert};
1309 # my $conv = $self->_sqlcase($self->{convert});
1310 # my @ret = map { $conv.'('.$_.')' } @_;
1311 # return wantarray ? @ret : $ret[0];
1312 if ($_[0]->{convert}) {
1313 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1320 #my ($self, $col, @vals) = @_;
1322 #LDNOTE : changed original implementation below because it did not make
1323 # sense when bindtype eq 'columns' and @vals > 1.
1324 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1326 # called often - tighten code
1327 return $_[0]->{bindtype} eq 'columns'
1328 ? map {[$_[1], $_]} @_[2 .. $#_]
1333 # Dies if any element of @bind is not in [colname => value] format
1334 # if bindtype is 'columns'.
1335 sub _assert_bindval_matches_bindtype {
1336 # my ($self, @bind) = @_;
1338 if ($self->{bindtype} eq 'columns') {
1340 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1341 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1347 sub _join_sql_clauses {
1348 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1350 if (@$clauses_aref > 1) {
1351 my $join = " " . $self->_sqlcase($logic) . " ";
1352 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1353 return ($sql, @$bind_aref);
1355 elsif (@$clauses_aref) {
1356 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1359 return (); # if no SQL, ignore @$bind_aref
1364 # Fix SQL case, if so requested
1366 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1367 # don't touch the argument ... crooked logic, but let's not change it!
1368 return $_[0]->{case} ? $_[1] : uc($_[1]);
1372 #======================================================================
1373 # DISPATCHING FROM REFKIND
1374 #======================================================================
1377 my ($self, $data) = @_;
1379 return 'UNDEF' unless defined $data;
1381 # blessed objects are treated like scalars
1382 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1384 return 'SCALAR' unless $ref;
1387 while ($ref eq 'REF') {
1389 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1393 return ($ref||'SCALAR') . ('REF' x $n_steps);
1397 my ($self, $data) = @_;
1398 my @try = ($self->_refkind($data));
1399 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1400 push @try, 'FALLBACK';
1404 sub _METHOD_FOR_refkind {
1405 my ($self, $meth_prefix, $data) = @_;
1408 for (@{$self->_try_refkind($data)}) {
1409 $method = $self->can($meth_prefix."_".$_)
1413 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1417 sub _SWITCH_refkind {
1418 my ($self, $data, $dispatch_table) = @_;
1421 for (@{$self->_try_refkind($data)}) {
1422 $coderef = $dispatch_table->{$_}
1426 puke "no dispatch entry for ".$self->_refkind($data)
1435 #======================================================================
1436 # VALUES, GENERATE, AUTOLOAD
1437 #======================================================================
1439 # LDNOTE: original code from nwiger, didn't touch code in that section
1440 # I feel the AUTOLOAD stuff should not be the default, it should
1441 # only be activated on explicit demand by user.
1445 my $data = shift || return;
1446 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1447 unless ref $data eq 'HASH';
1450 foreach my $k ( sort keys %$data ) {
1451 my $v = $data->{$k};
1452 $self->_SWITCH_refkind($v, {
1454 if ($self->{array_datatypes}) { # array datatype
1455 push @all_bind, $self->_bindtype($k, $v);
1457 else { # literal SQL with bind
1458 my ($sql, @bind) = @$v;
1459 $self->_assert_bindval_matches_bindtype(@bind);
1460 push @all_bind, @bind;
1463 ARRAYREFREF => sub { # literal SQL with bind
1464 my ($sql, @bind) = @${$v};
1465 $self->_assert_bindval_matches_bindtype(@bind);
1466 push @all_bind, @bind;
1468 SCALARREF => sub { # literal SQL without bind
1470 SCALAR_or_UNDEF => sub {
1471 push @all_bind, $self->_bindtype($k, $v);
1482 my(@sql, @sqlq, @sqlv);
1486 if ($ref eq 'HASH') {
1487 for my $k (sort keys %$_) {
1490 my $label = $self->_quote($k);
1491 if ($r eq 'ARRAY') {
1492 # literal SQL with bind
1493 my ($sql, @bind) = @$v;
1494 $self->_assert_bindval_matches_bindtype(@bind);
1495 push @sqlq, "$label = $sql";
1497 } elsif ($r eq 'SCALAR') {
1498 # literal SQL without bind
1499 push @sqlq, "$label = $$v";
1501 push @sqlq, "$label = ?";
1502 push @sqlv, $self->_bindtype($k, $v);
1505 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1506 } elsif ($ref eq 'ARRAY') {
1507 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1510 if ($r eq 'ARRAY') { # literal SQL with bind
1511 my ($sql, @bind) = @$v;
1512 $self->_assert_bindval_matches_bindtype(@bind);
1515 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1516 # embedded literal SQL
1523 push @sql, '(' . join(', ', @sqlq) . ')';
1524 } elsif ($ref eq 'SCALAR') {
1528 # strings get case twiddled
1529 push @sql, $self->_sqlcase($_);
1533 my $sql = join ' ', @sql;
1535 # this is pretty tricky
1536 # if ask for an array, return ($stmt, @bind)
1537 # otherwise, s/?/shift @sqlv/ to put it inline
1539 return ($sql, @sqlv);
1541 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1542 ref $d ? $d->[1] : $d/e;
1551 # This allows us to check for a local, then _form, attr
1553 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1554 return $self->generate($name, @_);
1565 SQL::Abstract - Generate SQL from Perl data structures
1571 my $sql = SQL::Abstract->new;
1573 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1575 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1577 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1579 my($stmt, @bind) = $sql->delete($table, \%where);
1581 # Then, use these in your DBI statements
1582 my $sth = $dbh->prepare($stmt);
1583 $sth->execute(@bind);
1585 # Just generate the WHERE clause
1586 my($stmt, @bind) = $sql->where(\%where, \@order);
1588 # Return values in the same order, for hashed queries
1589 # See PERFORMANCE section for more details
1590 my @bind = $sql->values(\%fieldvals);
1594 This module was inspired by the excellent L<DBIx::Abstract>.
1595 However, in using that module I found that what I really wanted
1596 to do was generate SQL, but still retain complete control over my
1597 statement handles and use the DBI interface. So, I set out to
1598 create an abstract SQL generation module.
1600 While based on the concepts used by L<DBIx::Abstract>, there are
1601 several important differences, especially when it comes to WHERE
1602 clauses. I have modified the concepts used to make the SQL easier
1603 to generate from Perl data structures and, IMO, more intuitive.
1604 The underlying idea is for this module to do what you mean, based
1605 on the data structures you provide it. The big advantage is that
1606 you don't have to modify your code every time your data changes,
1607 as this module figures it out.
1609 To begin with, an SQL INSERT is as easy as just specifying a hash
1610 of C<key=value> pairs:
1613 name => 'Jimbo Bobson',
1614 phone => '123-456-7890',
1615 address => '42 Sister Lane',
1616 city => 'St. Louis',
1617 state => 'Louisiana',
1620 The SQL can then be generated with this:
1622 my($stmt, @bind) = $sql->insert('people', \%data);
1624 Which would give you something like this:
1626 $stmt = "INSERT INTO people
1627 (address, city, name, phone, state)
1628 VALUES (?, ?, ?, ?, ?)";
1629 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1630 '123-456-7890', 'Louisiana');
1632 These are then used directly in your DBI code:
1634 my $sth = $dbh->prepare($stmt);
1635 $sth->execute(@bind);
1637 =head2 Inserting and Updating Arrays
1639 If your database has array types (like for example Postgres),
1640 activate the special option C<< array_datatypes => 1 >>
1641 when creating the C<SQL::Abstract> object.
1642 Then you may use an arrayref to insert and update database array types:
1644 my $sql = SQL::Abstract->new(array_datatypes => 1);
1646 planets => [qw/Mercury Venus Earth Mars/]
1649 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1653 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1655 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1658 =head2 Inserting and Updating SQL
1660 In order to apply SQL functions to elements of your C<%data> you may
1661 specify a reference to an arrayref for the given hash value. For example,
1662 if you need to execute the Oracle C<to_date> function on a value, you can
1663 say something like this:
1667 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1670 The first value in the array is the actual SQL. Any other values are
1671 optional and would be included in the bind values array. This gives
1674 my($stmt, @bind) = $sql->insert('people', \%data);
1676 $stmt = "INSERT INTO people (name, date_entered)
1677 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1678 @bind = ('Bill', '03/02/2003');
1680 An UPDATE is just as easy, all you change is the name of the function:
1682 my($stmt, @bind) = $sql->update('people', \%data);
1684 Notice that your C<%data> isn't touched; the module will generate
1685 the appropriately quirky SQL for you automatically. Usually you'll
1686 want to specify a WHERE clause for your UPDATE, though, which is
1687 where handling C<%where> hashes comes in handy...
1689 =head2 Complex where statements
1691 This module can generate pretty complicated WHERE statements
1692 easily. For example, simple C<key=value> pairs are taken to mean
1693 equality, and if you want to see if a field is within a set
1694 of values, you can use an arrayref. Let's say we wanted to
1695 SELECT some data based on this criteria:
1698 requestor => 'inna',
1699 worker => ['nwiger', 'rcwe', 'sfz'],
1700 status => { '!=', 'completed' }
1703 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1705 The above would give you something like this:
1707 $stmt = "SELECT * FROM tickets WHERE
1708 ( requestor = ? ) AND ( status != ? )
1709 AND ( worker = ? OR worker = ? OR worker = ? )";
1710 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1712 Which you could then use in DBI code like so:
1714 my $sth = $dbh->prepare($stmt);
1715 $sth->execute(@bind);
1721 The functions are simple. There's one for each major SQL operation,
1722 and a constructor you use first. The arguments are specified in a
1723 similar order to each function (table, then fields, then a where
1724 clause) to try and simplify things.
1729 =head2 new(option => 'value')
1731 The C<new()> function takes a list of options and values, and returns
1732 a new B<SQL::Abstract> object which can then be used to generate SQL
1733 through the methods below. The options accepted are:
1739 If set to 'lower', then SQL will be generated in all lowercase. By
1740 default SQL is generated in "textbook" case meaning something like:
1742 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1744 Any setting other than 'lower' is ignored.
1748 This determines what the default comparison operator is. By default
1749 it is C<=>, meaning that a hash like this:
1751 %where = (name => 'nwiger', email => 'nate@wiger.org');
1753 Will generate SQL like this:
1755 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1757 However, you may want loose comparisons by default, so if you set
1758 C<cmp> to C<like> you would get SQL such as:
1760 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1762 You can also override the comparsion on an individual basis - see
1763 the huge section on L</"WHERE CLAUSES"> at the bottom.
1765 =item sqltrue, sqlfalse
1767 Expressions for inserting boolean values within SQL statements.
1768 By default these are C<1=1> and C<1=0>. They are used
1769 by the special operators C<-in> and C<-not_in> for generating
1770 correct SQL even when the argument is an empty array (see below).
1774 This determines the default logical operator for multiple WHERE
1775 statements in arrays or hashes. If absent, the default logic is "or"
1776 for arrays, and "and" for hashes. This means that a WHERE
1780 event_date => {'>=', '2/13/99'},
1781 event_date => {'<=', '4/24/03'},
1784 will generate SQL like this:
1786 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1788 This is probably not what you want given this query, though (look
1789 at the dates). To change the "OR" to an "AND", simply specify:
1791 my $sql = SQL::Abstract->new(logic => 'and');
1793 Which will change the above C<WHERE> to:
1795 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1797 The logic can also be changed locally by inserting
1798 a modifier in front of an arrayref :
1800 @where = (-and => [event_date => {'>=', '2/13/99'},
1801 event_date => {'<=', '4/24/03'} ]);
1803 See the L</"WHERE CLAUSES"> section for explanations.
1807 This will automatically convert comparisons using the specified SQL
1808 function for both column and value. This is mostly used with an argument
1809 of C<upper> or C<lower>, so that the SQL will have the effect of
1810 case-insensitive "searches". For example, this:
1812 $sql = SQL::Abstract->new(convert => 'upper');
1813 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1815 Will turn out the following SQL:
1817 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1819 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1820 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1821 not validate this option; it will just pass through what you specify verbatim).
1825 This is a kludge because many databases suck. For example, you can't
1826 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1827 Instead, you have to use C<bind_param()>:
1829 $sth->bind_param(1, 'reg data');
1830 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1832 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1833 which loses track of which field each slot refers to. Fear not.
1835 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1836 Currently, you can specify either C<normal> (default) or C<columns>. If you
1837 specify C<columns>, you will get an array that looks like this:
1839 my $sql = SQL::Abstract->new(bindtype => 'columns');
1840 my($stmt, @bind) = $sql->insert(...);
1843 [ 'column1', 'value1' ],
1844 [ 'column2', 'value2' ],
1845 [ 'column3', 'value3' ],
1848 You can then iterate through this manually, using DBI's C<bind_param()>.
1850 $sth->prepare($stmt);
1853 my($col, $data) = @$_;
1854 if ($col eq 'details' || $col eq 'comments') {
1855 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1856 } elsif ($col eq 'image') {
1857 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1859 $sth->bind_param($i, $data);
1863 $sth->execute; # execute without @bind now
1865 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1866 Basically, the advantage is still that you don't have to care which fields
1867 are or are not included. You could wrap that above C<for> loop in a simple
1868 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1869 get a layer of abstraction over manual SQL specification.
1871 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1872 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1873 will expect the bind values in this format.
1877 This is the character that a table or column name will be quoted
1878 with. By default this is an empty string, but you could set it to
1879 the character C<`>, to generate SQL like this:
1881 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1883 Alternatively, you can supply an array ref of two items, the first being the left
1884 hand quote character, and the second the right hand quote character. For
1885 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1886 that generates SQL like this:
1888 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1890 Quoting is useful if you have tables or columns names that are reserved
1891 words in your database's SQL dialect.
1895 This is the character that separates a table and column name. It is
1896 necessary to specify this when the C<quote_char> option is selected,
1897 so that tables and column names can be individually quoted like this:
1899 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1901 =item injection_guard
1903 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1904 column name specified in a query structure. This is a safety mechanism to avoid
1905 injection attacks when mishandling user input e.g.:
1907 my %condition_as_column_value_pairs = get_values_from_user();
1908 $sqla->select( ... , \%condition_as_column_value_pairs );
1910 If the expression matches an exception is thrown. Note that literal SQL
1911 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1913 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1915 =item array_datatypes
1917 When this option is true, arrayrefs in INSERT or UPDATE are
1918 interpreted as array datatypes and are passed directly
1920 When this option is false, arrayrefs are interpreted
1921 as literal SQL, just like refs to arrayrefs
1922 (but this behavior is for backwards compatibility; when writing
1923 new queries, use the "reference to arrayref" syntax
1929 Takes a reference to a list of "special operators"
1930 to extend the syntax understood by L<SQL::Abstract>.
1931 See section L</"SPECIAL OPERATORS"> for details.
1935 Takes a reference to a list of "unary operators"
1936 to extend the syntax understood by L<SQL::Abstract>.
1937 See section L</"UNARY OPERATORS"> for details.
1943 =head2 insert($table, \@values || \%fieldvals, \%options)
1945 This is the simplest function. You simply give it a table name
1946 and either an arrayref of values or hashref of field/value pairs.
1947 It returns an SQL INSERT statement and a list of bind values.
1948 See the sections on L</"Inserting and Updating Arrays"> and
1949 L</"Inserting and Updating SQL"> for information on how to insert
1950 with those data types.
1952 The optional C<\%options> hash reference may contain additional
1953 options to generate the insert SQL. Currently supported options
1960 Takes either a scalar of raw SQL fields, or an array reference of
1961 field names, and adds on an SQL C<RETURNING> statement at the end.
1962 This allows you to return data generated by the insert statement
1963 (such as row IDs) without performing another C<SELECT> statement.
1964 Note, however, this is not part of the SQL standard and may not
1965 be supported by all database engines.
1969 =head2 update($table, \%fieldvals, \%where)
1971 This takes a table, hashref of field/value pairs, and an optional
1972 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1974 See the sections on L</"Inserting and Updating Arrays"> and
1975 L</"Inserting and Updating SQL"> for information on how to insert
1976 with those data types.
1978 =head2 select($source, $fields, $where, $order)
1980 This returns a SQL SELECT statement and associated list of bind values, as
1981 specified by the arguments :
1987 Specification of the 'FROM' part of the statement.
1988 The argument can be either a plain scalar (interpreted as a table
1989 name, will be quoted), or an arrayref (interpreted as a list
1990 of table names, joined by commas, quoted), or a scalarref
1991 (literal table name, not quoted), or a ref to an arrayref
1992 (list of literal table names, joined by commas, not quoted).
1996 Specification of the list of fields to retrieve from
1998 The argument can be either an arrayref (interpreted as a list
1999 of field names, will be joined by commas and quoted), or a
2000 plain scalar (literal SQL, not quoted).
2001 Please observe that this API is not as flexible as for
2002 the first argument C<$table>, for backwards compatibility reasons.
2006 Optional argument to specify the WHERE part of the query.
2007 The argument is most often a hashref, but can also be
2008 an arrayref or plain scalar --
2009 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2013 Optional argument to specify the ORDER BY part of the query.
2014 The argument can be a scalar, a hashref or an arrayref
2015 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2021 =head2 delete($table, \%where)
2023 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2024 It returns an SQL DELETE statement and list of bind values.
2026 =head2 where(\%where, \@order)
2028 This is used to generate just the WHERE clause. For example,
2029 if you have an arbitrary data structure and know what the
2030 rest of your SQL is going to look like, but want an easy way
2031 to produce a WHERE clause, use this. It returns an SQL WHERE
2032 clause and list of bind values.
2035 =head2 values(\%data)
2037 This just returns the values from the hash C<%data>, in the same
2038 order that would be returned from any of the other above queries.
2039 Using this allows you to markedly speed up your queries if you
2040 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2042 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2044 Warning: This is an experimental method and subject to change.
2046 This returns arbitrarily generated SQL. It's a really basic shortcut.
2047 It will return two different things, depending on return context:
2049 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2050 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2052 These would return the following:
2054 # First calling form
2055 $stmt = "CREATE TABLE test (?, ?)";
2056 @bind = (field1, field2);
2058 # Second calling form
2059 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2061 Depending on what you're trying to do, it's up to you to choose the correct
2062 format. In this example, the second form is what you would want.
2066 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2070 ALTER SESSION SET nls_date_format = 'MM/YY'
2072 You get the idea. Strings get their case twiddled, but everything
2073 else remains verbatim.
2075 =head1 WHERE CLAUSES
2079 This module uses a variation on the idea from L<DBIx::Abstract>. It
2080 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2081 module is that things in arrays are OR'ed, and things in hashes
2084 The easiest way to explain is to show lots of examples. After
2085 each C<%where> hash shown, it is assumed you used:
2087 my($stmt, @bind) = $sql->where(\%where);
2089 However, note that the C<%where> hash can be used directly in any
2090 of the other functions as well, as described above.
2092 =head2 Key-value pairs
2094 So, let's get started. To begin, a simple hash:
2098 status => 'completed'
2101 Is converted to SQL C<key = val> statements:
2103 $stmt = "WHERE user = ? AND status = ?";
2104 @bind = ('nwiger', 'completed');
2106 One common thing I end up doing is having a list of values that
2107 a field can be in. To do this, simply specify a list inside of
2112 status => ['assigned', 'in-progress', 'pending'];
2115 This simple code will create the following:
2117 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2118 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2120 A field associated to an empty arrayref will be considered a
2121 logical false and will generate 0=1.
2123 =head2 Tests for NULL values
2125 If the value part is C<undef> then this is converted to SQL <IS NULL>
2134 $stmt = "WHERE user = ? AND status IS NULL";
2137 To test if a column IS NOT NULL:
2141 status => { '!=', undef },
2144 =head2 Specific comparison operators
2146 If you want to specify a different type of operator for your comparison,
2147 you can use a hashref for a given column:
2151 status => { '!=', 'completed' }
2154 Which would generate:
2156 $stmt = "WHERE user = ? AND status != ?";
2157 @bind = ('nwiger', 'completed');
2159 To test against multiple values, just enclose the values in an arrayref:
2161 status => { '=', ['assigned', 'in-progress', 'pending'] };
2163 Which would give you:
2165 "WHERE status = ? OR status = ? OR status = ?"
2168 The hashref can also contain multiple pairs, in which case it is expanded
2169 into an C<AND> of its elements:
2173 status => { '!=', 'completed', -not_like => 'pending%' }
2176 # Or more dynamically, like from a form
2177 $where{user} = 'nwiger';
2178 $where{status}{'!='} = 'completed';
2179 $where{status}{'-not_like'} = 'pending%';
2181 # Both generate this
2182 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2183 @bind = ('nwiger', 'completed', 'pending%');
2186 To get an OR instead, you can combine it with the arrayref idea:
2190 priority => [ { '=', 2 }, { '>', 5 } ]
2193 Which would generate:
2195 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2196 @bind = ('2', '5', 'nwiger');
2198 If you want to include literal SQL (with or without bind values), just use a
2199 scalar reference or array reference as the value:
2202 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2203 date_expires => { '<' => \"now()" }
2206 Which would generate:
2208 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2209 @bind = ('11/26/2008');
2212 =head2 Logic and nesting operators
2214 In the example above,
2215 there is a subtle trap if you want to say something like
2216 this (notice the C<AND>):
2218 WHERE priority != ? AND priority != ?
2220 Because, in Perl you I<can't> do this:
2222 priority => { '!=', 2, '!=', 1 }
2224 As the second C<!=> key will obliterate the first. The solution
2225 is to use the special C<-modifier> form inside an arrayref:
2227 priority => [ -and => {'!=', 2},
2231 Normally, these would be joined by C<OR>, but the modifier tells it
2232 to use C<AND> instead. (Hint: You can use this in conjunction with the
2233 C<logic> option to C<new()> in order to change the way your queries
2234 work by default.) B<Important:> Note that the C<-modifier> goes
2235 B<INSIDE> the arrayref, as an extra first element. This will
2236 B<NOT> do what you think it might:
2238 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2240 Here is a quick list of equivalencies, since there is some overlap:
2243 status => {'!=', 'completed', 'not like', 'pending%' }
2244 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2247 status => {'=', ['assigned', 'in-progress']}
2248 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2249 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2253 =head2 Special operators : IN, BETWEEN, etc.
2255 You can also use the hashref format to compare a list of fields using the
2256 C<IN> comparison operator, by specifying the list as an arrayref:
2259 status => 'completed',
2260 reportid => { -in => [567, 2335, 2] }
2263 Which would generate:
2265 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2266 @bind = ('completed', '567', '2335', '2');
2268 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2271 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2272 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2273 'sqltrue' (by default : C<1=1>).
2275 In addition to the array you can supply a chunk of literal sql or
2276 literal sql with bind:
2279 customer => { -in => \[
2280 'SELECT cust_id FROM cust WHERE balance > ?',
2283 status => { -in => \'SELECT status_codes FROM states' },
2289 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2290 AND status IN ( SELECT status_codes FROM states )
2296 Another pair of operators is C<-between> and C<-not_between>,
2297 used with an arrayref of two values:
2301 completion_date => {
2302 -not_between => ['2002-10-01', '2003-02-06']
2308 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2310 Just like with C<-in> all plausible combinations of literal SQL
2314 start0 => { -between => [ 1, 2 ] },
2315 start1 => { -between => \["? AND ?", 1, 2] },
2316 start2 => { -between => \"lower(x) AND upper(y)" },
2317 start3 => { -between => [
2319 \["upper(?)", 'stuff' ],
2326 ( start0 BETWEEN ? AND ? )
2327 AND ( start1 BETWEEN ? AND ? )
2328 AND ( start2 BETWEEN lower(x) AND upper(y) )
2329 AND ( start3 BETWEEN lower(x) AND upper(?) )
2331 @bind = (1, 2, 1, 2, 'stuff');
2334 These are the two builtin "special operators"; but the
2335 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2337 =head2 Unary operators: bool
2339 If you wish to test against boolean columns or functions within your
2340 database you can use the C<-bool> and C<-not_bool> operators. For
2341 example to test the column C<is_user> being true and the column
2342 C<is_enabled> being false you would use:-
2346 -not_bool => 'is_enabled',
2351 WHERE is_user AND NOT is_enabled
2353 If a more complex combination is required, testing more conditions,
2354 then you should use the and/or operators:-
2361 -not_bool => 'four',
2367 WHERE one AND two AND three AND NOT four
2370 =head2 Nested conditions, -and/-or prefixes
2372 So far, we've seen how multiple conditions are joined with a top-level
2373 C<AND>. We can change this by putting the different conditions we want in
2374 hashes and then putting those hashes in an array. For example:
2379 status => { -like => ['pending%', 'dispatched'] },
2383 status => 'unassigned',
2387 This data structure would create the following:
2389 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2390 OR ( user = ? AND status = ? ) )";
2391 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2394 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2395 to change the logic inside :
2401 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2402 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2409 WHERE ( user = ? AND (
2410 ( workhrs > ? AND geo = ? )
2411 OR ( workhrs < ? OR geo = ? )
2414 =head3 Algebraic inconsistency, for historical reasons
2416 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2417 operator goes C<outside> of the nested structure; whereas when connecting
2418 several constraints on one column, the C<-and> operator goes
2419 C<inside> the arrayref. Here is an example combining both features :
2422 -and => [a => 1, b => 2],
2423 -or => [c => 3, d => 4],
2424 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2429 WHERE ( ( ( a = ? AND b = ? )
2430 OR ( c = ? OR d = ? )
2431 OR ( e LIKE ? AND e LIKE ? ) ) )
2433 This difference in syntax is unfortunate but must be preserved for
2434 historical reasons. So be careful : the two examples below would
2435 seem algebraically equivalent, but they are not
2437 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2438 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2440 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2441 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2444 =head2 Literal SQL and value type operators
2446 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2447 side" is a column name and the "right side" is a value (normally rendered as
2448 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2449 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2450 alter this behavior. There are several ways of doing so.
2454 This is a virtual operator that signals the string to its right side is an
2455 identifier (a column name) and not a value. For example to compare two
2456 columns you would write:
2459 priority => { '<', 2 },
2460 requestor => { -ident => 'submitter' },
2465 $stmt = "WHERE priority < ? AND requestor = submitter";
2468 If you are maintaining legacy code you may see a different construct as
2469 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2474 This is a virtual operator that signals that the construct to its right side
2475 is a value to be passed to DBI. This is for example necessary when you want
2476 to write a where clause against an array (for RDBMS that support such
2477 datatypes). For example:
2480 array => { -value => [1, 2, 3] }
2485 $stmt = 'WHERE array = ?';
2486 @bind = ([1, 2, 3]);
2488 Note that if you were to simply say:
2494 the result would porbably be not what you wanted:
2496 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2501 Finally, sometimes only literal SQL will do. To include a random snippet
2502 of SQL verbatim, you specify it as a scalar reference. Consider this only
2503 as a last resort. Usually there is a better way. For example:
2506 priority => { '<', 2 },
2507 requestor => { -in => \'(SELECT name FROM hitmen)' },
2512 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2515 Note that in this example, you only get one bind parameter back, since
2516 the verbatim SQL is passed as part of the statement.
2520 Never use untrusted input as a literal SQL argument - this is a massive
2521 security risk (there is no way to check literal snippets for SQL
2522 injections and other nastyness). If you need to deal with untrusted input
2523 use literal SQL with placeholders as described next.
2525 =head3 Literal SQL with placeholders and bind values (subqueries)
2527 If the literal SQL to be inserted has placeholders and bind values,
2528 use a reference to an arrayref (yes this is a double reference --
2529 not so common, but perfectly legal Perl). For example, to find a date
2530 in Postgres you can use something like this:
2533 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2538 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2541 Note that you must pass the bind values in the same format as they are returned
2542 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2543 provide the bind values in the C<< [ column_meta => value ] >> format, where
2544 C<column_meta> is an opaque scalar value; most commonly the column name, but
2545 you can use any scalar value (including references and blessed references),
2546 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2547 to C<columns> the above example will look like:
2550 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2553 Literal SQL is especially useful for nesting parenthesized clauses in the
2554 main SQL query. Here is a first example :
2556 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2560 bar => \["IN ($sub_stmt)" => @sub_bind],
2565 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2566 WHERE c2 < ? AND c3 LIKE ?))";
2567 @bind = (1234, 100, "foo%");
2569 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2570 are expressed in the same way. Of course the C<$sub_stmt> and
2571 its associated bind values can be generated through a former call
2574 my ($sub_stmt, @sub_bind)
2575 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2576 c3 => {-like => "foo%"}});
2579 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2582 In the examples above, the subquery was used as an operator on a column;
2583 but the same principle also applies for a clause within the main C<%where>
2584 hash, like an EXISTS subquery :
2586 my ($sub_stmt, @sub_bind)
2587 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2588 my %where = ( -and => [
2590 \["EXISTS ($sub_stmt)" => @sub_bind],
2595 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2596 WHERE c1 = ? AND c2 > t0.c0))";
2600 Observe that the condition on C<c2> in the subquery refers to
2601 column C<t0.c0> of the main query : this is I<not> a bind
2602 value, so we have to express it through a scalar ref.
2603 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2604 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2605 what we wanted here.
2607 Finally, here is an example where a subquery is used
2608 for expressing unary negation:
2610 my ($sub_stmt, @sub_bind)
2611 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2612 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2614 lname => {like => '%son%'},
2615 \["NOT ($sub_stmt)" => @sub_bind],
2620 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2621 @bind = ('%son%', 10, 20)
2623 =head3 Deprecated usage of Literal SQL
2625 Below are some examples of archaic use of literal SQL. It is shown only as
2626 reference for those who deal with legacy code. Each example has a much
2627 better, cleaner and safer alternative that users should opt for in new code.
2633 my %where = ( requestor => \'IS NOT NULL' )
2635 $stmt = "WHERE requestor IS NOT NULL"
2637 This used to be the way of generating NULL comparisons, before the handling
2638 of C<undef> got formalized. For new code please use the superior syntax as
2639 described in L</Tests for NULL values>.
2643 my %where = ( requestor => \'= submitter' )
2645 $stmt = "WHERE requestor = submitter"
2647 This used to be the only way to compare columns. Use the superior L</-ident>
2648 method for all new code. For example an identifier declared in such a way
2649 will be properly quoted if L</quote_char> is properly set, while the legacy
2650 form will remain as supplied.
2654 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2656 $stmt = "WHERE completed > ? AND is_ready"
2657 @bind = ('2012-12-21')
2659 Using an empty string literal used to be the only way to express a boolean.
2660 For all new code please use the much more readable
2661 L<-bool|/Unary operators: bool> operator.
2667 These pages could go on for a while, since the nesting of the data
2668 structures this module can handle are pretty much unlimited (the
2669 module implements the C<WHERE> expansion as a recursive function
2670 internally). Your best bet is to "play around" with the module a
2671 little to see how the data structures behave, and choose the best
2672 format for your data based on that.
2674 And of course, all the values above will probably be replaced with
2675 variables gotten from forms or the command line. After all, if you
2676 knew everything ahead of time, you wouldn't have to worry about
2677 dynamically-generating SQL and could just hardwire it into your
2680 =head1 ORDER BY CLAUSES
2682 Some functions take an order by clause. This can either be a scalar (just a
2683 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2684 or an array of either of the two previous forms. Examples:
2686 Given | Will Generate
2687 ----------------------------------------------------------
2689 \'colA DESC' | ORDER BY colA DESC
2691 'colA' | ORDER BY colA
2693 [qw/colA colB/] | ORDER BY colA, colB
2695 {-asc => 'colA'} | ORDER BY colA ASC
2697 {-desc => 'colB'} | ORDER BY colB DESC
2699 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2701 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2704 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2705 { -desc => [qw/colB/], | colC ASC, colD ASC
2706 { -asc => [qw/colC colD/],|
2708 ===========================================================
2712 =head1 SPECIAL OPERATORS
2714 my $sqlmaker = SQL::Abstract->new(special_ops => [
2718 my ($self, $field, $op, $arg) = @_;
2724 handler => 'method_name',
2728 A "special operator" is a SQL syntactic clause that can be
2729 applied to a field, instead of a usual binary operator.
2732 WHERE field IN (?, ?, ?)
2733 WHERE field BETWEEN ? AND ?
2734 WHERE MATCH(field) AGAINST (?, ?)
2736 Special operators IN and BETWEEN are fairly standard and therefore
2737 are builtin within C<SQL::Abstract> (as the overridable methods
2738 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2739 like the MATCH .. AGAINST example above which is specific to MySQL,
2740 you can write your own operator handlers - supply a C<special_ops>
2741 argument to the C<new> method. That argument takes an arrayref of
2742 operator definitions; each operator definition is a hashref with two
2749 the regular expression to match the operator
2753 Either a coderef or a plain scalar method name. In both cases
2754 the expected return is C<< ($sql, @bind) >>.
2756 When supplied with a method name, it is simply called on the
2757 L<SQL::Abstract/> object as:
2759 $self->$method_name ($field, $op, $arg)
2763 $op is the part that matched the handler regex
2764 $field is the LHS of the operator
2767 When supplied with a coderef, it is called as:
2769 $coderef->($self, $field, $op, $arg)
2774 For example, here is an implementation
2775 of the MATCH .. AGAINST syntax for MySQL
2777 my $sqlmaker = SQL::Abstract->new(special_ops => [
2779 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2780 {regex => qr/^match$/i,
2782 my ($self, $field, $op, $arg) = @_;
2783 $arg = [$arg] if not ref $arg;
2784 my $label = $self->_quote($field);
2785 my ($placeholder) = $self->_convert('?');
2786 my $placeholders = join ", ", (($placeholder) x @$arg);
2787 my $sql = $self->_sqlcase('match') . " ($label) "
2788 . $self->_sqlcase('against') . " ($placeholders) ";
2789 my @bind = $self->_bindtype($field, @$arg);
2790 return ($sql, @bind);
2797 =head1 UNARY OPERATORS
2799 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2803 my ($self, $op, $arg) = @_;
2809 handler => 'method_name',
2813 A "unary operator" is a SQL syntactic clause that can be
2814 applied to a field - the operator goes before the field
2816 You can write your own operator handlers - supply a C<unary_ops>
2817 argument to the C<new> method. That argument takes an arrayref of
2818 operator definitions; each operator definition is a hashref with two
2825 the regular expression to match the operator
2829 Either a coderef or a plain scalar method name. In both cases
2830 the expected return is C<< $sql >>.
2832 When supplied with a method name, it is simply called on the
2833 L<SQL::Abstract/> object as:
2835 $self->$method_name ($op, $arg)
2839 $op is the part that matched the handler regex
2840 $arg is the RHS or argument of the operator
2842 When supplied with a coderef, it is called as:
2844 $coderef->($self, $op, $arg)
2852 Thanks to some benchmarking by Mark Stosberg, it turns out that
2853 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2854 I must admit this wasn't an intentional design issue, but it's a
2855 byproduct of the fact that you get to control your C<DBI> handles
2858 To maximize performance, use a code snippet like the following:
2860 # prepare a statement handle using the first row
2861 # and then reuse it for the rest of the rows
2863 for my $href (@array_of_hashrefs) {
2864 $stmt ||= $sql->insert('table', $href);
2865 $sth ||= $dbh->prepare($stmt);
2866 $sth->execute($sql->values($href));
2869 The reason this works is because the keys in your C<$href> are sorted
2870 internally by B<SQL::Abstract>. Thus, as long as your data retains
2871 the same structure, you only have to generate the SQL the first time
2872 around. On subsequent queries, simply use the C<values> function provided
2873 by this module to return your values in the correct order.
2875 However this depends on the values having the same type - if, for
2876 example, the values of a where clause may either have values
2877 (resulting in sql of the form C<column = ?> with a single bind
2878 value), or alternatively the values might be C<undef> (resulting in
2879 sql of the form C<column IS NULL> with no bind value) then the
2880 caching technique suggested will not work.
2884 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2885 really like this part (I do, at least). Building up a complex query
2886 can be as simple as the following:
2890 use CGI::FormBuilder;
2893 my $form = CGI::FormBuilder->new(...);
2894 my $sql = SQL::Abstract->new;
2896 if ($form->submitted) {
2897 my $field = $form->field;
2898 my $id = delete $field->{id};
2899 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2902 Of course, you would still have to connect using C<DBI> to run the
2903 query, but the point is that if you make your form look like your
2904 table, the actual query script can be extremely simplistic.
2906 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2907 a fast interface to returning and formatting data. I frequently
2908 use these three modules together to write complex database query
2909 apps in under 50 lines.
2915 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2917 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2923 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2924 Great care has been taken to preserve the I<published> behavior
2925 documented in previous versions in the 1.* family; however,
2926 some features that were previously undocumented, or behaved
2927 differently from the documentation, had to be changed in order
2928 to clarify the semantics. Hence, client code that was relying
2929 on some dark areas of C<SQL::Abstract> v1.*
2930 B<might behave differently> in v1.50.
2932 The main changes are :
2938 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2942 support for the { operator => \"..." } construct (to embed literal SQL)
2946 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2950 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2954 defensive programming : check arguments
2958 fixed bug with global logic, which was previously implemented
2959 through global variables yielding side-effects. Prior versions would
2960 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2961 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2962 Now this is interpreted
2963 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2968 fixed semantics of _bindtype on array args
2972 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2973 we just avoid shifting arrays within that tree.
2977 dropped the C<_modlogic> function
2981 =head1 ACKNOWLEDGEMENTS
2983 There are a number of individuals that have really helped out with
2984 this module. Unfortunately, most of them submitted bugs via CPAN
2985 so I have no idea who they are! But the people I do know are:
2987 Ash Berlin (order_by hash term support)
2988 Matt Trout (DBIx::Class support)
2989 Mark Stosberg (benchmarking)
2990 Chas Owens (initial "IN" operator support)
2991 Philip Collins (per-field SQL functions)
2992 Eric Kolve (hashref "AND" support)
2993 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2994 Dan Kubb (support for "quote_char" and "name_sep")
2995 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2996 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2997 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2998 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2999 Oliver Charles (support for "RETURNING" after "INSERT")
3005 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3009 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3011 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3013 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3014 While not an official support venue, C<DBIx::Class> makes heavy use of
3015 C<SQL::Abstract>, and as such list members there are very familiar with
3016 how to create queries.
3020 This module is free software; you may copy this under the same
3021 terms as perl itself (either the GNU General Public License or
3022 the Artistic License)