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)
14 #======================================================================
16 #======================================================================
18 our $VERSION = '1.72';
20 # This would confuse some packagers
21 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
25 # special operators (-in, -between). May be extended/overridden by user.
26 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
27 my @BUILTIN_SPECIAL_OPS = (
28 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
29 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
30 {regex => qr/^ func $/ix, handler => '_where_field_FUNC'},
31 {regex => qr/^ op $/ix, handler => '_where_op_OP'},
34 # unaryish operators - key maps to handler
35 my @BUILTIN_UNARY_OPS = (
36 # the digits are backcompat stuff
37 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
38 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
39 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
40 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
41 { regex => qr/^ func $/ix, handler => '_where_op_FUNC' },
42 { regex => qr/^ op $/ix, handler => '_where_op_OP' },
45 #======================================================================
46 # DEBUGGING AND ERROR REPORTING
47 #======================================================================
50 return unless $_[0]->{debug}; shift; # a little faster
51 my $func = (caller(1))[3];
52 warn "[$func] ", @_, "\n";
56 my($func) = (caller(1))[3];
57 carp "[$func] Warning: ", @_;
61 my($func) = (caller(1))[3];
62 croak "[$func] Fatal: ", @_;
66 #======================================================================
68 #======================================================================
72 my $class = ref($self) || $self;
73 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
75 # choose our case by keeping an option around
76 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
78 # default logic for interpreting arrayrefs
79 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
81 # how to return bind vars
82 # LDNOTE: changed nwiger code : why this 'delete' ??
83 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
84 $opt{bindtype} ||= 'normal';
86 # default comparison is "=", but can be overridden
89 # try to recognize which are the 'equality' and 'unequality' ops
90 # (temporary quickfix, should go through a more seasoned API)
91 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
92 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
95 $opt{sqltrue} ||= '1=1';
96 $opt{sqlfalse} ||= '0=1';
99 $opt{special_ops} ||= [];
100 # regexes are applied in order, thus push after user-defines
101 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
104 $opt{unary_ops} ||= [];
105 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
107 # rudimentary saniy-check for user supplied bits treated as functions/operators
108 # If a purported function matches this regular expression, an exception is thrown.
109 # Literal SQL is *NOT* subject to this check, only functions (and column names
110 # when quoting is not in effect)
113 # need to guard against ()'s in column names too, but this will break tons of
114 # hacks... ideas anyone?
115 $opt{injection_guard} ||= qr/
121 return bless \%opt, $class;
125 sub _assert_pass_injection_guard {
126 if ($_[1] =~ $_[0]->{injection_guard}) {
127 my $class = ref $_[0];
128 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
129 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
130 . "{injection_guard} attribute to ${class}->new()"
135 #======================================================================
137 #======================================================================
141 my $table = $self->_table(shift);
142 my $data = shift || return;
145 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
146 my ($sql, @bind) = $self->$method($data);
147 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
149 if ($options->{returning}) {
150 my ($s, @b) = $self->_insert_returning ($options);
155 return wantarray ? ($sql, @bind) : $sql;
158 sub _insert_returning {
159 my ($self, $options) = @_;
161 my $f = $options->{returning};
163 my $fieldlist = $self->_SWITCH_refkind($f, {
164 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
165 SCALAR => sub {$self->_quote($f)},
166 SCALARREF => sub {$$f},
168 return $self->_sqlcase(' returning ') . $fieldlist;
171 sub _insert_HASHREF { # explicit list of fields and then values
172 my ($self, $data) = @_;
174 my @fields = sort keys %$data;
176 my ($sql, @bind) = $self->_insert_values($data);
179 $_ = $self->_quote($_) foreach @fields;
180 $sql = "( ".join(", ", @fields).") ".$sql;
182 return ($sql, @bind);
185 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
186 my ($self, $data) = @_;
188 # no names (arrayref) so can't generate bindtype
189 $self->{bindtype} ne 'columns'
190 or belch "can't do 'columns' bindtype when called with arrayref";
192 # fold the list of values into a hash of column name - value pairs
193 # (where the column names are artificially generated, and their
194 # lexicographical ordering keep the ordering of the original list)
195 my $i = "a"; # incremented values will be in lexicographical order
196 my $data_in_hash = { map { ($i++ => $_) } @$data };
198 return $self->_insert_values($data_in_hash);
201 sub _insert_ARRAYREFREF { # literal SQL with bind
202 my ($self, $data) = @_;
204 my ($sql, @bind) = @${$data};
205 $self->_assert_bindval_matches_bindtype(@bind);
207 return ($sql, @bind);
211 sub _insert_SCALARREF { # literal SQL without bind
212 my ($self, $data) = @_;
218 my ($self, $data) = @_;
220 my (@values, @all_bind);
221 foreach my $column (sort keys %$data) {
222 my $v = $data->{$column};
224 $self->_SWITCH_refkind($v, {
227 if ($self->{array_datatypes}) { # if array datatype are activated
229 push @all_bind, $self->_bindtype($column, $v);
231 else { # else literal SQL with bind
232 my ($sql, @bind) = @$v;
233 $self->_assert_bindval_matches_bindtype(@bind);
235 push @all_bind, @bind;
239 ARRAYREFREF => sub { # literal SQL with bind
240 my ($sql, @bind) = @${$v};
241 $self->_assert_bindval_matches_bindtype(@bind);
243 push @all_bind, @bind;
246 # THINK : anything useful to do with a HASHREF ?
247 HASHREF => sub { # (nothing, but old SQLA passed it through)
248 #TODO in SQLA >= 2.0 it will die instead
249 belch "HASH ref as bind value in insert is not supported";
251 push @all_bind, $self->_bindtype($column, $v);
254 SCALARREF => sub { # literal SQL without bind
258 SCALAR_or_UNDEF => sub {
260 push @all_bind, $self->_bindtype($column, $v);
267 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
268 return ($sql, @all_bind);
273 #======================================================================
275 #======================================================================
280 my $table = $self->_table(shift);
281 my $data = shift || return;
284 # first build the 'SET' part of the sql statement
285 my (@set, @all_bind);
286 puke "Unsupported data type specified to \$sql->update"
287 unless ref $data eq 'HASH';
289 for my $k (sort keys %$data) {
292 my $label = $self->_quote($k);
294 $self->_SWITCH_refkind($v, {
296 if ($self->{array_datatypes}) { # array datatype
297 push @set, "$label = ?";
298 push @all_bind, $self->_bindtype($k, $v);
300 else { # literal SQL with bind
301 my ($sql, @bind) = @$v;
302 $self->_assert_bindval_matches_bindtype(@bind);
303 push @set, "$label = $sql";
304 push @all_bind, @bind;
307 ARRAYREFREF => sub { # literal SQL with bind
308 my ($sql, @bind) = @${$v};
309 $self->_assert_bindval_matches_bindtype(@bind);
310 push @set, "$label = $sql";
311 push @all_bind, @bind;
313 SCALARREF => sub { # literal SQL without bind
314 push @set, "$label = $$v";
317 my ($op, $arg, @rest) = %$v;
319 puke 'Operator calls in update must be in the form { -op => $arg }'
320 if (@rest or not $op =~ /^\-(.+)/);
322 local $self->{_nested_func_lhs} = $k;
323 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
325 push @set, "$label = $sql";
326 push @all_bind, @bind;
328 SCALAR_or_UNDEF => sub {
329 push @set, "$label = ?";
330 push @all_bind, $self->_bindtype($k, $v);
336 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
340 my($where_sql, @where_bind) = $self->where($where);
342 push @all_bind, @where_bind;
345 return wantarray ? ($sql, @all_bind) : $sql;
351 #======================================================================
353 #======================================================================
358 my $table = $self->_table(shift);
359 my $fields = shift || '*';
363 my($where_sql, @bind) = $self->where($where, $order);
365 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
367 my $sql = join(' ', $self->_sqlcase('select'), $f,
368 $self->_sqlcase('from'), $table)
371 return wantarray ? ($sql, @bind) : $sql;
374 #======================================================================
376 #======================================================================
381 my $table = $self->_table(shift);
385 my($where_sql, @bind) = $self->where($where);
386 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
388 return wantarray ? ($sql, @bind) : $sql;
392 #======================================================================
394 #======================================================================
398 # Finally, a separate routine just to handle WHERE clauses
400 my ($self, $where, $order) = @_;
403 my ($sql, @bind) = $self->_recurse_where($where);
404 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
408 $sql .= $self->_order_by($order);
411 return wantarray ? ($sql, @bind) : $sql;
416 my ($self, $where, $logic) = @_;
418 # dispatch on appropriate method according to refkind of $where
419 my $method = $self->_METHOD_FOR_refkind("_where", $where);
421 my ($sql, @bind) = $self->$method($where, $logic);
423 # DBIx::Class directly calls _recurse_where in scalar context, so
424 # we must implement it, even if not in the official API
425 return wantarray ? ($sql, @bind) : $sql;
430 #======================================================================
431 # WHERE: top-level ARRAYREF
432 #======================================================================
435 sub _where_ARRAYREF {
436 my ($self, $where, $logic) = @_;
438 $logic = uc($logic || $self->{logic});
439 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
441 my @clauses = @$where;
443 my (@sql_clauses, @all_bind);
444 # need to use while() so can shift() for pairs
445 while (my $el = shift @clauses) {
447 # switch according to kind of $el and get corresponding ($sql, @bind)
448 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
450 # skip empty elements, otherwise get invalid trailing AND stuff
451 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
455 $self->_assert_bindval_matches_bindtype(@b);
459 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
460 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
461 # side-effect: the first hashref within an array would change
462 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
463 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
464 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
466 SCALARREF => sub { ($$el); },
468 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
469 $self->_recurse_where({$el => shift(@clauses)})},
471 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
475 push @sql_clauses, $sql;
476 push @all_bind, @bind;
480 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
483 #======================================================================
484 # WHERE: top-level ARRAYREFREF
485 #======================================================================
487 sub _where_ARRAYREFREF {
488 my ($self, $where) = @_;
489 my ($sql, @bind) = @$$where;
490 $self->_assert_bindval_matches_bindtype(@bind);
491 return ($sql, @bind);
494 #======================================================================
495 # WHERE: top-level HASHREF
496 #======================================================================
499 my ($self, $where) = @_;
500 my (@sql_clauses, @all_bind);
502 for my $k (sort keys %$where) {
503 my $v = $where->{$k};
505 # ($k => $v) is either a special unary op or a regular hashpair
506 my ($sql, @bind) = do {
508 # put the operator in canonical form
510 $op = substr $op, 1; # remove initial dash
511 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
512 $op =~ s/\s+/ /g; # compress whitespace
514 # so that -not_foo works correctly
515 $op =~ s/^not_/NOT /i;
517 $self->_debug("Unary OP(-$op) within hashref, recursing...");
518 my ($s, @b) = $self->_where_unary_op ($op, $v);
520 # top level vs nested
521 # we assume that handled unary ops will take care of their ()s
523 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
525 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
530 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
531 $self->$method($k, $v);
535 push @sql_clauses, $sql;
536 push @all_bind, @bind;
539 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
542 sub _where_unary_op {
543 my ($self, $op, $rhs) = @_;
545 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
546 my $handler = $op_entry->{handler};
548 if (not ref $handler) {
549 if ($op =~ s/ [_\s]? \d+ $//x ) {
550 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
551 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
553 return $self->$handler ($op, $rhs);
555 elsif (ref $handler eq 'CODE') {
556 return $handler->($self, $op, $rhs);
559 puke "Illegal handler for operator $op - expecting a method name or a coderef";
563 $self->debug("Generic unary OP: $op - recursing as function");
565 $self->_assert_pass_injection_guard($op);
567 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
569 puke "Illegal use of top-level '$op'"
570 unless $self->{_nested_func_lhs};
573 $self->_convert('?'),
574 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
578 $self->_recurse_where ($rhs)
582 $sql = sprintf ('%s %s',
583 $self->_sqlcase($op),
587 return ($sql, @bind);
590 sub _where_op_ANDOR {
591 my ($self, $op, $v) = @_;
593 $self->_SWITCH_refkind($v, {
595 return $self->_where_ARRAYREF($v, $op);
599 return ( $op =~ /^or/i )
600 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
601 : $self->_where_HASHREF($v);
605 puke "-$op => \\\$scalar makes little sense, use " .
607 ? '[ \$scalar, \%rest_of_conditions ] instead'
608 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
613 puke "-$op => \\[...] makes little sense, use " .
615 ? '[ \[...], \%rest_of_conditions ] instead'
616 : '-and => [ \[...], \%rest_of_conditions ] instead'
620 SCALAR => sub { # permissively interpreted as SQL
621 puke "-$op => \$value makes little sense, use -bool => \$value instead";
625 puke "-$op => undef not supported";
631 my ($self, $op, $v) = @_;
633 $self->_SWITCH_refkind($v, {
635 SCALAR => sub { # permissively interpreted as SQL
636 belch "literal SQL should be -nest => \\'scalar' "
637 . "instead of -nest => 'scalar' ";
642 puke "-$op => undef not supported";
646 $self->_recurse_where ($v);
654 my ($self, $op, $v) = @_;
656 my ($s, @b) = $self->_SWITCH_refkind($v, {
657 SCALAR => sub { # interpreted as SQL column
658 $self->_convert($self->_quote($v));
662 puke "-$op => undef not supported";
666 $self->_recurse_where ($v);
670 $s = "(NOT $s)" if $op =~ /^not/i;
675 sub _where_hashpair_ARRAYREF {
676 my ($self, $k, $v) = @_;
679 my @v = @$v; # need copy because of shift below
680 $self->_debug("ARRAY($k) means distribute over elements");
682 # put apart first element if it is an operator (-and, -or)
684 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
688 my @distributed = map { {$k => $_} } @v;
691 $self->_debug("OP($op) reinjected into the distributed array");
692 unshift @distributed, $op;
695 my $logic = $op ? substr($op, 1) : '';
697 return $self->_recurse_where(\@distributed, $logic);
700 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
701 $self->_debug("empty ARRAY($k) means 0=1");
702 return ($self->{sqlfalse});
706 sub _where_hashpair_HASHREF {
707 my ($self, $k, $v, $logic) = @_;
710 local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
712 my ($all_sql, @all_bind);
714 for my $orig_op (sort keys %$v) {
715 my $val = $v->{$orig_op};
717 # put the operator in canonical form
720 # FIXME - we need to phase out dash-less ops
721 $op =~ s/^-//; # remove possible initial dash
722 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
723 $op =~ s/\s+/ /g; # compress whitespace
725 $self->_assert_pass_injection_guard($op);
727 # so that -not_foo works correctly
728 $op =~ s/^not_/NOT /i;
732 # CASE: col-value logic modifiers
733 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
734 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
736 # CASE: special operators like -in or -between
737 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
738 my $handler = $special_op->{handler};
740 puke "No handler supplied for special operator $orig_op";
742 elsif (not ref $handler) {
743 ($sql, @bind) = $self->$handler ($k, $op, $val);
745 elsif (ref $handler eq 'CODE') {
746 ($sql, @bind) = $handler->($self, $k, $op, $val);
749 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
753 $self->_SWITCH_refkind($val, {
755 ARRAYREF => sub { # CASE: col => {op => \@vals}
756 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
759 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
760 my ($sub_sql, @sub_bind) = @$$val;
761 $self->_assert_bindval_matches_bindtype(@sub_bind);
762 $sql = join ' ', $self->_convert($self->_quote($k)),
763 $self->_sqlcase($op),
768 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
769 my $is = ($op =~ $self->{equality_op}) ? 'is' :
770 ($op =~ $self->{inequality_op}) ? 'is not' :
771 puke "unexpected operator '$orig_op' with undef operand";
772 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
775 FALLBACK => sub { # CASE: col => {op/func => $stuff}
777 # retain for proper column type bind
778 $self->{_nested_func_lhs} ||= $k;
780 ($sql, @bind) = $self->_where_unary_op ($op, $val);
783 $self->_convert($self->_quote($k)),
784 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
790 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
791 push @all_bind, @bind;
793 return ($all_sql, @all_bind);
798 sub _where_field_op_ARRAYREF {
799 my ($self, $k, $op, $vals) = @_;
801 my @vals = @$vals; #always work on a copy
804 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
806 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
809 # see if the first element is an -and/-or op
811 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
816 # distribute $op over each remaining member of @vals, append logic if exists
817 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
819 # LDNOTE : had planned to change the distribution logic when
820 # $op =~ $self->{inequality_op}, because of Morgan laws :
821 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
822 # WHERE field != 22 OR field != 33 : the user probably means
823 # WHERE field != 22 AND field != 33.
824 # To do this, replace the above to roughly :
825 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
826 # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
830 # try to DWIM on equality operators
831 # LDNOTE : not 100% sure this is the correct thing to do ...
832 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
833 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
836 puke "operator '$op' applied on an empty array (field '$k')";
841 sub _where_hashpair_SCALARREF {
842 my ($self, $k, $v) = @_;
843 $self->_debug("SCALAR($k) means literal SQL: $$v");
844 my $sql = $self->_quote($k) . " " . $$v;
848 # literal SQL with bind
849 sub _where_hashpair_ARRAYREFREF {
850 my ($self, $k, $v) = @_;
851 $self->_debug("REF($k) means literal SQL: @${$v}");
852 my ($sql, @bind) = @$$v;
853 $self->_assert_bindval_matches_bindtype(@bind);
854 $sql = $self->_quote($k) . " " . $sql;
855 return ($sql, @bind );
858 # literal SQL without bind
859 sub _where_hashpair_SCALAR {
860 my ($self, $k, $v) = @_;
861 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
862 my $sql = join ' ', $self->_convert($self->_quote($k)),
863 $self->_sqlcase($self->{cmp}),
864 $self->_convert('?');
865 my @bind = $self->_bindtype($k, $v);
866 return ( $sql, @bind);
870 sub _where_hashpair_UNDEF {
871 my ($self, $k, $v) = @_;
872 $self->_debug("UNDEF($k) means IS NULL");
873 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
877 #======================================================================
878 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
879 #======================================================================
882 sub _where_SCALARREF {
883 my ($self, $where) = @_;
886 $self->_debug("SCALAR(*top) means literal SQL: $$where");
892 my ($self, $where) = @_;
895 $self->_debug("NOREF(*top) means literal SQL: $where");
906 #======================================================================
907 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
908 #======================================================================
911 sub _where_field_BETWEEN {
912 my ($self, $k, $op, $vals) = @_;
914 my ($label, $and, $placeholder);
915 $label = $self->_convert($self->_quote($k));
916 $and = ' ' . $self->_sqlcase('and') . ' ';
917 $placeholder = $self->_convert('?');
918 $op = $self->_sqlcase($op);
920 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
922 my ($s, @b) = @$$vals;
923 $self->_assert_bindval_matches_bindtype(@b);
930 puke "special op 'between' accepts an arrayref with exactly two values"
933 my (@all_sql, @all_bind);
934 foreach my $val (@$vals) {
935 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
937 return ($placeholder, $self->_bindtype($k, $val) );
943 my ($sql, @bind) = @$$val;
944 $self->_assert_bindval_matches_bindtype(@bind);
945 return ($sql, @bind);
948 my ($func, $arg, @rest) = %$val;
949 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
950 if (@rest or $func !~ /^ \- (.+)/x);
951 local $self->{_nested_func_lhs} = $k;
952 $self->_where_unary_op ($1 => $arg);
956 push @all_bind, @bind;
960 (join $and, @all_sql),
965 puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
969 my $sql = "( $label $op $clause )";
973 sub _where_field_FUNC {
974 my ($self, $k, $op, $vals) = @_;
976 return $self->_where_generic_FUNC($k,$vals);
980 my ($self, $k, $vals) = @_;
982 return $self->_where_generic_FUNC('', $vals);
985 sub _where_generic_FUNC {
986 my ($self, $k, $vals) = @_;
988 my $label = $self->_convert($self->_quote($k));
989 my $placeholder = $self->_convert('?');
991 puke '-func must be an array' unless ref $vals eq 'ARRAY';
992 puke 'first arg for -func must be a scalar' unless !ref $vals->[0];
994 my ($func,@rest_of_vals) = @$vals;
996 $self->_assert_pass_injection_guard($func);
998 my (@all_sql, @all_bind);
999 foreach my $val (@rest_of_vals) {
1000 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1002 return ($placeholder, $self->_bindtype($k, $val) );
1007 ARRAYREFREF => sub {
1008 my ($sql, @bind) = @$$val;
1009 $self->_assert_bindval_matches_bindtype(@bind);
1010 return ($sql, @bind);
1013 $self->_recurse_where( $val );
1016 push @all_sql, $sql;
1017 push @all_bind, @bind;
1020 my ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
1022 my $sql = $k ? "( $label = $clause )" : "( $clause )";
1023 return ($sql, @bind)
1032 # $_[1] gets set to "op"
1037 # $_[2] gets set to "op"
1041 my $label = $self->_convert($self->_quote($k));
1042 my $placeholder = $self->_convert('?');
1044 puke 'argument to -op must be an arrayref' unless ref $vals eq 'ARRAY';
1045 puke 'first arg for -op must be a scalar' unless !ref $vals->[0];
1047 my ($op, @rest_of_vals) = @$vals;
1049 $self->_assert_pass_injection_guard($op);
1051 my (@all_sql, @all_bind);
1052 foreach my $val (@rest_of_vals) {
1053 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1055 return ($placeholder, $self->_bindtype($k, $val) );
1060 ARRAYREFREF => sub {
1061 my ($sql, @bind) = @$$val;
1062 $self->_assert_bindval_matches_bindtype(@bind);
1063 return ($sql, @bind);
1066 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
1067 $self->$method('', $val);
1070 push @all_sql, $sql;
1071 push @all_bind, @bind;
1074 my ($clause, @bind) = ((join " $op ", @all_sql), @all_bind);
1076 my $sql = $k ? "( $label = $clause )" : "( $clause )";
1077 return ($sql, @bind)
1080 sub _where_field_IN {
1081 my ($self, $k, $op, $vals) = @_;
1083 # backwards compatibility : if scalar, force into an arrayref
1084 $vals = [$vals] if defined $vals && ! ref $vals;
1086 my ($label) = $self->_convert($self->_quote($k));
1087 my ($placeholder) = $self->_convert('?');
1088 $op = $self->_sqlcase($op);
1090 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1091 ARRAYREF => sub { # list of choices
1092 if (@$vals) { # nonempty list
1093 my (@all_sql, @all_bind);
1095 for my $val (@$vals) {
1096 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1098 return ($placeholder, $val);
1103 ARRAYREFREF => sub {
1104 my ($sql, @bind) = @$$val;
1105 $self->_assert_bindval_matches_bindtype(@bind);
1106 return ($sql, @bind);
1109 my ($func, $arg, @rest) = %$val;
1110 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1111 if (@rest or $func !~ /^ \- (.+)/x);
1112 local $self->{_nested_func_lhs} = $k;
1113 $self->_where_unary_op ($1 => $arg);
1116 return $self->_sqlcase('null');
1119 push @all_sql, $sql;
1120 push @all_bind, @bind;
1124 sprintf ('%s %s ( %s )',
1127 join (', ', @all_sql)
1129 $self->_bindtype($k, @all_bind),
1132 else { # empty list : some databases won't understand "IN ()", so DWIM
1133 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1138 SCALARREF => sub { # literal SQL
1139 my $sql = $self->_open_outer_paren ($$vals);
1140 return ("$label $op ( $sql )");
1142 ARRAYREFREF => sub { # literal SQL with bind
1143 my ($sql, @bind) = @$$vals;
1144 $self->_assert_bindval_matches_bindtype(@bind);
1145 $sql = $self->_open_outer_paren ($sql);
1146 return ("$label $op ( $sql )", @bind);
1150 puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)";
1154 return ($sql, @bind);
1157 # Some databases (SQLite) treat col IN (1, 2) different from
1158 # col IN ( (1, 2) ). Use this to strip all outer parens while
1159 # adding them back in the corresponding method
1160 sub _open_outer_paren {
1161 my ($self, $sql) = @_;
1162 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1167 #======================================================================
1169 #======================================================================
1172 my ($self, $arg) = @_;
1175 for my $c ($self->_order_by_chunks ($arg) ) {
1176 $self->_SWITCH_refkind ($c, {
1177 SCALAR => sub { push @sql, $c },
1178 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1184 $self->_sqlcase(' order by'),
1190 return wantarray ? ($sql, @bind) : $sql;
1193 sub _order_by_chunks {
1194 my ($self, $arg) = @_;
1196 return $self->_SWITCH_refkind($arg, {
1199 map { $self->_order_by_chunks ($_ ) } @$arg;
1202 ARRAYREFREF => sub {
1203 my ($s, @b) = @$$arg;
1204 $self->_assert_bindval_matches_bindtype(@b);
1208 SCALAR => sub {$self->_quote($arg)},
1210 UNDEF => sub {return () },
1212 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1215 # get first pair in hash
1216 my ($key, $val, @rest) = %$arg;
1218 return () unless $key;
1220 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1221 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1227 for my $c ($self->_order_by_chunks ($val)) {
1230 $self->_SWITCH_refkind ($c, {
1235 ($sql, @bind) = @$c;
1239 $sql = $sql . ' ' . $self->_sqlcase($direction);
1241 push @ret, [ $sql, @bind];
1250 #======================================================================
1251 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1252 #======================================================================
1257 $self->_SWITCH_refkind($from, {
1258 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1259 SCALAR => sub {$self->_quote($from)},
1260 SCALARREF => sub {$$from},
1261 ARRAYREFREF => sub {join ', ', @$from;},
1266 #======================================================================
1268 #======================================================================
1270 # highly optimized, as it's called way too often
1272 # my ($self, $label) = @_;
1274 return '' unless defined $_[1];
1275 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1277 unless ($_[0]->{quote_char}) {
1278 $_[0]->_assert_pass_injection_guard($_[1]);
1282 my $qref = ref $_[0]->{quote_char};
1285 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1287 elsif ($qref eq 'ARRAY') {
1288 ($l, $r) = @{$_[0]->{quote_char}};
1291 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1294 # parts containing * are naturally unquoted
1295 return join( $_[0]->{name_sep}||'', map
1296 { $_ eq '*' ? $_ : $l . $_ . $r }
1297 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1302 # Conversion, if applicable
1304 #my ($self, $arg) = @_;
1306 # LDNOTE : modified the previous implementation below because
1307 # it was not consistent : the first "return" is always an array,
1308 # the second "return" is context-dependent. Anyway, _convert
1309 # seems always used with just a single argument, so make it a
1311 # return @_ unless $self->{convert};
1312 # my $conv = $self->_sqlcase($self->{convert});
1313 # my @ret = map { $conv.'('.$_.')' } @_;
1314 # return wantarray ? @ret : $ret[0];
1315 if ($_[0]->{convert}) {
1316 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1323 #my ($self, $col, @vals) = @_;
1325 #LDNOTE : changed original implementation below because it did not make
1326 # sense when bindtype eq 'columns' and @vals > 1.
1327 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1329 # called often - tighten code
1330 return $_[0]->{bindtype} eq 'columns'
1331 ? map {[$_[1], $_]} @_[2 .. $#_]
1336 # Dies if any element of @bind is not in [colname => value] format
1337 # if bindtype is 'columns'.
1338 sub _assert_bindval_matches_bindtype {
1339 # my ($self, @bind) = @_;
1341 if ($self->{bindtype} eq 'columns') {
1343 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1344 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1350 sub _join_sql_clauses {
1351 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1353 if (@$clauses_aref > 1) {
1354 my $join = " " . $self->_sqlcase($logic) . " ";
1355 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1356 return ($sql, @$bind_aref);
1358 elsif (@$clauses_aref) {
1359 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1362 return (); # if no SQL, ignore @$bind_aref
1367 # Fix SQL case, if so requested
1369 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1370 # don't touch the argument ... crooked logic, but let's not change it!
1371 return $_[0]->{case} ? $_[1] : uc($_[1]);
1375 #======================================================================
1376 # DISPATCHING FROM REFKIND
1377 #======================================================================
1380 my ($self, $data) = @_;
1382 return 'UNDEF' unless defined $data;
1384 # blessed objects are treated like scalars
1385 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1387 return 'SCALAR' unless $ref;
1390 while ($ref eq 'REF') {
1392 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1396 return ($ref||'SCALAR') . ('REF' x $n_steps);
1400 my ($self, $data) = @_;
1401 my @try = ($self->_refkind($data));
1402 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1403 push @try, 'FALLBACK';
1407 sub _METHOD_FOR_refkind {
1408 my ($self, $meth_prefix, $data) = @_;
1411 for (@{$self->_try_refkind($data)}) {
1412 $method = $self->can($meth_prefix."_".$_)
1416 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1420 sub _SWITCH_refkind {
1421 my ($self, $data, $dispatch_table) = @_;
1424 for (@{$self->_try_refkind($data)}) {
1425 $coderef = $dispatch_table->{$_}
1429 puke "no dispatch entry for ".$self->_refkind($data)
1438 #======================================================================
1439 # VALUES, GENERATE, AUTOLOAD
1440 #======================================================================
1442 # LDNOTE: original code from nwiger, didn't touch code in that section
1443 # I feel the AUTOLOAD stuff should not be the default, it should
1444 # only be activated on explicit demand by user.
1448 my $data = shift || return;
1449 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1450 unless ref $data eq 'HASH';
1453 foreach my $k ( sort keys %$data ) {
1454 my $v = $data->{$k};
1455 $self->_SWITCH_refkind($v, {
1457 if ($self->{array_datatypes}) { # array datatype
1458 push @all_bind, $self->_bindtype($k, $v);
1460 else { # literal SQL with bind
1461 my ($sql, @bind) = @$v;
1462 $self->_assert_bindval_matches_bindtype(@bind);
1463 push @all_bind, @bind;
1466 ARRAYREFREF => sub { # literal SQL with bind
1467 my ($sql, @bind) = @${$v};
1468 $self->_assert_bindval_matches_bindtype(@bind);
1469 push @all_bind, @bind;
1471 SCALARREF => sub { # literal SQL without bind
1473 SCALAR_or_UNDEF => sub {
1474 push @all_bind, $self->_bindtype($k, $v);
1485 my(@sql, @sqlq, @sqlv);
1489 if ($ref eq 'HASH') {
1490 for my $k (sort keys %$_) {
1493 my $label = $self->_quote($k);
1494 if ($r eq 'ARRAY') {
1495 # literal SQL with bind
1496 my ($sql, @bind) = @$v;
1497 $self->_assert_bindval_matches_bindtype(@bind);
1498 push @sqlq, "$label = $sql";
1500 } elsif ($r eq 'SCALAR') {
1501 # literal SQL without bind
1502 push @sqlq, "$label = $$v";
1504 push @sqlq, "$label = ?";
1505 push @sqlv, $self->_bindtype($k, $v);
1508 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1509 } elsif ($ref eq 'ARRAY') {
1510 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1513 if ($r eq 'ARRAY') { # literal SQL with bind
1514 my ($sql, @bind) = @$v;
1515 $self->_assert_bindval_matches_bindtype(@bind);
1518 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1519 # embedded literal SQL
1526 push @sql, '(' . join(', ', @sqlq) . ')';
1527 } elsif ($ref eq 'SCALAR') {
1531 # strings get case twiddled
1532 push @sql, $self->_sqlcase($_);
1536 my $sql = join ' ', @sql;
1538 # this is pretty tricky
1539 # if ask for an array, return ($stmt, @bind)
1540 # otherwise, s/?/shift @sqlv/ to put it inline
1542 return ($sql, @sqlv);
1544 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1545 ref $d ? $d->[1] : $d/e;
1554 # This allows us to check for a local, then _form, attr
1556 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1557 return $self->generate($name, @_);
1568 SQL::Abstract - Generate SQL from Perl data structures
1574 my $sql = SQL::Abstract->new;
1576 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1578 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1580 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1582 my($stmt, @bind) = $sql->delete($table, \%where);
1584 # Then, use these in your DBI statements
1585 my $sth = $dbh->prepare($stmt);
1586 $sth->execute(@bind);
1588 # Just generate the WHERE clause
1589 my($stmt, @bind) = $sql->where(\%where, \@order);
1591 # Return values in the same order, for hashed queries
1592 # See PERFORMANCE section for more details
1593 my @bind = $sql->values(\%fieldvals);
1597 This module was inspired by the excellent L<DBIx::Abstract>.
1598 However, in using that module I found that what I really wanted
1599 to do was generate SQL, but still retain complete control over my
1600 statement handles and use the DBI interface. So, I set out to
1601 create an abstract SQL generation module.
1603 While based on the concepts used by L<DBIx::Abstract>, there are
1604 several important differences, especially when it comes to WHERE
1605 clauses. I have modified the concepts used to make the SQL easier
1606 to generate from Perl data structures and, IMO, more intuitive.
1607 The underlying idea is for this module to do what you mean, based
1608 on the data structures you provide it. The big advantage is that
1609 you don't have to modify your code every time your data changes,
1610 as this module figures it out.
1612 To begin with, an SQL INSERT is as easy as just specifying a hash
1613 of C<key=value> pairs:
1616 name => 'Jimbo Bobson',
1617 phone => '123-456-7890',
1618 address => '42 Sister Lane',
1619 city => 'St. Louis',
1620 state => 'Louisiana',
1623 The SQL can then be generated with this:
1625 my($stmt, @bind) = $sql->insert('people', \%data);
1627 Which would give you something like this:
1629 $stmt = "INSERT INTO people
1630 (address, city, name, phone, state)
1631 VALUES (?, ?, ?, ?, ?)";
1632 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1633 '123-456-7890', 'Louisiana');
1635 These are then used directly in your DBI code:
1637 my $sth = $dbh->prepare($stmt);
1638 $sth->execute(@bind);
1640 =head2 Inserting and Updating Arrays
1642 If your database has array types (like for example Postgres),
1643 activate the special option C<< array_datatypes => 1 >>
1644 when creating the C<SQL::Abstract> object.
1645 Then you may use an arrayref to insert and update database array types:
1647 my $sql = SQL::Abstract->new(array_datatypes => 1);
1649 planets => [qw/Mercury Venus Earth Mars/]
1652 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1656 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1658 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1661 =head2 Inserting and Updating SQL
1663 In order to apply SQL functions to elements of your C<%data> you may
1664 specify a reference to an arrayref for the given hash value. For example,
1665 if you need to execute the Oracle C<to_date> function on a value, you can
1666 say something like this:
1670 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1673 The first value in the array is the actual SQL. Any other values are
1674 optional and would be included in the bind values array. This gives
1677 my($stmt, @bind) = $sql->insert('people', \%data);
1679 $stmt = "INSERT INTO people (name, date_entered)
1680 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1681 @bind = ('Bill', '03/02/2003');
1683 An UPDATE is just as easy, all you change is the name of the function:
1685 my($stmt, @bind) = $sql->update('people', \%data);
1687 Notice that your C<%data> isn't touched; the module will generate
1688 the appropriately quirky SQL for you automatically. Usually you'll
1689 want to specify a WHERE clause for your UPDATE, though, which is
1690 where handling C<%where> hashes comes in handy...
1692 =head2 Complex where statements
1694 This module can generate pretty complicated WHERE statements
1695 easily. For example, simple C<key=value> pairs are taken to mean
1696 equality, and if you want to see if a field is within a set
1697 of values, you can use an arrayref. Let's say we wanted to
1698 SELECT some data based on this criteria:
1701 requestor => 'inna',
1702 worker => ['nwiger', 'rcwe', 'sfz'],
1703 status => { '!=', 'completed' }
1706 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1708 The above would give you something like this:
1710 $stmt = "SELECT * FROM tickets WHERE
1711 ( requestor = ? ) AND ( status != ? )
1712 AND ( worker = ? OR worker = ? OR worker = ? )";
1713 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1715 Which you could then use in DBI code like so:
1717 my $sth = $dbh->prepare($stmt);
1718 $sth->execute(@bind);
1724 The functions are simple. There's one for each major SQL operation,
1725 and a constructor you use first. The arguments are specified in a
1726 similar order to each function (table, then fields, then a where
1727 clause) to try and simplify things.
1732 =head2 new(option => 'value')
1734 The C<new()> function takes a list of options and values, and returns
1735 a new B<SQL::Abstract> object which can then be used to generate SQL
1736 through the methods below. The options accepted are:
1742 If set to 'lower', then SQL will be generated in all lowercase. By
1743 default SQL is generated in "textbook" case meaning something like:
1745 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1747 Any setting other than 'lower' is ignored.
1751 This determines what the default comparison operator is. By default
1752 it is C<=>, meaning that a hash like this:
1754 %where = (name => 'nwiger', email => 'nate@wiger.org');
1756 Will generate SQL like this:
1758 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1760 However, you may want loose comparisons by default, so if you set
1761 C<cmp> to C<like> you would get SQL such as:
1763 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1765 You can also override the comparsion on an individual basis - see
1766 the huge section on L</"WHERE CLAUSES"> at the bottom.
1768 =item sqltrue, sqlfalse
1770 Expressions for inserting boolean values within SQL statements.
1771 By default these are C<1=1> and C<1=0>. They are used
1772 by the special operators C<-in> and C<-not_in> for generating
1773 correct SQL even when the argument is an empty array (see below).
1777 This determines the default logical operator for multiple WHERE
1778 statements in arrays or hashes. If absent, the default logic is "or"
1779 for arrays, and "and" for hashes. This means that a WHERE
1783 event_date => {'>=', '2/13/99'},
1784 event_date => {'<=', '4/24/03'},
1787 will generate SQL like this:
1789 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1791 This is probably not what you want given this query, though (look
1792 at the dates). To change the "OR" to an "AND", simply specify:
1794 my $sql = SQL::Abstract->new(logic => 'and');
1796 Which will change the above C<WHERE> to:
1798 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1800 The logic can also be changed locally by inserting
1801 a modifier in front of an arrayref :
1803 @where = (-and => [event_date => {'>=', '2/13/99'},
1804 event_date => {'<=', '4/24/03'} ]);
1806 See the L</"WHERE CLAUSES"> section for explanations.
1810 This will automatically convert comparisons using the specified SQL
1811 function for both column and value. This is mostly used with an argument
1812 of C<upper> or C<lower>, so that the SQL will have the effect of
1813 case-insensitive "searches". For example, this:
1815 $sql = SQL::Abstract->new(convert => 'upper');
1816 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1818 Will turn out the following SQL:
1820 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1822 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1823 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1824 not validate this option; it will just pass through what you specify verbatim).
1828 This is a kludge because many databases suck. For example, you can't
1829 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1830 Instead, you have to use C<bind_param()>:
1832 $sth->bind_param(1, 'reg data');
1833 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1835 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1836 which loses track of which field each slot refers to. Fear not.
1838 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1839 Currently, you can specify either C<normal> (default) or C<columns>. If you
1840 specify C<columns>, you will get an array that looks like this:
1842 my $sql = SQL::Abstract->new(bindtype => 'columns');
1843 my($stmt, @bind) = $sql->insert(...);
1846 [ 'column1', 'value1' ],
1847 [ 'column2', 'value2' ],
1848 [ 'column3', 'value3' ],
1851 You can then iterate through this manually, using DBI's C<bind_param()>.
1853 $sth->prepare($stmt);
1856 my($col, $data) = @$_;
1857 if ($col eq 'details' || $col eq 'comments') {
1858 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1859 } elsif ($col eq 'image') {
1860 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1862 $sth->bind_param($i, $data);
1866 $sth->execute; # execute without @bind now
1868 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1869 Basically, the advantage is still that you don't have to care which fields
1870 are or are not included. You could wrap that above C<for> loop in a simple
1871 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1872 get a layer of abstraction over manual SQL specification.
1874 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1875 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1876 will expect the bind values in this format.
1880 This is the character that a table or column name will be quoted
1881 with. By default this is an empty string, but you could set it to
1882 the character C<`>, to generate SQL like this:
1884 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1886 Alternatively, you can supply an array ref of two items, the first being the left
1887 hand quote character, and the second the right hand quote character. For
1888 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1889 that generates SQL like this:
1891 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1893 Quoting is useful if you have tables or columns names that are reserved
1894 words in your database's SQL dialect.
1898 This is the character that separates a table and column name. It is
1899 necessary to specify this when the C<quote_char> option is selected,
1900 so that tables and column names can be individually quoted like this:
1902 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1904 =item injection_guard
1906 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1907 column name specified in a query structure. This is a safety mechanism to avoid
1908 injection attacks when mishandling user input e.g.:
1910 my %condition_as_column_value_pairs = get_values_from_user();
1911 $sqla->select( ... , \%condition_as_column_value_pairs );
1913 If the expression matches an exception is thrown. Note that literal SQL
1914 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1916 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1918 =item array_datatypes
1920 When this option is true, arrayrefs in INSERT or UPDATE are
1921 interpreted as array datatypes and are passed directly
1923 When this option is false, arrayrefs are interpreted
1924 as literal SQL, just like refs to arrayrefs
1925 (but this behavior is for backwards compatibility; when writing
1926 new queries, use the "reference to arrayref" syntax
1932 Takes a reference to a list of "special operators"
1933 to extend the syntax understood by L<SQL::Abstract>.
1934 See section L</"SPECIAL OPERATORS"> for details.
1938 Takes a reference to a list of "unary operators"
1939 to extend the syntax understood by L<SQL::Abstract>.
1940 See section L</"UNARY OPERATORS"> for details.
1946 =head2 insert($table, \@values || \%fieldvals, \%options)
1948 This is the simplest function. You simply give it a table name
1949 and either an arrayref of values or hashref of field/value pairs.
1950 It returns an SQL INSERT statement and a list of bind values.
1951 See the sections on L</"Inserting and Updating Arrays"> and
1952 L</"Inserting and Updating SQL"> for information on how to insert
1953 with those data types.
1955 The optional C<\%options> hash reference may contain additional
1956 options to generate the insert SQL. Currently supported options
1963 Takes either a scalar of raw SQL fields, or an array reference of
1964 field names, and adds on an SQL C<RETURNING> statement at the end.
1965 This allows you to return data generated by the insert statement
1966 (such as row IDs) without performing another C<SELECT> statement.
1967 Note, however, this is not part of the SQL standard and may not
1968 be supported by all database engines.
1972 =head2 update($table, \%fieldvals, \%where)
1974 This takes a table, hashref of field/value pairs, and an optional
1975 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1977 See the sections on L</"Inserting and Updating Arrays"> and
1978 L</"Inserting and Updating SQL"> for information on how to insert
1979 with those data types.
1981 =head2 select($source, $fields, $where, $order)
1983 This returns a SQL SELECT statement and associated list of bind values, as
1984 specified by the arguments :
1990 Specification of the 'FROM' part of the statement.
1991 The argument can be either a plain scalar (interpreted as a table
1992 name, will be quoted), or an arrayref (interpreted as a list
1993 of table names, joined by commas, quoted), or a scalarref
1994 (literal table name, not quoted), or a ref to an arrayref
1995 (list of literal table names, joined by commas, not quoted).
1999 Specification of the list of fields to retrieve from
2001 The argument can be either an arrayref (interpreted as a list
2002 of field names, will be joined by commas and quoted), or a
2003 plain scalar (literal SQL, not quoted).
2004 Please observe that this API is not as flexible as for
2005 the first argument C<$table>, for backwards compatibility reasons.
2009 Optional argument to specify the WHERE part of the query.
2010 The argument is most often a hashref, but can also be
2011 an arrayref or plain scalar --
2012 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2016 Optional argument to specify the ORDER BY part of the query.
2017 The argument can be a scalar, a hashref or an arrayref
2018 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2024 =head2 delete($table, \%where)
2026 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2027 It returns an SQL DELETE statement and list of bind values.
2029 =head2 where(\%where, \@order)
2031 This is used to generate just the WHERE clause. For example,
2032 if you have an arbitrary data structure and know what the
2033 rest of your SQL is going to look like, but want an easy way
2034 to produce a WHERE clause, use this. It returns an SQL WHERE
2035 clause and list of bind values.
2038 =head2 values(\%data)
2040 This just returns the values from the hash C<%data>, in the same
2041 order that would be returned from any of the other above queries.
2042 Using this allows you to markedly speed up your queries if you
2043 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2045 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2047 Warning: This is an experimental method and subject to change.
2049 This returns arbitrarily generated SQL. It's a really basic shortcut.
2050 It will return two different things, depending on return context:
2052 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2053 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2055 These would return the following:
2057 # First calling form
2058 $stmt = "CREATE TABLE test (?, ?)";
2059 @bind = (field1, field2);
2061 # Second calling form
2062 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2064 Depending on what you're trying to do, it's up to you to choose the correct
2065 format. In this example, the second form is what you would want.
2069 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2073 ALTER SESSION SET nls_date_format = 'MM/YY'
2075 You get the idea. Strings get their case twiddled, but everything
2076 else remains verbatim.
2081 =head1 WHERE CLAUSES
2085 This module uses a variation on the idea from L<DBIx::Abstract>. It
2086 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2087 module is that things in arrays are OR'ed, and things in hashes
2090 The easiest way to explain is to show lots of examples. After
2091 each C<%where> hash shown, it is assumed you used:
2093 my($stmt, @bind) = $sql->where(\%where);
2095 However, note that the C<%where> hash can be used directly in any
2096 of the other functions as well, as described above.
2098 =head2 Key-value pairs
2100 So, let's get started. To begin, a simple hash:
2104 status => 'completed'
2107 Is converted to SQL C<key = val> statements:
2109 $stmt = "WHERE user = ? AND status = ?";
2110 @bind = ('nwiger', 'completed');
2112 One common thing I end up doing is having a list of values that
2113 a field can be in. To do this, simply specify a list inside of
2118 status => ['assigned', 'in-progress', 'pending'];
2121 This simple code will create the following:
2123 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2124 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2126 A field associated to an empty arrayref will be considered a
2127 logical false and will generate 0=1.
2129 =head2 Tests for NULL values
2131 If the value part is C<undef> then this is converted to SQL <IS NULL>
2140 $stmt = "WHERE user = ? AND status IS NULL";
2143 =head2 Specific comparison operators
2145 If you want to specify a different type of operator for your comparison,
2146 you can use a hashref for a given column:
2150 status => { '!=', 'completed' }
2153 Which would generate:
2155 $stmt = "WHERE user = ? AND status != ?";
2156 @bind = ('nwiger', 'completed');
2158 To test against multiple values, just enclose the values in an arrayref:
2160 status => { '=', ['assigned', 'in-progress', 'pending'] };
2162 Which would give you:
2164 "WHERE status = ? OR status = ? OR status = ?"
2167 The hashref can also contain multiple pairs, in which case it is expanded
2168 into an C<AND> of its elements:
2172 status => { '!=', 'completed', -not_like => 'pending%' }
2175 # Or more dynamically, like from a form
2176 $where{user} = 'nwiger';
2177 $where{status}{'!='} = 'completed';
2178 $where{status}{'-not_like'} = 'pending%';
2180 # Both generate this
2181 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2182 @bind = ('nwiger', 'completed', 'pending%');
2185 To get an OR instead, you can combine it with the arrayref idea:
2189 priority => [ {'=', 2}, {'!=', 1} ]
2192 Which would generate:
2194 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
2195 @bind = ('nwiger', '2', '1');
2197 If you want to include literal SQL (with or without bind values), just use a
2198 scalar reference or array reference as the value:
2201 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2202 date_expires => { '<' => \"now()" }
2205 Which would generate:
2207 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2208 @bind = ('11/26/2008');
2211 =head2 Logic and nesting operators
2213 In the example above,
2214 there is a subtle trap if you want to say something like
2215 this (notice the C<AND>):
2217 WHERE priority != ? AND priority != ?
2219 Because, in Perl you I<can't> do this:
2221 priority => { '!=', 2, '!=', 1 }
2223 As the second C<!=> key will obliterate the first. The solution
2224 is to use the special C<-modifier> form inside an arrayref:
2226 priority => [ -and => {'!=', 2},
2230 Normally, these would be joined by C<OR>, but the modifier tells it
2231 to use C<AND> instead. (Hint: You can use this in conjunction with the
2232 C<logic> option to C<new()> in order to change the way your queries
2233 work by default.) B<Important:> Note that the C<-modifier> goes
2234 B<INSIDE> the arrayref, as an extra first element. This will
2235 B<NOT> do what you think it might:
2237 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2239 Here is a quick list of equivalencies, since there is some overlap:
2242 status => {'!=', 'completed', 'not like', 'pending%' }
2243 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2246 status => {'=', ['assigned', 'in-progress']}
2247 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2248 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2252 =head2 Special operators : IN, BETWEEN, etc.
2254 You can also use the hashref format to compare a list of fields using the
2255 C<IN> comparison operator, by specifying the list as an arrayref:
2258 status => 'completed',
2259 reportid => { -in => [567, 2335, 2] }
2262 Which would generate:
2264 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2265 @bind = ('completed', '567', '2335', '2');
2267 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2270 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2271 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2272 'sqltrue' (by default : C<1=1>).
2274 In addition to the array you can supply a chunk of literal sql or
2275 literal sql with bind:
2278 customer => { -in => \[
2279 'SELECT cust_id FROM cust WHERE balance > ?',
2282 status => { -in => \'SELECT status_codes FROM states' },
2288 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2289 AND status IN ( SELECT status_codes FROM states )
2295 Another pair of operators is C<-between> and C<-not_between>,
2296 used with an arrayref of two values:
2300 completion_date => {
2301 -not_between => ['2002-10-01', '2003-02-06']
2307 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2309 Just like with C<-in> all plausible combinations of literal SQL
2313 start0 => { -between => [ 1, 2 ] },
2314 start1 => { -between => \["? AND ?", 1, 2] },
2315 start2 => { -between => \"lower(x) AND upper(y)" },
2316 start3 => { -between => [
2318 \["upper(?)", 'stuff' ],
2325 ( start0 BETWEEN ? AND ? )
2326 AND ( start1 BETWEEN ? AND ? )
2327 AND ( start2 BETWEEN lower(x) AND upper(y) )
2328 AND ( start3 BETWEEN lower(x) AND upper(?) )
2330 @bind = (1, 2, 1, 2, 'stuff');
2333 These are the two builtin "special operators"; but the
2334 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2336 Another operator is C<-func> that allows you to call SQL functions with
2337 arguments. It receives an array reference containing the function name
2338 as the 0th argument and the other arguments being its parameters. For example:
2341 -func => ['substr', 'Hello', 50, 5],
2346 $stmt = "WHERE (substr(?,?,?))";
2347 @bind = ("Hello", 50, 5);
2349 Yet another operator is C<-op> that allows you to use SQL operators. It
2350 receives an array reference containing the operator 0th argument and the other
2351 arguments being its operands. For example:
2354 foo => { -op => ['+', \'bar', 50, 5] },
2359 $stmt = "WHERE (foo = bar + ? + ?)";
2362 =head2 Unary operators: bool
2364 If you wish to test against boolean columns or functions within your
2365 database you can use the C<-bool> and C<-not_bool> operators. For
2366 example to test the column C<is_user> being true and the column
2367 C<is_enabled> being false you would use:-
2371 -not_bool => 'is_enabled',
2376 WHERE is_user AND NOT is_enabled
2378 If a more complex combination is required, testing more conditions,
2379 then you should use the and/or operators:-
2386 -not_bool => 'four',
2392 WHERE one AND two AND three AND NOT four
2395 =head2 Nested conditions, -and/-or prefixes
2397 So far, we've seen how multiple conditions are joined with a top-level
2398 C<AND>. We can change this by putting the different conditions we want in
2399 hashes and then putting those hashes in an array. For example:
2404 status => { -like => ['pending%', 'dispatched'] },
2408 status => 'unassigned',
2412 This data structure would create the following:
2414 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2415 OR ( user = ? AND status = ? ) )";
2416 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2419 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2420 to change the logic inside :
2426 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2427 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2434 WHERE ( user = ? AND (
2435 ( workhrs > ? AND geo = ? )
2436 OR ( workhrs < ? OR geo = ? )
2439 =head2 Algebraic inconsistency, for historical reasons
2441 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2442 operator goes C<outside> of the nested structure; whereas when connecting
2443 several constraints on one column, the C<-and> operator goes
2444 C<inside> the arrayref. Here is an example combining both features :
2447 -and => [a => 1, b => 2],
2448 -or => [c => 3, d => 4],
2449 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2454 WHERE ( ( ( a = ? AND b = ? )
2455 OR ( c = ? OR d = ? )
2456 OR ( e LIKE ? AND e LIKE ? ) ) )
2458 This difference in syntax is unfortunate but must be preserved for
2459 historical reasons. So be careful : the two examples below would
2460 seem algebraically equivalent, but they are not
2462 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2463 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2465 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2466 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2471 Finally, sometimes only literal SQL will do. If you want to include
2472 literal SQL verbatim, you can specify it as a scalar reference, namely:
2474 my $inn = 'is Not Null';
2476 priority => { '<', 2 },
2482 $stmt = "WHERE priority < ? AND requestor is Not Null";
2485 Note that in this example, you only get one bind parameter back, since
2486 the verbatim SQL is passed as part of the statement.
2488 Of course, just to prove a point, the above can also be accomplished
2492 priority => { '<', 2 },
2493 requestor => { '!=', undef },
2499 Conditions on boolean columns can be expressed in the same way, passing
2500 a reference to an empty string, however using liternal SQL in this way
2501 is deprecated - the preferred method is to use the boolean operators -
2502 see L</"Unary operators: bool"> :
2505 priority => { '<', 2 },
2511 $stmt = "WHERE priority < ? AND is_ready";
2514 Literal SQL is also the only way to compare 2 columns to one another:
2517 priority => { '<', 2 },
2518 requestor => \'= submittor'
2523 $stmt = "WHERE priority < ? AND requestor = submitter";
2526 =head2 Literal SQL with placeholders and bind values (subqueries)
2528 If the literal SQL to be inserted has placeholders and bind values,
2529 use a reference to an arrayref (yes this is a double reference --
2530 not so common, but perfectly legal Perl). For example, to find a date
2531 in Postgres you can use something like this:
2534 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2539 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2542 Note that you must pass the bind values in the same format as they are returned
2543 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2544 provide the bind values in the C<< [ column_meta => value ] >> format, where
2545 C<column_meta> is an opaque scalar value; most commonly the column name, but
2546 you can use any scalar value (including references and blessed references),
2547 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2548 to C<columns> the above example will look like:
2551 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2554 Literal SQL is especially useful for nesting parenthesized clauses in the
2555 main SQL query. Here is a first example :
2557 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2561 bar => \["IN ($sub_stmt)" => @sub_bind],
2566 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2567 WHERE c2 < ? AND c3 LIKE ?))";
2568 @bind = (1234, 100, "foo%");
2570 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2571 are expressed in the same way. Of course the C<$sub_stmt> and
2572 its associated bind values can be generated through a former call
2575 my ($sub_stmt, @sub_bind)
2576 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2577 c3 => {-like => "foo%"}});
2580 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2583 In the examples above, the subquery was used as an operator on a column;
2584 but the same principle also applies for a clause within the main C<%where>
2585 hash, like an EXISTS subquery :
2587 my ($sub_stmt, @sub_bind)
2588 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2589 my %where = ( -and => [
2591 \["EXISTS ($sub_stmt)" => @sub_bind],
2596 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2597 WHERE c1 = ? AND c2 > t0.c0))";
2601 Observe that the condition on C<c2> in the subquery refers to
2602 column C<t0.c0> of the main query : this is I<not> a bind
2603 value, so we have to express it through a scalar ref.
2604 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2605 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2606 what we wanted here.
2608 Finally, here is an example where a subquery is used
2609 for expressing unary negation:
2611 my ($sub_stmt, @sub_bind)
2612 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2613 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2615 lname => {like => '%son%'},
2616 \["NOT ($sub_stmt)" => @sub_bind],
2621 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2622 @bind = ('%son%', 10, 20)
2628 These pages could go on for a while, since the nesting of the data
2629 structures this module can handle are pretty much unlimited (the
2630 module implements the C<WHERE> expansion as a recursive function
2631 internally). Your best bet is to "play around" with the module a
2632 little to see how the data structures behave, and choose the best
2633 format for your data based on that.
2635 And of course, all the values above will probably be replaced with
2636 variables gotten from forms or the command line. After all, if you
2637 knew everything ahead of time, you wouldn't have to worry about
2638 dynamically-generating SQL and could just hardwire it into your
2644 =head1 ORDER BY CLAUSES
2646 Some functions take an order by clause. This can either be a scalar (just a
2647 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2648 or an array of either of the two previous forms. Examples:
2650 Given | Will Generate
2651 ----------------------------------------------------------
2653 \'colA DESC' | ORDER BY colA DESC
2655 'colA' | ORDER BY colA
2657 [qw/colA colB/] | ORDER BY colA, colB
2659 {-asc => 'colA'} | ORDER BY colA ASC
2661 {-desc => 'colB'} | ORDER BY colB DESC
2663 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2665 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2668 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2669 { -desc => [qw/colB/], | colC ASC, colD ASC
2670 { -asc => [qw/colC colD/],|
2672 ===========================================================
2676 =head1 SPECIAL OPERATORS
2678 my $sqlmaker = SQL::Abstract->new(special_ops => [
2682 my ($self, $field, $op, $arg) = @_;
2688 handler => 'method_name',
2692 A "special operator" is a SQL syntactic clause that can be
2693 applied to a field, instead of a usual binary operator.
2696 WHERE field IN (?, ?, ?)
2697 WHERE field BETWEEN ? AND ?
2698 WHERE MATCH(field) AGAINST (?, ?)
2700 Special operators IN and BETWEEN are fairly standard and therefore
2701 are builtin within C<SQL::Abstract> (as the overridable methods
2702 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2703 like the MATCH .. AGAINST example above which is specific to MySQL,
2704 you can write your own operator handlers - supply a C<special_ops>
2705 argument to the C<new> method. That argument takes an arrayref of
2706 operator definitions; each operator definition is a hashref with two
2713 the regular expression to match the operator
2717 Either a coderef or a plain scalar method name. In both cases
2718 the expected return is C<< ($sql, @bind) >>.
2720 When supplied with a method name, it is simply called on the
2721 L<SQL::Abstract/> object as:
2723 $self->$method_name ($field, $op, $arg)
2727 $op is the part that matched the handler regex
2728 $field is the LHS of the operator
2731 When supplied with a coderef, it is called as:
2733 $coderef->($self, $field, $op, $arg)
2738 For example, here is an implementation
2739 of the MATCH .. AGAINST syntax for MySQL
2741 my $sqlmaker = SQL::Abstract->new(special_ops => [
2743 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2744 {regex => qr/^match$/i,
2746 my ($self, $field, $op, $arg) = @_;
2747 $arg = [$arg] if not ref $arg;
2748 my $label = $self->_quote($field);
2749 my ($placeholder) = $self->_convert('?');
2750 my $placeholders = join ", ", (($placeholder) x @$arg);
2751 my $sql = $self->_sqlcase('match') . " ($label) "
2752 . $self->_sqlcase('against') . " ($placeholders) ";
2753 my @bind = $self->_bindtype($field, @$arg);
2754 return ($sql, @bind);
2761 =head1 UNARY OPERATORS
2763 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2767 my ($self, $op, $arg) = @_;
2773 handler => 'method_name',
2777 A "unary operator" is a SQL syntactic clause that can be
2778 applied to a field - the operator goes before the field
2780 You can write your own operator handlers - supply a C<unary_ops>
2781 argument to the C<new> method. That argument takes an arrayref of
2782 operator definitions; each operator definition is a hashref with two
2789 the regular expression to match the operator
2793 Either a coderef or a plain scalar method name. In both cases
2794 the expected return is C<< $sql >>.
2796 When supplied with a method name, it is simply called on the
2797 L<SQL::Abstract/> object as:
2799 $self->$method_name ($op, $arg)
2803 $op is the part that matched the handler regex
2804 $arg is the RHS or argument of the operator
2806 When supplied with a coderef, it is called as:
2808 $coderef->($self, $op, $arg)
2816 Thanks to some benchmarking by Mark Stosberg, it turns out that
2817 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2818 I must admit this wasn't an intentional design issue, but it's a
2819 byproduct of the fact that you get to control your C<DBI> handles
2822 To maximize performance, use a code snippet like the following:
2824 # prepare a statement handle using the first row
2825 # and then reuse it for the rest of the rows
2827 for my $href (@array_of_hashrefs) {
2828 $stmt ||= $sql->insert('table', $href);
2829 $sth ||= $dbh->prepare($stmt);
2830 $sth->execute($sql->values($href));
2833 The reason this works is because the keys in your C<$href> are sorted
2834 internally by B<SQL::Abstract>. Thus, as long as your data retains
2835 the same structure, you only have to generate the SQL the first time
2836 around. On subsequent queries, simply use the C<values> function provided
2837 by this module to return your values in the correct order.
2839 However this depends on the values having the same type - if, for
2840 example, the values of a where clause may either have values
2841 (resulting in sql of the form C<column = ?> with a single bind
2842 value), or alternatively the values might be C<undef> (resulting in
2843 sql of the form C<column IS NULL> with no bind value) then the
2844 caching technique suggested will not work.
2848 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2849 really like this part (I do, at least). Building up a complex query
2850 can be as simple as the following:
2854 use CGI::FormBuilder;
2857 my $form = CGI::FormBuilder->new(...);
2858 my $sql = SQL::Abstract->new;
2860 if ($form->submitted) {
2861 my $field = $form->field;
2862 my $id = delete $field->{id};
2863 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2866 Of course, you would still have to connect using C<DBI> to run the
2867 query, but the point is that if you make your form look like your
2868 table, the actual query script can be extremely simplistic.
2870 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2871 a fast interface to returning and formatting data. I frequently
2872 use these three modules together to write complex database query
2873 apps in under 50 lines.
2879 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class.git>
2881 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/DBIx-Class.git>
2887 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2888 Great care has been taken to preserve the I<published> behavior
2889 documented in previous versions in the 1.* family; however,
2890 some features that were previously undocumented, or behaved
2891 differently from the documentation, had to be changed in order
2892 to clarify the semantics. Hence, client code that was relying
2893 on some dark areas of C<SQL::Abstract> v1.*
2894 B<might behave differently> in v1.50.
2896 The main changes are :
2902 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2906 support for the { operator => \"..." } construct (to embed literal SQL)
2910 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2914 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2918 defensive programming : check arguments
2922 fixed bug with global logic, which was previously implemented
2923 through global variables yielding side-effects. Prior versions would
2924 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2925 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2926 Now this is interpreted
2927 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2932 fixed semantics of _bindtype on array args
2936 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2937 we just avoid shifting arrays within that tree.
2941 dropped the C<_modlogic> function
2947 =head1 ACKNOWLEDGEMENTS
2949 There are a number of individuals that have really helped out with
2950 this module. Unfortunately, most of them submitted bugs via CPAN
2951 so I have no idea who they are! But the people I do know are:
2953 Ash Berlin (order_by hash term support)
2954 Matt Trout (DBIx::Class support)
2955 Mark Stosberg (benchmarking)
2956 Chas Owens (initial "IN" operator support)
2957 Philip Collins (per-field SQL functions)
2958 Eric Kolve (hashref "AND" support)
2959 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2960 Dan Kubb (support for "quote_char" and "name_sep")
2961 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2962 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2963 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2964 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2965 Oliver Charles (support for "RETURNING" after "INSERT")
2971 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2975 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2977 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2979 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2980 While not an official support venue, C<DBIx::Class> makes heavy use of
2981 C<SQL::Abstract>, and as such list members there are very familiar with
2982 how to create queries.
2986 This module is free software; you may copy this under the same
2987 terms as perl itself (either the GNU General Public License or
2988 the Artistic License)