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'},
33 # unaryish operators - key maps to handler
34 my @BUILTIN_UNARY_OPS = (
35 # the digits are backcompat stuff
36 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
37 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
38 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
39 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
40 { regex => qr/^ func $/ix, handler => '_where_op_FUNC' },
43 #======================================================================
44 # DEBUGGING AND ERROR REPORTING
45 #======================================================================
48 return unless $_[0]->{debug}; shift; # a little faster
49 my $func = (caller(1))[3];
50 warn "[$func] ", @_, "\n";
54 my($func) = (caller(1))[3];
55 carp "[$func] Warning: ", @_;
59 my($func) = (caller(1))[3];
60 croak "[$func] Fatal: ", @_;
64 #======================================================================
66 #======================================================================
70 my $class = ref($self) || $self;
71 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
73 # choose our case by keeping an option around
74 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
76 # default logic for interpreting arrayrefs
77 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
79 # how to return bind vars
80 # LDNOTE: changed nwiger code : why this 'delete' ??
81 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
82 $opt{bindtype} ||= 'normal';
84 # default comparison is "=", but can be overridden
87 # try to recognize which are the 'equality' and 'unequality' ops
88 # (temporary quickfix, should go through a more seasoned API)
89 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
90 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
93 $opt{sqltrue} ||= '1=1';
94 $opt{sqlfalse} ||= '0=1';
97 $opt{special_ops} ||= [];
98 # regexes are applied in order, thus push after user-defines
99 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
102 $opt{unary_ops} ||= [];
103 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
105 # rudimentary saniy-check for user supplied bits treated as functions/operators
106 # If a purported function matches this regular expression, an exception is thrown.
107 # Literal SQL is *NOT* subject to this check, only functions (and column names
108 # when quoting is not in effect)
111 # need to guard against ()'s in column names too, but this will break tons of
112 # hacks... ideas anyone?
113 $opt{injection_guard} ||= qr/
119 return bless \%opt, $class;
123 sub _assert_pass_injection_guard {
124 if ($_[1] =~ $_[0]->{injection_guard}) {
125 my $class = ref $_[0];
126 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
127 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
128 . "{injection_guard} attribute to ${class}->new()"
133 #======================================================================
135 #======================================================================
139 my $table = $self->_table(shift);
140 my $data = shift || return;
143 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
144 my ($sql, @bind) = $self->$method($data);
145 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
147 if ($options->{returning}) {
148 my ($s, @b) = $self->_insert_returning ($options);
153 return wantarray ? ($sql, @bind) : $sql;
156 sub _insert_returning {
157 my ($self, $options) = @_;
159 my $f = $options->{returning};
161 my $fieldlist = $self->_SWITCH_refkind($f, {
162 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
163 SCALAR => sub {$self->_quote($f)},
164 SCALARREF => sub {$$f},
166 return $self->_sqlcase(' returning ') . $fieldlist;
169 sub _insert_HASHREF { # explicit list of fields and then values
170 my ($self, $data) = @_;
172 my @fields = sort keys %$data;
174 my ($sql, @bind) = $self->_insert_values($data);
177 $_ = $self->_quote($_) foreach @fields;
178 $sql = "( ".join(", ", @fields).") ".$sql;
180 return ($sql, @bind);
183 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
184 my ($self, $data) = @_;
186 # no names (arrayref) so can't generate bindtype
187 $self->{bindtype} ne 'columns'
188 or belch "can't do 'columns' bindtype when called with arrayref";
190 # fold the list of values into a hash of column name - value pairs
191 # (where the column names are artificially generated, and their
192 # lexicographical ordering keep the ordering of the original list)
193 my $i = "a"; # incremented values will be in lexicographical order
194 my $data_in_hash = { map { ($i++ => $_) } @$data };
196 return $self->_insert_values($data_in_hash);
199 sub _insert_ARRAYREFREF { # literal SQL with bind
200 my ($self, $data) = @_;
202 my ($sql, @bind) = @${$data};
203 $self->_assert_bindval_matches_bindtype(@bind);
205 return ($sql, @bind);
209 sub _insert_SCALARREF { # literal SQL without bind
210 my ($self, $data) = @_;
216 my ($self, $data) = @_;
218 my (@values, @all_bind);
219 foreach my $column (sort keys %$data) {
220 my $v = $data->{$column};
222 $self->_SWITCH_refkind($v, {
225 if ($self->{array_datatypes}) { # if array datatype are activated
227 push @all_bind, $self->_bindtype($column, $v);
229 else { # else literal SQL with bind
230 my ($sql, @bind) = @$v;
231 $self->_assert_bindval_matches_bindtype(@bind);
233 push @all_bind, @bind;
237 ARRAYREFREF => sub { # literal SQL with bind
238 my ($sql, @bind) = @${$v};
239 $self->_assert_bindval_matches_bindtype(@bind);
241 push @all_bind, @bind;
244 # THINK : anything useful to do with a HASHREF ?
245 HASHREF => sub { # (nothing, but old SQLA passed it through)
246 #TODO in SQLA >= 2.0 it will die instead
247 belch "HASH ref as bind value in insert is not supported";
249 push @all_bind, $self->_bindtype($column, $v);
252 SCALARREF => sub { # literal SQL without bind
256 SCALAR_or_UNDEF => sub {
258 push @all_bind, $self->_bindtype($column, $v);
265 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
266 return ($sql, @all_bind);
271 #======================================================================
273 #======================================================================
278 my $table = $self->_table(shift);
279 my $data = shift || return;
282 # first build the 'SET' part of the sql statement
283 my (@set, @all_bind);
284 puke "Unsupported data type specified to \$sql->update"
285 unless ref $data eq 'HASH';
287 for my $k (sort keys %$data) {
290 my $label = $self->_quote($k);
292 $self->_SWITCH_refkind($v, {
294 if ($self->{array_datatypes}) { # array datatype
295 push @set, "$label = ?";
296 push @all_bind, $self->_bindtype($k, $v);
298 else { # literal SQL with bind
299 my ($sql, @bind) = @$v;
300 $self->_assert_bindval_matches_bindtype(@bind);
301 push @set, "$label = $sql";
302 push @all_bind, @bind;
305 ARRAYREFREF => sub { # literal SQL with bind
306 my ($sql, @bind) = @${$v};
307 $self->_assert_bindval_matches_bindtype(@bind);
308 push @set, "$label = $sql";
309 push @all_bind, @bind;
311 SCALARREF => sub { # literal SQL without bind
312 push @set, "$label = $$v";
315 my ($op, $arg, @rest) = %$v;
317 puke 'Operator calls in update must be in the form { -op => $arg }'
318 if (@rest or not $op =~ /^\-(.+)/);
320 local $self->{_nested_func_lhs} = $k;
321 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
323 push @set, "$label = $sql";
324 push @all_bind, @bind;
326 SCALAR_or_UNDEF => sub {
327 push @set, "$label = ?";
328 push @all_bind, $self->_bindtype($k, $v);
334 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
338 my($where_sql, @where_bind) = $self->where($where);
340 push @all_bind, @where_bind;
343 return wantarray ? ($sql, @all_bind) : $sql;
349 #======================================================================
351 #======================================================================
356 my $table = $self->_table(shift);
357 my $fields = shift || '*';
361 my($where_sql, @bind) = $self->where($where, $order);
363 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
365 my $sql = join(' ', $self->_sqlcase('select'), $f,
366 $self->_sqlcase('from'), $table)
369 return wantarray ? ($sql, @bind) : $sql;
372 #======================================================================
374 #======================================================================
379 my $table = $self->_table(shift);
383 my($where_sql, @bind) = $self->where($where);
384 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
386 return wantarray ? ($sql, @bind) : $sql;
390 #======================================================================
392 #======================================================================
396 # Finally, a separate routine just to handle WHERE clauses
398 my ($self, $where, $order) = @_;
401 my ($sql, @bind) = $self->_recurse_where($where);
402 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
406 $sql .= $self->_order_by($order);
409 return wantarray ? ($sql, @bind) : $sql;
414 my ($self, $where, $logic) = @_;
416 # dispatch on appropriate method according to refkind of $where
417 my $method = $self->_METHOD_FOR_refkind("_where", $where);
419 my ($sql, @bind) = $self->$method($where, $logic);
421 # DBIx::Class directly calls _recurse_where in scalar context, so
422 # we must implement it, even if not in the official API
423 return wantarray ? ($sql, @bind) : $sql;
428 #======================================================================
429 # WHERE: top-level ARRAYREF
430 #======================================================================
433 sub _where_ARRAYREF {
434 my ($self, $where, $logic) = @_;
436 $logic = uc($logic || $self->{logic});
437 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
439 my @clauses = @$where;
441 my (@sql_clauses, @all_bind);
442 # need to use while() so can shift() for pairs
443 while (my $el = shift @clauses) {
445 # switch according to kind of $el and get corresponding ($sql, @bind)
446 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
448 # skip empty elements, otherwise get invalid trailing AND stuff
449 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
453 $self->_assert_bindval_matches_bindtype(@b);
457 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
458 # LDNOTE : previous SQLA code for hashrefs was creating a dirty
459 # side-effect: the first hashref within an array would change
460 # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
461 # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
462 # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
464 SCALARREF => sub { ($$el); },
466 SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
467 $self->_recurse_where({$el => shift(@clauses)})},
469 UNDEF => sub {puke "not supported : UNDEF in arrayref" },
473 push @sql_clauses, $sql;
474 push @all_bind, @bind;
478 return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
481 #======================================================================
482 # WHERE: top-level ARRAYREFREF
483 #======================================================================
485 sub _where_ARRAYREFREF {
486 my ($self, $where) = @_;
487 my ($sql, @bind) = @$$where;
488 $self->_assert_bindval_matches_bindtype(@bind);
489 return ($sql, @bind);
492 #======================================================================
493 # WHERE: top-level HASHREF
494 #======================================================================
497 my ($self, $where) = @_;
498 my (@sql_clauses, @all_bind);
500 for my $k (sort keys %$where) {
501 my $v = $where->{$k};
503 # ($k => $v) is either a special unary op or a regular hashpair
504 my ($sql, @bind) = do {
506 # put the operator in canonical form
508 $op = substr $op, 1; # remove initial dash
509 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
510 $op =~ s/\s+/ /g; # compress whitespace
512 # so that -not_foo works correctly
513 $op =~ s/^not_/NOT /i;
515 $self->_debug("Unary OP(-$op) within hashref, recursing...");
516 my ($s, @b) = $self->_where_unary_op ($op, $v);
518 # top level vs nested
519 # we assume that handled unary ops will take care of their ()s
521 List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
523 defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
528 my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
529 $self->$method($k, $v);
533 push @sql_clauses, $sql;
534 push @all_bind, @bind;
537 return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
540 sub _where_unary_op {
541 my ($self, $op, $rhs) = @_;
543 if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
544 my $handler = $op_entry->{handler};
546 if (not ref $handler) {
547 if ($op =~ s/ [_\s]? \d+ $//x ) {
548 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
549 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
551 return $self->$handler ($op, $rhs);
553 elsif (ref $handler eq 'CODE') {
554 return $handler->($self, $op, $rhs);
557 puke "Illegal handler for operator $op - expecting a method name or a coderef";
561 $self->debug("Generic unary OP: $op - recursing as function");
563 $self->_assert_pass_injection_guard($op);
565 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
567 puke "Illegal use of top-level '$op'"
568 unless $self->{_nested_func_lhs};
571 $self->_convert('?'),
572 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
576 $self->_recurse_where ($rhs)
580 $sql = sprintf ('%s %s',
581 $self->_sqlcase($op),
585 return ($sql, @bind);
588 sub _where_op_ANDOR {
589 my ($self, $op, $v) = @_;
591 $self->_SWITCH_refkind($v, {
593 return $self->_where_ARRAYREF($v, $op);
597 return ( $op =~ /^or/i )
598 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
599 : $self->_where_HASHREF($v);
603 puke "-$op => \\\$scalar makes little sense, use " .
605 ? '[ \$scalar, \%rest_of_conditions ] instead'
606 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
611 puke "-$op => \\[...] makes little sense, use " .
613 ? '[ \[...], \%rest_of_conditions ] instead'
614 : '-and => [ \[...], \%rest_of_conditions ] instead'
618 SCALAR => sub { # permissively interpreted as SQL
619 puke "-$op => \$value makes little sense, use -bool => \$value instead";
623 puke "-$op => undef not supported";
629 my ($self, $op, $v) = @_;
631 $self->_SWITCH_refkind($v, {
633 SCALAR => sub { # permissively interpreted as SQL
634 belch "literal SQL should be -nest => \\'scalar' "
635 . "instead of -nest => 'scalar' ";
640 puke "-$op => undef not supported";
644 $self->_recurse_where ($v);
652 my ($self, $op, $v) = @_;
654 my ($s, @b) = $self->_SWITCH_refkind($v, {
655 SCALAR => sub { # interpreted as SQL column
656 $self->_convert($self->_quote($v));
660 puke "-$op => undef not supported";
664 $self->_recurse_where ($v);
668 $s = "(NOT $s)" if $op =~ /^not/i;
673 sub _where_hashpair_ARRAYREF {
674 my ($self, $k, $v) = @_;
677 my @v = @$v; # need copy because of shift below
678 $self->_debug("ARRAY($k) means distribute over elements");
680 # put apart first element if it is an operator (-and, -or)
682 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
686 my @distributed = map { {$k => $_} } @v;
689 $self->_debug("OP($op) reinjected into the distributed array");
690 unshift @distributed, $op;
693 my $logic = $op ? substr($op, 1) : '';
695 return $self->_recurse_where(\@distributed, $logic);
698 # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
699 $self->_debug("empty ARRAY($k) means 0=1");
700 return ($self->{sqlfalse});
704 sub _where_hashpair_HASHREF {
705 my ($self, $k, $v, $logic) = @_;
708 local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
710 my ($all_sql, @all_bind);
712 for my $orig_op (sort keys %$v) {
713 my $val = $v->{$orig_op};
715 # put the operator in canonical form
718 # FIXME - we need to phase out dash-less ops
719 $op =~ s/^-//; # remove possible initial dash
720 $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
721 $op =~ s/\s+/ /g; # compress whitespace
723 $self->_assert_pass_injection_guard($op);
725 # so that -not_foo works correctly
726 $op =~ s/^not_/NOT /i;
730 # CASE: col-value logic modifiers
731 if ( $orig_op =~ /^ \- (and|or) $/xi ) {
732 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
734 # CASE: special operators like -in or -between
735 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
736 my $handler = $special_op->{handler};
738 puke "No handler supplied for special operator $orig_op";
740 elsif (not ref $handler) {
741 ($sql, @bind) = $self->$handler ($k, $op, $val);
743 elsif (ref $handler eq 'CODE') {
744 ($sql, @bind) = $handler->($self, $k, $op, $val);
747 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
751 $self->_SWITCH_refkind($val, {
753 ARRAYREF => sub { # CASE: col => {op => \@vals}
754 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
757 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
758 my ($sub_sql, @sub_bind) = @$$val;
759 $self->_assert_bindval_matches_bindtype(@sub_bind);
760 $sql = join ' ', $self->_convert($self->_quote($k)),
761 $self->_sqlcase($op),
766 UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
767 my $is = ($op =~ $self->{equality_op}) ? 'is' :
768 ($op =~ $self->{inequality_op}) ? 'is not' :
769 puke "unexpected operator '$orig_op' with undef operand";
770 $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
773 FALLBACK => sub { # CASE: col => {op/func => $stuff}
775 # retain for proper column type bind
776 $self->{_nested_func_lhs} ||= $k;
778 ($sql, @bind) = $self->_where_unary_op ($op, $val);
781 $self->_convert($self->_quote($k)),
782 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
788 ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
789 push @all_bind, @bind;
791 return ($all_sql, @all_bind);
796 sub _where_field_op_ARRAYREF {
797 my ($self, $k, $op, $vals) = @_;
799 my @vals = @$vals; #always work on a copy
802 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
804 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
807 # see if the first element is an -and/-or op
809 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
814 # distribute $op over each remaining member of @vals, append logic if exists
815 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
817 # LDNOTE : had planned to change the distribution logic when
818 # $op =~ $self->{inequality_op}, because of Morgan laws :
819 # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
820 # WHERE field != 22 OR field != 33 : the user probably means
821 # WHERE field != 22 AND field != 33.
822 # To do this, replace the above to roughly :
823 # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
824 # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
828 # try to DWIM on equality operators
829 # LDNOTE : not 100% sure this is the correct thing to do ...
830 return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
831 return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
834 puke "operator '$op' applied on an empty array (field '$k')";
839 sub _where_hashpair_SCALARREF {
840 my ($self, $k, $v) = @_;
841 $self->_debug("SCALAR($k) means literal SQL: $$v");
842 my $sql = $self->_quote($k) . " " . $$v;
846 # literal SQL with bind
847 sub _where_hashpair_ARRAYREFREF {
848 my ($self, $k, $v) = @_;
849 $self->_debug("REF($k) means literal SQL: @${$v}");
850 my ($sql, @bind) = @$$v;
851 $self->_assert_bindval_matches_bindtype(@bind);
852 $sql = $self->_quote($k) . " " . $sql;
853 return ($sql, @bind );
856 # literal SQL without bind
857 sub _where_hashpair_SCALAR {
858 my ($self, $k, $v) = @_;
859 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
860 my $sql = join ' ', $self->_convert($self->_quote($k)),
861 $self->_sqlcase($self->{cmp}),
862 $self->_convert('?');
863 my @bind = $self->_bindtype($k, $v);
864 return ( $sql, @bind);
868 sub _where_hashpair_UNDEF {
869 my ($self, $k, $v) = @_;
870 $self->_debug("UNDEF($k) means IS NULL");
871 my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
875 #======================================================================
876 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
877 #======================================================================
880 sub _where_SCALARREF {
881 my ($self, $where) = @_;
884 $self->_debug("SCALAR(*top) means literal SQL: $$where");
890 my ($self, $where) = @_;
893 $self->_debug("NOREF(*top) means literal SQL: $where");
904 #======================================================================
905 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
906 #======================================================================
909 sub _where_field_BETWEEN {
910 my ($self, $k, $op, $vals) = @_;
912 my ($label, $and, $placeholder);
913 $label = $self->_convert($self->_quote($k));
914 $and = ' ' . $self->_sqlcase('and') . ' ';
915 $placeholder = $self->_convert('?');
916 $op = $self->_sqlcase($op);
918 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
920 my ($s, @b) = @$$vals;
921 $self->_assert_bindval_matches_bindtype(@b);
928 puke "special op 'between' accepts an arrayref with exactly two values"
931 my (@all_sql, @all_bind);
932 foreach my $val (@$vals) {
933 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
935 return ($placeholder, $self->_bindtype($k, $val) );
941 my ($sql, @bind) = @$$val;
942 $self->_assert_bindval_matches_bindtype(@bind);
943 return ($sql, @bind);
946 my ($func, $arg, @rest) = %$val;
947 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
948 if (@rest or $func !~ /^ \- (.+)/x);
949 local $self->{_nested_func_lhs} = $k;
950 $self->_where_unary_op ($1 => $arg);
954 push @all_bind, @bind;
958 (join $and, @all_sql),
963 puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
967 my $sql = "( $label $op $clause )";
971 sub _where_field_FUNC {
972 my ($self, $k, $op, $vals) = @_;
974 return $self->_where_generic_FUNC($k,$vals);
978 my ($self, $k, $vals) = @_;
980 return $self->_where_generic_FUNC('', $vals);
983 sub _where_generic_FUNC {
984 my ($self, $k, $vals) = @_;
986 my $label = $self->_convert($self->_quote($k));
987 my $placeholder = $self->_convert('?');
988 my $error = "special op 'func' accepts an arrayref with more than one value.";
990 puke '-func must be an array' unless ref $vals eq 'ARRAY';
991 puke 'first arg for -func must be a scalar' unless !ref $vals->[0];
993 my ($func,@rest_of_vals) = @$vals;
995 $self->_assert_pass_injection_guard($func);
997 my (@all_sql, @all_bind);
998 foreach my $val (@rest_of_vals) {
999 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1001 return ($placeholder, $self->_bindtype($k, $val) );
1006 ARRAYREFREF => sub {
1007 my ($sql, @bind) = @$$val;
1008 $self->_assert_bindval_matches_bindtype(@bind);
1009 return ($sql, @bind);
1012 $self->_recurse_where( $val );
1015 push @all_sql, $sql;
1016 push @all_bind, @bind;
1019 my ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
1021 my $sql = $k ? "( $label = $clause )" : "( $clause )";
1022 return ($sql, @bind)
1025 sub _where_field_IN {
1026 my ($self, $k, $op, $vals) = @_;
1028 # backwards compatibility : if scalar, force into an arrayref
1029 $vals = [$vals] if defined $vals && ! ref $vals;
1031 my ($label) = $self->_convert($self->_quote($k));
1032 my ($placeholder) = $self->_convert('?');
1033 $op = $self->_sqlcase($op);
1035 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1036 ARRAYREF => sub { # list of choices
1037 if (@$vals) { # nonempty list
1038 my (@all_sql, @all_bind);
1040 for my $val (@$vals) {
1041 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1043 return ($placeholder, $val);
1048 ARRAYREFREF => sub {
1049 my ($sql, @bind) = @$$val;
1050 $self->_assert_bindval_matches_bindtype(@bind);
1051 return ($sql, @bind);
1054 my ($func, $arg, @rest) = %$val;
1055 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1056 if (@rest or $func !~ /^ \- (.+)/x);
1057 local $self->{_nested_func_lhs} = $k;
1058 $self->_where_unary_op ($1 => $arg);
1061 return $self->_sqlcase('null');
1064 push @all_sql, $sql;
1065 push @all_bind, @bind;
1069 sprintf ('%s %s ( %s )',
1072 join (', ', @all_sql)
1074 $self->_bindtype($k, @all_bind),
1077 else { # empty list : some databases won't understand "IN ()", so DWIM
1078 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1083 SCALARREF => sub { # literal SQL
1084 my $sql = $self->_open_outer_paren ($$vals);
1085 return ("$label $op ( $sql )");
1087 ARRAYREFREF => sub { # literal SQL with bind
1088 my ($sql, @bind) = @$$vals;
1089 $self->_assert_bindval_matches_bindtype(@bind);
1090 $sql = $self->_open_outer_paren ($sql);
1091 return ("$label $op ( $sql )", @bind);
1095 puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)";
1099 return ($sql, @bind);
1102 # Some databases (SQLite) treat col IN (1, 2) different from
1103 # col IN ( (1, 2) ). Use this to strip all outer parens while
1104 # adding them back in the corresponding method
1105 sub _open_outer_paren {
1106 my ($self, $sql) = @_;
1107 $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1112 #======================================================================
1114 #======================================================================
1117 my ($self, $arg) = @_;
1120 for my $c ($self->_order_by_chunks ($arg) ) {
1121 $self->_SWITCH_refkind ($c, {
1122 SCALAR => sub { push @sql, $c },
1123 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1129 $self->_sqlcase(' order by'),
1135 return wantarray ? ($sql, @bind) : $sql;
1138 sub _order_by_chunks {
1139 my ($self, $arg) = @_;
1141 return $self->_SWITCH_refkind($arg, {
1144 map { $self->_order_by_chunks ($_ ) } @$arg;
1147 ARRAYREFREF => sub {
1148 my ($s, @b) = @$$arg;
1149 $self->_assert_bindval_matches_bindtype(@b);
1153 SCALAR => sub {$self->_quote($arg)},
1155 UNDEF => sub {return () },
1157 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1160 # get first pair in hash
1161 my ($key, $val, @rest) = %$arg;
1163 return () unless $key;
1165 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1166 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1172 for my $c ($self->_order_by_chunks ($val)) {
1175 $self->_SWITCH_refkind ($c, {
1180 ($sql, @bind) = @$c;
1184 $sql = $sql . ' ' . $self->_sqlcase($direction);
1186 push @ret, [ $sql, @bind];
1195 #======================================================================
1196 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1197 #======================================================================
1202 $self->_SWITCH_refkind($from, {
1203 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1204 SCALAR => sub {$self->_quote($from)},
1205 SCALARREF => sub {$$from},
1206 ARRAYREFREF => sub {join ', ', @$from;},
1211 #======================================================================
1213 #======================================================================
1215 # highly optimized, as it's called way too often
1217 # my ($self, $label) = @_;
1219 return '' unless defined $_[1];
1220 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1222 unless ($_[0]->{quote_char}) {
1223 $_[0]->_assert_pass_injection_guard($_[1]);
1227 my $qref = ref $_[0]->{quote_char};
1230 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1232 elsif ($qref eq 'ARRAY') {
1233 ($l, $r) = @{$_[0]->{quote_char}};
1236 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1239 # parts containing * are naturally unquoted
1240 return join( $_[0]->{name_sep}||'', map
1241 { $_ eq '*' ? $_ : $l . $_ . $r }
1242 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1247 # Conversion, if applicable
1249 #my ($self, $arg) = @_;
1251 # LDNOTE : modified the previous implementation below because
1252 # it was not consistent : the first "return" is always an array,
1253 # the second "return" is context-dependent. Anyway, _convert
1254 # seems always used with just a single argument, so make it a
1256 # return @_ unless $self->{convert};
1257 # my $conv = $self->_sqlcase($self->{convert});
1258 # my @ret = map { $conv.'('.$_.')' } @_;
1259 # return wantarray ? @ret : $ret[0];
1260 if ($_[0]->{convert}) {
1261 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1268 #my ($self, $col, @vals) = @_;
1270 #LDNOTE : changed original implementation below because it did not make
1271 # sense when bindtype eq 'columns' and @vals > 1.
1272 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1274 # called often - tighten code
1275 return $_[0]->{bindtype} eq 'columns'
1276 ? map {[$_[1], $_]} @_[2 .. $#_]
1281 # Dies if any element of @bind is not in [colname => value] format
1282 # if bindtype is 'columns'.
1283 sub _assert_bindval_matches_bindtype {
1284 # my ($self, @bind) = @_;
1286 if ($self->{bindtype} eq 'columns') {
1288 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1289 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1295 sub _join_sql_clauses {
1296 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1298 if (@$clauses_aref > 1) {
1299 my $join = " " . $self->_sqlcase($logic) . " ";
1300 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1301 return ($sql, @$bind_aref);
1303 elsif (@$clauses_aref) {
1304 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1307 return (); # if no SQL, ignore @$bind_aref
1312 # Fix SQL case, if so requested
1314 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1315 # don't touch the argument ... crooked logic, but let's not change it!
1316 return $_[0]->{case} ? $_[1] : uc($_[1]);
1320 #======================================================================
1321 # DISPATCHING FROM REFKIND
1322 #======================================================================
1325 my ($self, $data) = @_;
1327 return 'UNDEF' unless defined $data;
1329 # blessed objects are treated like scalars
1330 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1332 return 'SCALAR' unless $ref;
1335 while ($ref eq 'REF') {
1337 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1341 return ($ref||'SCALAR') . ('REF' x $n_steps);
1345 my ($self, $data) = @_;
1346 my @try = ($self->_refkind($data));
1347 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1348 push @try, 'FALLBACK';
1352 sub _METHOD_FOR_refkind {
1353 my ($self, $meth_prefix, $data) = @_;
1356 for (@{$self->_try_refkind($data)}) {
1357 $method = $self->can($meth_prefix."_".$_)
1361 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1365 sub _SWITCH_refkind {
1366 my ($self, $data, $dispatch_table) = @_;
1369 for (@{$self->_try_refkind($data)}) {
1370 $coderef = $dispatch_table->{$_}
1374 puke "no dispatch entry for ".$self->_refkind($data)
1383 #======================================================================
1384 # VALUES, GENERATE, AUTOLOAD
1385 #======================================================================
1387 # LDNOTE: original code from nwiger, didn't touch code in that section
1388 # I feel the AUTOLOAD stuff should not be the default, it should
1389 # only be activated on explicit demand by user.
1393 my $data = shift || return;
1394 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1395 unless ref $data eq 'HASH';
1398 foreach my $k ( sort keys %$data ) {
1399 my $v = $data->{$k};
1400 $self->_SWITCH_refkind($v, {
1402 if ($self->{array_datatypes}) { # array datatype
1403 push @all_bind, $self->_bindtype($k, $v);
1405 else { # literal SQL with bind
1406 my ($sql, @bind) = @$v;
1407 $self->_assert_bindval_matches_bindtype(@bind);
1408 push @all_bind, @bind;
1411 ARRAYREFREF => sub { # literal SQL with bind
1412 my ($sql, @bind) = @${$v};
1413 $self->_assert_bindval_matches_bindtype(@bind);
1414 push @all_bind, @bind;
1416 SCALARREF => sub { # literal SQL without bind
1418 SCALAR_or_UNDEF => sub {
1419 push @all_bind, $self->_bindtype($k, $v);
1430 my(@sql, @sqlq, @sqlv);
1434 if ($ref eq 'HASH') {
1435 for my $k (sort keys %$_) {
1438 my $label = $self->_quote($k);
1439 if ($r eq 'ARRAY') {
1440 # literal SQL with bind
1441 my ($sql, @bind) = @$v;
1442 $self->_assert_bindval_matches_bindtype(@bind);
1443 push @sqlq, "$label = $sql";
1445 } elsif ($r eq 'SCALAR') {
1446 # literal SQL without bind
1447 push @sqlq, "$label = $$v";
1449 push @sqlq, "$label = ?";
1450 push @sqlv, $self->_bindtype($k, $v);
1453 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1454 } elsif ($ref eq 'ARRAY') {
1455 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1458 if ($r eq 'ARRAY') { # literal SQL with bind
1459 my ($sql, @bind) = @$v;
1460 $self->_assert_bindval_matches_bindtype(@bind);
1463 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1464 # embedded literal SQL
1471 push @sql, '(' . join(', ', @sqlq) . ')';
1472 } elsif ($ref eq 'SCALAR') {
1476 # strings get case twiddled
1477 push @sql, $self->_sqlcase($_);
1481 my $sql = join ' ', @sql;
1483 # this is pretty tricky
1484 # if ask for an array, return ($stmt, @bind)
1485 # otherwise, s/?/shift @sqlv/ to put it inline
1487 return ($sql, @sqlv);
1489 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1490 ref $d ? $d->[1] : $d/e;
1499 # This allows us to check for a local, then _form, attr
1501 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1502 return $self->generate($name, @_);
1513 SQL::Abstract - Generate SQL from Perl data structures
1519 my $sql = SQL::Abstract->new;
1521 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1523 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1525 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1527 my($stmt, @bind) = $sql->delete($table, \%where);
1529 # Then, use these in your DBI statements
1530 my $sth = $dbh->prepare($stmt);
1531 $sth->execute(@bind);
1533 # Just generate the WHERE clause
1534 my($stmt, @bind) = $sql->where(\%where, \@order);
1536 # Return values in the same order, for hashed queries
1537 # See PERFORMANCE section for more details
1538 my @bind = $sql->values(\%fieldvals);
1542 This module was inspired by the excellent L<DBIx::Abstract>.
1543 However, in using that module I found that what I really wanted
1544 to do was generate SQL, but still retain complete control over my
1545 statement handles and use the DBI interface. So, I set out to
1546 create an abstract SQL generation module.
1548 While based on the concepts used by L<DBIx::Abstract>, there are
1549 several important differences, especially when it comes to WHERE
1550 clauses. I have modified the concepts used to make the SQL easier
1551 to generate from Perl data structures and, IMO, more intuitive.
1552 The underlying idea is for this module to do what you mean, based
1553 on the data structures you provide it. The big advantage is that
1554 you don't have to modify your code every time your data changes,
1555 as this module figures it out.
1557 To begin with, an SQL INSERT is as easy as just specifying a hash
1558 of C<key=value> pairs:
1561 name => 'Jimbo Bobson',
1562 phone => '123-456-7890',
1563 address => '42 Sister Lane',
1564 city => 'St. Louis',
1565 state => 'Louisiana',
1568 The SQL can then be generated with this:
1570 my($stmt, @bind) = $sql->insert('people', \%data);
1572 Which would give you something like this:
1574 $stmt = "INSERT INTO people
1575 (address, city, name, phone, state)
1576 VALUES (?, ?, ?, ?, ?)";
1577 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1578 '123-456-7890', 'Louisiana');
1580 These are then used directly in your DBI code:
1582 my $sth = $dbh->prepare($stmt);
1583 $sth->execute(@bind);
1585 =head2 Inserting and Updating Arrays
1587 If your database has array types (like for example Postgres),
1588 activate the special option C<< array_datatypes => 1 >>
1589 when creating the C<SQL::Abstract> object.
1590 Then you may use an arrayref to insert and update database array types:
1592 my $sql = SQL::Abstract->new(array_datatypes => 1);
1594 planets => [qw/Mercury Venus Earth Mars/]
1597 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1601 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1603 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1606 =head2 Inserting and Updating SQL
1608 In order to apply SQL functions to elements of your C<%data> you may
1609 specify a reference to an arrayref for the given hash value. For example,
1610 if you need to execute the Oracle C<to_date> function on a value, you can
1611 say something like this:
1615 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1618 The first value in the array is the actual SQL. Any other values are
1619 optional and would be included in the bind values array. This gives
1622 my($stmt, @bind) = $sql->insert('people', \%data);
1624 $stmt = "INSERT INTO people (name, date_entered)
1625 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1626 @bind = ('Bill', '03/02/2003');
1628 An UPDATE is just as easy, all you change is the name of the function:
1630 my($stmt, @bind) = $sql->update('people', \%data);
1632 Notice that your C<%data> isn't touched; the module will generate
1633 the appropriately quirky SQL for you automatically. Usually you'll
1634 want to specify a WHERE clause for your UPDATE, though, which is
1635 where handling C<%where> hashes comes in handy...
1637 =head2 Complex where statements
1639 This module can generate pretty complicated WHERE statements
1640 easily. For example, simple C<key=value> pairs are taken to mean
1641 equality, and if you want to see if a field is within a set
1642 of values, you can use an arrayref. Let's say we wanted to
1643 SELECT some data based on this criteria:
1646 requestor => 'inna',
1647 worker => ['nwiger', 'rcwe', 'sfz'],
1648 status => { '!=', 'completed' }
1651 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1653 The above would give you something like this:
1655 $stmt = "SELECT * FROM tickets WHERE
1656 ( requestor = ? ) AND ( status != ? )
1657 AND ( worker = ? OR worker = ? OR worker = ? )";
1658 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1660 Which you could then use in DBI code like so:
1662 my $sth = $dbh->prepare($stmt);
1663 $sth->execute(@bind);
1669 The functions are simple. There's one for each major SQL operation,
1670 and a constructor you use first. The arguments are specified in a
1671 similar order to each function (table, then fields, then a where
1672 clause) to try and simplify things.
1677 =head2 new(option => 'value')
1679 The C<new()> function takes a list of options and values, and returns
1680 a new B<SQL::Abstract> object which can then be used to generate SQL
1681 through the methods below. The options accepted are:
1687 If set to 'lower', then SQL will be generated in all lowercase. By
1688 default SQL is generated in "textbook" case meaning something like:
1690 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1692 Any setting other than 'lower' is ignored.
1696 This determines what the default comparison operator is. By default
1697 it is C<=>, meaning that a hash like this:
1699 %where = (name => 'nwiger', email => 'nate@wiger.org');
1701 Will generate SQL like this:
1703 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1705 However, you may want loose comparisons by default, so if you set
1706 C<cmp> to C<like> you would get SQL such as:
1708 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1710 You can also override the comparsion on an individual basis - see
1711 the huge section on L</"WHERE CLAUSES"> at the bottom.
1713 =item sqltrue, sqlfalse
1715 Expressions for inserting boolean values within SQL statements.
1716 By default these are C<1=1> and C<1=0>. They are used
1717 by the special operators C<-in> and C<-not_in> for generating
1718 correct SQL even when the argument is an empty array (see below).
1722 This determines the default logical operator for multiple WHERE
1723 statements in arrays or hashes. If absent, the default logic is "or"
1724 for arrays, and "and" for hashes. This means that a WHERE
1728 event_date => {'>=', '2/13/99'},
1729 event_date => {'<=', '4/24/03'},
1732 will generate SQL like this:
1734 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1736 This is probably not what you want given this query, though (look
1737 at the dates). To change the "OR" to an "AND", simply specify:
1739 my $sql = SQL::Abstract->new(logic => 'and');
1741 Which will change the above C<WHERE> to:
1743 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1745 The logic can also be changed locally by inserting
1746 a modifier in front of an arrayref :
1748 @where = (-and => [event_date => {'>=', '2/13/99'},
1749 event_date => {'<=', '4/24/03'} ]);
1751 See the L</"WHERE CLAUSES"> section for explanations.
1755 This will automatically convert comparisons using the specified SQL
1756 function for both column and value. This is mostly used with an argument
1757 of C<upper> or C<lower>, so that the SQL will have the effect of
1758 case-insensitive "searches". For example, this:
1760 $sql = SQL::Abstract->new(convert => 'upper');
1761 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1763 Will turn out the following SQL:
1765 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1767 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1768 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1769 not validate this option; it will just pass through what you specify verbatim).
1773 This is a kludge because many databases suck. For example, you can't
1774 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1775 Instead, you have to use C<bind_param()>:
1777 $sth->bind_param(1, 'reg data');
1778 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1780 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1781 which loses track of which field each slot refers to. Fear not.
1783 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1784 Currently, you can specify either C<normal> (default) or C<columns>. If you
1785 specify C<columns>, you will get an array that looks like this:
1787 my $sql = SQL::Abstract->new(bindtype => 'columns');
1788 my($stmt, @bind) = $sql->insert(...);
1791 [ 'column1', 'value1' ],
1792 [ 'column2', 'value2' ],
1793 [ 'column3', 'value3' ],
1796 You can then iterate through this manually, using DBI's C<bind_param()>.
1798 $sth->prepare($stmt);
1801 my($col, $data) = @$_;
1802 if ($col eq 'details' || $col eq 'comments') {
1803 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1804 } elsif ($col eq 'image') {
1805 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1807 $sth->bind_param($i, $data);
1811 $sth->execute; # execute without @bind now
1813 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1814 Basically, the advantage is still that you don't have to care which fields
1815 are or are not included. You could wrap that above C<for> loop in a simple
1816 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1817 get a layer of abstraction over manual SQL specification.
1819 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1820 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1821 will expect the bind values in this format.
1825 This is the character that a table or column name will be quoted
1826 with. By default this is an empty string, but you could set it to
1827 the character C<`>, to generate SQL like this:
1829 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1831 Alternatively, you can supply an array ref of two items, the first being the left
1832 hand quote character, and the second the right hand quote character. For
1833 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1834 that generates SQL like this:
1836 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1838 Quoting is useful if you have tables or columns names that are reserved
1839 words in your database's SQL dialect.
1843 This is the character that separates a table and column name. It is
1844 necessary to specify this when the C<quote_char> option is selected,
1845 so that tables and column names can be individually quoted like this:
1847 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1849 =item injection_guard
1851 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1852 column name specified in a query structure. This is a safety mechanism to avoid
1853 injection attacks when mishandling user input e.g.:
1855 my %condition_as_column_value_pairs = get_values_from_user();
1856 $sqla->select( ... , \%condition_as_column_value_pairs );
1858 If the expression matches an exception is thrown. Note that literal SQL
1859 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1861 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1863 =item array_datatypes
1865 When this option is true, arrayrefs in INSERT or UPDATE are
1866 interpreted as array datatypes and are passed directly
1868 When this option is false, arrayrefs are interpreted
1869 as literal SQL, just like refs to arrayrefs
1870 (but this behavior is for backwards compatibility; when writing
1871 new queries, use the "reference to arrayref" syntax
1877 Takes a reference to a list of "special operators"
1878 to extend the syntax understood by L<SQL::Abstract>.
1879 See section L</"SPECIAL OPERATORS"> for details.
1883 Takes a reference to a list of "unary operators"
1884 to extend the syntax understood by L<SQL::Abstract>.
1885 See section L</"UNARY OPERATORS"> for details.
1891 =head2 insert($table, \@values || \%fieldvals, \%options)
1893 This is the simplest function. You simply give it a table name
1894 and either an arrayref of values or hashref of field/value pairs.
1895 It returns an SQL INSERT statement and a list of bind values.
1896 See the sections on L</"Inserting and Updating Arrays"> and
1897 L</"Inserting and Updating SQL"> for information on how to insert
1898 with those data types.
1900 The optional C<\%options> hash reference may contain additional
1901 options to generate the insert SQL. Currently supported options
1908 Takes either a scalar of raw SQL fields, or an array reference of
1909 field names, and adds on an SQL C<RETURNING> statement at the end.
1910 This allows you to return data generated by the insert statement
1911 (such as row IDs) without performing another C<SELECT> statement.
1912 Note, however, this is not part of the SQL standard and may not
1913 be supported by all database engines.
1917 =head2 update($table, \%fieldvals, \%where)
1919 This takes a table, hashref of field/value pairs, and an optional
1920 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1922 See the sections on L</"Inserting and Updating Arrays"> and
1923 L</"Inserting and Updating SQL"> for information on how to insert
1924 with those data types.
1926 =head2 select($source, $fields, $where, $order)
1928 This returns a SQL SELECT statement and associated list of bind values, as
1929 specified by the arguments :
1935 Specification of the 'FROM' part of the statement.
1936 The argument can be either a plain scalar (interpreted as a table
1937 name, will be quoted), or an arrayref (interpreted as a list
1938 of table names, joined by commas, quoted), or a scalarref
1939 (literal table name, not quoted), or a ref to an arrayref
1940 (list of literal table names, joined by commas, not quoted).
1944 Specification of the list of fields to retrieve from
1946 The argument can be either an arrayref (interpreted as a list
1947 of field names, will be joined by commas and quoted), or a
1948 plain scalar (literal SQL, not quoted).
1949 Please observe that this API is not as flexible as for
1950 the first argument C<$table>, for backwards compatibility reasons.
1954 Optional argument to specify the WHERE part of the query.
1955 The argument is most often a hashref, but can also be
1956 an arrayref or plain scalar --
1957 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1961 Optional argument to specify the ORDER BY part of the query.
1962 The argument can be a scalar, a hashref or an arrayref
1963 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1969 =head2 delete($table, \%where)
1971 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1972 It returns an SQL DELETE statement and list of bind values.
1974 =head2 where(\%where, \@order)
1976 This is used to generate just the WHERE clause. For example,
1977 if you have an arbitrary data structure and know what the
1978 rest of your SQL is going to look like, but want an easy way
1979 to produce a WHERE clause, use this. It returns an SQL WHERE
1980 clause and list of bind values.
1983 =head2 values(\%data)
1985 This just returns the values from the hash C<%data>, in the same
1986 order that would be returned from any of the other above queries.
1987 Using this allows you to markedly speed up your queries if you
1988 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1990 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1992 Warning: This is an experimental method and subject to change.
1994 This returns arbitrarily generated SQL. It's a really basic shortcut.
1995 It will return two different things, depending on return context:
1997 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1998 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2000 These would return the following:
2002 # First calling form
2003 $stmt = "CREATE TABLE test (?, ?)";
2004 @bind = (field1, field2);
2006 # Second calling form
2007 $stmt_and_val = "CREATE TABLE test (field1, field2)";
2009 Depending on what you're trying to do, it's up to you to choose the correct
2010 format. In this example, the second form is what you would want.
2014 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2018 ALTER SESSION SET nls_date_format = 'MM/YY'
2020 You get the idea. Strings get their case twiddled, but everything
2021 else remains verbatim.
2026 =head1 WHERE CLAUSES
2030 This module uses a variation on the idea from L<DBIx::Abstract>. It
2031 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2032 module is that things in arrays are OR'ed, and things in hashes
2035 The easiest way to explain is to show lots of examples. After
2036 each C<%where> hash shown, it is assumed you used:
2038 my($stmt, @bind) = $sql->where(\%where);
2040 However, note that the C<%where> hash can be used directly in any
2041 of the other functions as well, as described above.
2043 =head2 Key-value pairs
2045 So, let's get started. To begin, a simple hash:
2049 status => 'completed'
2052 Is converted to SQL C<key = val> statements:
2054 $stmt = "WHERE user = ? AND status = ?";
2055 @bind = ('nwiger', 'completed');
2057 One common thing I end up doing is having a list of values that
2058 a field can be in. To do this, simply specify a list inside of
2063 status => ['assigned', 'in-progress', 'pending'];
2066 This simple code will create the following:
2068 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2069 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2071 A field associated to an empty arrayref will be considered a
2072 logical false and will generate 0=1.
2074 =head2 Tests for NULL values
2076 If the value part is C<undef> then this is converted to SQL <IS NULL>
2085 $stmt = "WHERE user = ? AND status IS NULL";
2088 =head2 Specific comparison operators
2090 If you want to specify a different type of operator for your comparison,
2091 you can use a hashref for a given column:
2095 status => { '!=', 'completed' }
2098 Which would generate:
2100 $stmt = "WHERE user = ? AND status != ?";
2101 @bind = ('nwiger', 'completed');
2103 To test against multiple values, just enclose the values in an arrayref:
2105 status => { '=', ['assigned', 'in-progress', 'pending'] };
2107 Which would give you:
2109 "WHERE status = ? OR status = ? OR status = ?"
2112 The hashref can also contain multiple pairs, in which case it is expanded
2113 into an C<AND> of its elements:
2117 status => { '!=', 'completed', -not_like => 'pending%' }
2120 # Or more dynamically, like from a form
2121 $where{user} = 'nwiger';
2122 $where{status}{'!='} = 'completed';
2123 $where{status}{'-not_like'} = 'pending%';
2125 # Both generate this
2126 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2127 @bind = ('nwiger', 'completed', 'pending%');
2130 To get an OR instead, you can combine it with the arrayref idea:
2134 priority => [ {'=', 2}, {'!=', 1} ]
2137 Which would generate:
2139 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
2140 @bind = ('nwiger', '2', '1');
2142 If you want to include literal SQL (with or without bind values), just use a
2143 scalar reference or array reference as the value:
2146 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2147 date_expires => { '<' => \"now()" }
2150 Which would generate:
2152 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2153 @bind = ('11/26/2008');
2156 =head2 Logic and nesting operators
2158 In the example above,
2159 there is a subtle trap if you want to say something like
2160 this (notice the C<AND>):
2162 WHERE priority != ? AND priority != ?
2164 Because, in Perl you I<can't> do this:
2166 priority => { '!=', 2, '!=', 1 }
2168 As the second C<!=> key will obliterate the first. The solution
2169 is to use the special C<-modifier> form inside an arrayref:
2171 priority => [ -and => {'!=', 2},
2175 Normally, these would be joined by C<OR>, but the modifier tells it
2176 to use C<AND> instead. (Hint: You can use this in conjunction with the
2177 C<logic> option to C<new()> in order to change the way your queries
2178 work by default.) B<Important:> Note that the C<-modifier> goes
2179 B<INSIDE> the arrayref, as an extra first element. This will
2180 B<NOT> do what you think it might:
2182 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
2184 Here is a quick list of equivalencies, since there is some overlap:
2187 status => {'!=', 'completed', 'not like', 'pending%' }
2188 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2191 status => {'=', ['assigned', 'in-progress']}
2192 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2193 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2197 =head2 Special operators : IN, BETWEEN, etc.
2199 You can also use the hashref format to compare a list of fields using the
2200 C<IN> comparison operator, by specifying the list as an arrayref:
2203 status => 'completed',
2204 reportid => { -in => [567, 2335, 2] }
2207 Which would generate:
2209 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2210 @bind = ('completed', '567', '2335', '2');
2212 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2215 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2216 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2217 'sqltrue' (by default : C<1=1>).
2219 In addition to the array you can supply a chunk of literal sql or
2220 literal sql with bind:
2223 customer => { -in => \[
2224 'SELECT cust_id FROM cust WHERE balance > ?',
2227 status => { -in => \'SELECT status_codes FROM states' },
2233 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2234 AND status IN ( SELECT status_codes FROM states )
2240 Another pair of operators is C<-between> and C<-not_between>,
2241 used with an arrayref of two values:
2245 completion_date => {
2246 -not_between => ['2002-10-01', '2003-02-06']
2252 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2254 Just like with C<-in> all plausible combinations of literal SQL
2258 start0 => { -between => [ 1, 2 ] },
2259 start1 => { -between => \["? AND ?", 1, 2] },
2260 start2 => { -between => \"lower(x) AND upper(y)" },
2261 start3 => { -between => [
2263 \["upper(?)", 'stuff' ],
2270 ( start0 BETWEEN ? AND ? )
2271 AND ( start1 BETWEEN ? AND ? )
2272 AND ( start2 BETWEEN lower(x) AND upper(y) )
2273 AND ( start3 BETWEEN lower(x) AND upper(?) )
2275 @bind = (1, 2, 1, 2, 'stuff');
2278 These are the two builtin "special operators"; but the
2279 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2281 Another operator is C<-func> that allows you to call SQL functions with
2282 arguments. It receives an array reference containing the function name
2283 as the 0th argument and the other arguments being its parameters. For example:
2286 -func => ['substr', 'Hello', 50, 5],
2291 $stmt = "WHERE (substr(?,?,?))";
2292 @bind = ("Hello", 50, 5);
2294 =head2 Unary operators: bool
2296 If you wish to test against boolean columns or functions within your
2297 database you can use the C<-bool> and C<-not_bool> operators. For
2298 example to test the column C<is_user> being true and the column
2299 C<is_enabled> being false you would use:-
2303 -not_bool => 'is_enabled',
2308 WHERE is_user AND NOT is_enabled
2310 If a more complex combination is required, testing more conditions,
2311 then you should use the and/or operators:-
2318 -not_bool => 'four',
2324 WHERE one AND two AND three AND NOT four
2327 =head2 Nested conditions, -and/-or prefixes
2329 So far, we've seen how multiple conditions are joined with a top-level
2330 C<AND>. We can change this by putting the different conditions we want in
2331 hashes and then putting those hashes in an array. For example:
2336 status => { -like => ['pending%', 'dispatched'] },
2340 status => 'unassigned',
2344 This data structure would create the following:
2346 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2347 OR ( user = ? AND status = ? ) )";
2348 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2351 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2352 to change the logic inside :
2358 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2359 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2366 WHERE ( user = ? AND (
2367 ( workhrs > ? AND geo = ? )
2368 OR ( workhrs < ? OR geo = ? )
2371 =head2 Algebraic inconsistency, for historical reasons
2373 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2374 operator goes C<outside> of the nested structure; whereas when connecting
2375 several constraints on one column, the C<-and> operator goes
2376 C<inside> the arrayref. Here is an example combining both features :
2379 -and => [a => 1, b => 2],
2380 -or => [c => 3, d => 4],
2381 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2386 WHERE ( ( ( a = ? AND b = ? )
2387 OR ( c = ? OR d = ? )
2388 OR ( e LIKE ? AND e LIKE ? ) ) )
2390 This difference in syntax is unfortunate but must be preserved for
2391 historical reasons. So be careful : the two examples below would
2392 seem algebraically equivalent, but they are not
2394 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2395 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2397 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2398 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2403 Finally, sometimes only literal SQL will do. If you want to include
2404 literal SQL verbatim, you can specify it as a scalar reference, namely:
2406 my $inn = 'is Not Null';
2408 priority => { '<', 2 },
2414 $stmt = "WHERE priority < ? AND requestor is Not Null";
2417 Note that in this example, you only get one bind parameter back, since
2418 the verbatim SQL is passed as part of the statement.
2420 Of course, just to prove a point, the above can also be accomplished
2424 priority => { '<', 2 },
2425 requestor => { '!=', undef },
2431 Conditions on boolean columns can be expressed in the same way, passing
2432 a reference to an empty string, however using liternal SQL in this way
2433 is deprecated - the preferred method is to use the boolean operators -
2434 see L</"Unary operators: bool"> :
2437 priority => { '<', 2 },
2443 $stmt = "WHERE priority < ? AND is_ready";
2446 Literal SQL is also the only way to compare 2 columns to one another:
2449 priority => { '<', 2 },
2450 requestor => \'= submittor'
2455 $stmt = "WHERE priority < ? AND requestor = submitter";
2458 =head2 Literal SQL with placeholders and bind values (subqueries)
2460 If the literal SQL to be inserted has placeholders and bind values,
2461 use a reference to an arrayref (yes this is a double reference --
2462 not so common, but perfectly legal Perl). For example, to find a date
2463 in Postgres you can use something like this:
2466 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2471 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2474 Note that you must pass the bind values in the same format as they are returned
2475 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2476 provide the bind values in the C<< [ column_meta => value ] >> format, where
2477 C<column_meta> is an opaque scalar value; most commonly the column name, but
2478 you can use any scalar value (including references and blessed references),
2479 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2480 to C<columns> the above example will look like:
2483 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2486 Literal SQL is especially useful for nesting parenthesized clauses in the
2487 main SQL query. Here is a first example :
2489 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2493 bar => \["IN ($sub_stmt)" => @sub_bind],
2498 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2499 WHERE c2 < ? AND c3 LIKE ?))";
2500 @bind = (1234, 100, "foo%");
2502 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2503 are expressed in the same way. Of course the C<$sub_stmt> and
2504 its associated bind values can be generated through a former call
2507 my ($sub_stmt, @sub_bind)
2508 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2509 c3 => {-like => "foo%"}});
2512 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2515 In the examples above, the subquery was used as an operator on a column;
2516 but the same principle also applies for a clause within the main C<%where>
2517 hash, like an EXISTS subquery :
2519 my ($sub_stmt, @sub_bind)
2520 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2521 my %where = ( -and => [
2523 \["EXISTS ($sub_stmt)" => @sub_bind],
2528 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2529 WHERE c1 = ? AND c2 > t0.c0))";
2533 Observe that the condition on C<c2> in the subquery refers to
2534 column C<t0.c0> of the main query : this is I<not> a bind
2535 value, so we have to express it through a scalar ref.
2536 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2537 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2538 what we wanted here.
2540 Finally, here is an example where a subquery is used
2541 for expressing unary negation:
2543 my ($sub_stmt, @sub_bind)
2544 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2545 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2547 lname => {like => '%son%'},
2548 \["NOT ($sub_stmt)" => @sub_bind],
2553 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2554 @bind = ('%son%', 10, 20)
2560 These pages could go on for a while, since the nesting of the data
2561 structures this module can handle are pretty much unlimited (the
2562 module implements the C<WHERE> expansion as a recursive function
2563 internally). Your best bet is to "play around" with the module a
2564 little to see how the data structures behave, and choose the best
2565 format for your data based on that.
2567 And of course, all the values above will probably be replaced with
2568 variables gotten from forms or the command line. After all, if you
2569 knew everything ahead of time, you wouldn't have to worry about
2570 dynamically-generating SQL and could just hardwire it into your
2576 =head1 ORDER BY CLAUSES
2578 Some functions take an order by clause. This can either be a scalar (just a
2579 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2580 or an array of either of the two previous forms. Examples:
2582 Given | Will Generate
2583 ----------------------------------------------------------
2585 \'colA DESC' | ORDER BY colA DESC
2587 'colA' | ORDER BY colA
2589 [qw/colA colB/] | ORDER BY colA, colB
2591 {-asc => 'colA'} | ORDER BY colA ASC
2593 {-desc => 'colB'} | ORDER BY colB DESC
2595 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2597 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2600 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2601 { -desc => [qw/colB/], | colC ASC, colD ASC
2602 { -asc => [qw/colC colD/],|
2604 ===========================================================
2608 =head1 SPECIAL OPERATORS
2610 my $sqlmaker = SQL::Abstract->new(special_ops => [
2614 my ($self, $field, $op, $arg) = @_;
2620 handler => 'method_name',
2624 A "special operator" is a SQL syntactic clause that can be
2625 applied to a field, instead of a usual binary operator.
2628 WHERE field IN (?, ?, ?)
2629 WHERE field BETWEEN ? AND ?
2630 WHERE MATCH(field) AGAINST (?, ?)
2632 Special operators IN and BETWEEN are fairly standard and therefore
2633 are builtin within C<SQL::Abstract> (as the overridable methods
2634 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2635 like the MATCH .. AGAINST example above which is specific to MySQL,
2636 you can write your own operator handlers - supply a C<special_ops>
2637 argument to the C<new> method. That argument takes an arrayref of
2638 operator definitions; each operator definition is a hashref with two
2645 the regular expression to match the operator
2649 Either a coderef or a plain scalar method name. In both cases
2650 the expected return is C<< ($sql, @bind) >>.
2652 When supplied with a method name, it is simply called on the
2653 L<SQL::Abstract/> object as:
2655 $self->$method_name ($field, $op, $arg)
2659 $op is the part that matched the handler regex
2660 $field is the LHS of the operator
2663 When supplied with a coderef, it is called as:
2665 $coderef->($self, $field, $op, $arg)
2670 For example, here is an implementation
2671 of the MATCH .. AGAINST syntax for MySQL
2673 my $sqlmaker = SQL::Abstract->new(special_ops => [
2675 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2676 {regex => qr/^match$/i,
2678 my ($self, $field, $op, $arg) = @_;
2679 $arg = [$arg] if not ref $arg;
2680 my $label = $self->_quote($field);
2681 my ($placeholder) = $self->_convert('?');
2682 my $placeholders = join ", ", (($placeholder) x @$arg);
2683 my $sql = $self->_sqlcase('match') . " ($label) "
2684 . $self->_sqlcase('against') . " ($placeholders) ";
2685 my @bind = $self->_bindtype($field, @$arg);
2686 return ($sql, @bind);
2693 =head1 UNARY OPERATORS
2695 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2699 my ($self, $op, $arg) = @_;
2705 handler => 'method_name',
2709 A "unary operator" is a SQL syntactic clause that can be
2710 applied to a field - the operator goes before the field
2712 You can write your own operator handlers - supply a C<unary_ops>
2713 argument to the C<new> method. That argument takes an arrayref of
2714 operator definitions; each operator definition is a hashref with two
2721 the regular expression to match the operator
2725 Either a coderef or a plain scalar method name. In both cases
2726 the expected return is C<< $sql >>.
2728 When supplied with a method name, it is simply called on the
2729 L<SQL::Abstract/> object as:
2731 $self->$method_name ($op, $arg)
2735 $op is the part that matched the handler regex
2736 $arg is the RHS or argument of the operator
2738 When supplied with a coderef, it is called as:
2740 $coderef->($self, $op, $arg)
2748 Thanks to some benchmarking by Mark Stosberg, it turns out that
2749 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2750 I must admit this wasn't an intentional design issue, but it's a
2751 byproduct of the fact that you get to control your C<DBI> handles
2754 To maximize performance, use a code snippet like the following:
2756 # prepare a statement handle using the first row
2757 # and then reuse it for the rest of the rows
2759 for my $href (@array_of_hashrefs) {
2760 $stmt ||= $sql->insert('table', $href);
2761 $sth ||= $dbh->prepare($stmt);
2762 $sth->execute($sql->values($href));
2765 The reason this works is because the keys in your C<$href> are sorted
2766 internally by B<SQL::Abstract>. Thus, as long as your data retains
2767 the same structure, you only have to generate the SQL the first time
2768 around. On subsequent queries, simply use the C<values> function provided
2769 by this module to return your values in the correct order.
2771 However this depends on the values having the same type - if, for
2772 example, the values of a where clause may either have values
2773 (resulting in sql of the form C<column = ?> with a single bind
2774 value), or alternatively the values might be C<undef> (resulting in
2775 sql of the form C<column IS NULL> with no bind value) then the
2776 caching technique suggested will not work.
2780 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2781 really like this part (I do, at least). Building up a complex query
2782 can be as simple as the following:
2786 use CGI::FormBuilder;
2789 my $form = CGI::FormBuilder->new(...);
2790 my $sql = SQL::Abstract->new;
2792 if ($form->submitted) {
2793 my $field = $form->field;
2794 my $id = delete $field->{id};
2795 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2798 Of course, you would still have to connect using C<DBI> to run the
2799 query, but the point is that if you make your form look like your
2800 table, the actual query script can be extremely simplistic.
2802 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2803 a fast interface to returning and formatting data. I frequently
2804 use these three modules together to write complex database query
2805 apps in under 50 lines.
2811 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class.git>
2813 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/DBIx-Class.git>
2819 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2820 Great care has been taken to preserve the I<published> behavior
2821 documented in previous versions in the 1.* family; however,
2822 some features that were previously undocumented, or behaved
2823 differently from the documentation, had to be changed in order
2824 to clarify the semantics. Hence, client code that was relying
2825 on some dark areas of C<SQL::Abstract> v1.*
2826 B<might behave differently> in v1.50.
2828 The main changes are :
2834 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2838 support for the { operator => \"..." } construct (to embed literal SQL)
2842 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2846 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2850 defensive programming : check arguments
2854 fixed bug with global logic, which was previously implemented
2855 through global variables yielding side-effects. Prior versions would
2856 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2857 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2858 Now this is interpreted
2859 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2864 fixed semantics of _bindtype on array args
2868 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2869 we just avoid shifting arrays within that tree.
2873 dropped the C<_modlogic> function
2879 =head1 ACKNOWLEDGEMENTS
2881 There are a number of individuals that have really helped out with
2882 this module. Unfortunately, most of them submitted bugs via CPAN
2883 so I have no idea who they are! But the people I do know are:
2885 Ash Berlin (order_by hash term support)
2886 Matt Trout (DBIx::Class support)
2887 Mark Stosberg (benchmarking)
2888 Chas Owens (initial "IN" operator support)
2889 Philip Collins (per-field SQL functions)
2890 Eric Kolve (hashref "AND" support)
2891 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2892 Dan Kubb (support for "quote_char" and "name_sep")
2893 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2894 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2895 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2896 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2897 Oliver Charles (support for "RETURNING" after "INSERT")
2903 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2907 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2909 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2911 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2912 While not an official support venue, C<DBIx::Class> makes heavy use of
2913 C<SQL::Abstract>, and as such list members there are very familiar with
2914 how to create queries.
2918 This module is free software; you may copy this under the same
2919 terms as perl itself (either the GNU General Public License or
2920 the Artistic License)