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)
11 use Data::Query::Constants qw(
12 DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_LITERAL DQ_JOIN DQ_SELECT DQ_ORDER
13 DQ_WHERE DQ_DELETE DQ_UPDATE DQ_INSERT
15 use Data::Query::ExprHelpers qw(perl_scalar_value);
18 #======================================================================
20 #======================================================================
22 our $VERSION = '1.72';
24 # This would confuse some packagers
25 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
29 #======================================================================
30 # DEBUGGING AND ERROR REPORTING
31 #======================================================================
34 return unless $_[0]->{debug}; shift; # a little faster
35 my $func = (caller(1))[3];
36 warn "[$func] ", @_, "\n";
40 my($func) = (caller(1))[3];
41 Carp::carp "[$func] Warning: ", @_;
45 my($func) = (caller(1))[3];
46 Carp::croak "[$func] Fatal: ", @_;
50 #======================================================================
52 #======================================================================
55 is => 'ro', coerce => sub { $_[0] eq 'lower' ? 'lower' : undef }
59 is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
63 is => 'ro', default => sub { 'normal' }
66 has cmp => (is => 'ro', default => sub { '=' });
69 # try to recognize which are the 'equality' and 'unequality' ops
70 # (temporary quickfix, should go through a more seasoned API)
73 is => 'ro', lazy => 1,
74 default => sub { qr/^(\Q${\$_[0]->cmp}\E|is|(is\s+)?like)$/i }
77 has inequality_op => (
79 default => sub { qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i }
83 has sqltrue => (is => 'ro', default => sub { '1=1' });
84 has sqlfalse => (is => 'ro', default => sub { '0=1' });
86 has special_ops => (is => 'ro', default => sub { [] });
87 has unary_ops => (is => 'ro', default => sub { [] });
89 # rudimentary saniy-check for user supplied bits treated as functions/operators
90 # If a purported function matches this regular expression, an exception is thrown.
91 # Literal SQL is *NOT* subject to this check, only functions (and column names
92 # when quoting is not in effect)
95 # need to guard against ()'s in column names too, but this will break tons of
96 # hacks... ideas anyone?
98 has injection_guard => (
109 has renderer => (is => 'lazy', clearer => 'clear_renderer');
112 is => 'rw', default => sub { '.' },
113 trigger => sub { shift->clear_renderer },
118 trigger => sub { shift->clear_renderer },
121 has always_quote => (is => 'ro', default => sub { 1 });
123 has convert => (is => 'ro');
125 has array_datatypes => (is => 'ro');
127 sub _build_renderer {
129 require Data::Query::Renderer::SQL::Naive;
131 for ($self->quote_char) {
132 $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
134 Data::Query::Renderer::SQL::Naive->new({
135 quote_chars => $chars, always_quote => $self->always_quote,
136 identifier_sep => $self->name_sep,
137 ($self->case ? (lc_keywords => 1) : ()), # always 'lower' if it exists
142 my ($self, $dq) = @_;
146 my ($sql, @bind) = @{$self->renderer->render($dq)};
148 ($self->{bindtype} eq 'normal'
149 ? ($sql, map $_->{value}, @bind)
150 : ($sql, map [ $_->{value_meta}, $_->{value} ], @bind)
156 my ($self, $type, @args) = @_;
157 $self->_render_dq($self->${\"_${type}_to_dq"}(@args));
161 my ($self, $literal) = @_;
163 ($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
168 (@bind ? (values => [ $self->_bind_to_dq(@bind) ]) : ()),
173 my ($self, @bind) = @_;
175 $self->{bindtype} eq 'normal'
176 ? map perl_scalar_value($_), @bind
178 $self->_assert_bindval_matches_bindtype(@bind);
179 map perl_scalar_value(reverse @$_), @bind
184 my ($self, $value) = @_;
185 $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
189 my ($self, $ident) = @_;
190 $self->_assert_pass_injection_guard($ident)
191 unless $self->renderer->quote_chars->[0] && $self->renderer->always_quote;
192 $self->_maybe_convert_dq({
193 type => DQ_IDENTIFIER,
194 elements => [ split /\Q${\$self->renderer->identifier_sep}/, $ident ],
198 sub _maybe_convert_dq {
199 my ($self, $dq) = @_;
200 if (my $c = $self->{where_convert}) {
203 operator => { 'SQL.Naive' => 'apply' },
205 { type => DQ_IDENTIFIER, elements => [ $self->_sqlcase($c) ] },
215 my ($self, $op, @args) = @_;
216 $self->_assert_pass_injection_guard($op);
219 operator => { 'SQL.Naive' => $op },
224 sub _assert_pass_injection_guard {
225 if ($_[1] =~ $_[0]->{injection_guard}) {
226 my $class = ref $_[0];
227 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
228 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
229 . "{injection_guard} attribute to ${class}->new()"
234 #======================================================================
236 #======================================================================
238 sub insert { shift->_render_sqla(insert => @_) }
241 my ($self, $table, $data, $options) = @_;
242 my (@names, @values);
243 if (ref($data) eq 'HASH') {
244 @names = sort keys %$data;
245 foreach my $k (@names) {
246 local our $Cur_Col_Meta = $k;
247 push @values, $self->_mutation_rhs_to_dq($data->{$k});
249 } elsif (ref($data) eq 'ARRAY') {
250 local our $Cur_Col_Meta;
251 @values = map $self->_mutation_rhs_to_dq($_), @$data;
253 die "Not handled yet";
256 if (my $r_source = $options->{returning}) {
258 map +(ref($_) ? $self->_expr_to_dq($_) : $self->_ident_to_dq($_)),
259 (ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
264 target => $self->_table_to_dq($table),
265 (@names ? (names => [ map $self->_ident_to_dq($_), @names ]) : ()),
266 values => [ \@values ],
267 ($returning ? (returning => $returning) : ()),
271 sub _mutation_rhs_to_dq {
273 if (ref($v) eq 'ARRAY') {
274 if ($self->{array_datatypes}) {
275 return $self->_value_to_dq($v);
277 $v = \do { my $x = $v };
279 if (ref($v) eq 'HASH') {
280 my ($op, $arg, @rest) = %$v;
282 puke 'Operator calls in update/insert must be in the form { -op => $arg }'
283 if (@rest or not $op =~ /^\-(.+)/);
285 return $self->_expr_to_dq($v);
288 #======================================================================
290 #======================================================================
293 sub update { shift->_render_sqla(update => @_) }
296 my ($self, $table, $data, $where) = @_;
298 puke "Unsupported data type specified to \$sql->update"
299 unless ref $data eq 'HASH';
303 foreach my $k (sort keys %$data) {
305 local our $Cur_Col_Meta = $k;
306 push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
311 target => $self->_table_to_dq($table),
313 where => $self->_where_to_dq($where),
318 #======================================================================
320 #======================================================================
323 my ($self, $table, $where) = @_;
325 my $source_dq = $self->_table_to_dq($table);
327 if (my $where_dq = $self->_where_to_dq($where)) {
338 sub select { shift->_render_sqla(select => @_) }
341 my ($self, $table, $fields, $where, $order) = @_;
343 my $final_dq = $self->_select_body_to_dq($table, $fields, $where);
346 $final_dq = $self->_order_by_to_dq($order, undef, $final_dq);
352 sub _select_body_to_dq {
353 my ($self, $table, $fields, $where) = @_;
357 my $source_dq = $self->_source_to_dq($table, $where);
362 map $self->_select_field_to_dq($_),
363 ref($fields) eq 'ARRAY' ? @$fields : $fields
369 sub _select_field_to_dq {
370 my ($self, $field) = @_;
372 ? $self->_literal_to_dq($$field)
373 : $self->_ident_to_dq($field)
376 #======================================================================
378 #======================================================================
381 sub delete { shift->_render_sqla(delete => @_) }
384 my ($self, $table, $where) = @_;
387 target => $self->_table_to_dq($table),
388 where => $self->_where_to_dq($where),
393 #======================================================================
395 #======================================================================
399 # Finally, a separate routine just to handle WHERE clauses
401 my ($self, $where, $order) = @_;
407 ($sql, @bind) = $self->_recurse_where($where) if defined($where);
408 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
412 $sql .= $self->_order_by($order);
415 return wantarray ? ($sql, @bind) : $sql;
418 sub _recurse_where { shift->_render_sqla(where => @_) }
421 my ($self, $where, $logic) = @_;
423 return undef unless defined($where);
425 # turn the convert misfeature on - only used in WHERE clauses
426 local $self->{where_convert} = $self->{convert};
428 return $self->_expr_to_dq($where, $logic);
432 my ($self, $where, $logic) = @_;
434 if (ref($where) eq 'ARRAY') {
435 return $self->_expr_to_dq_ARRAYREF($where, $logic);
436 } elsif (ref($where) eq 'HASH') {
437 return $self->_expr_to_dq_HASHREF($where, $logic);
439 ref($where) eq 'SCALAR'
440 or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
442 return $self->_literal_to_dq($$where);
443 } elsif (!ref($where) or Scalar::Util::blessed($where)) {
444 return $self->_value_to_dq($where);
446 die "Can't handle $where";
449 sub _expr_to_dq_ARRAYREF {
450 my ($self, $where, $logic) = @_;
452 $logic = uc($logic || $self->{logic} || 'OR');
453 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
455 return unless @$where;
457 my ($first, @rest) = @$where;
459 return $self->_expr_to_dq($first) unless @rest;
463 $self->_where_hashpair_to_dq($first => shift(@rest));
465 $self->_expr_to_dq($first);
469 return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
472 $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
476 sub _expr_to_dq_HASHREF {
477 my ($self, $where, $logic) = @_;
479 $logic = uc($logic) if $logic;
482 $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
485 return $dq[0] unless @dq > 1;
487 my $final = pop(@dq);
489 foreach my $dq (reverse @dq) {
490 $final = $self->_op_to_dq($logic||'AND', $dq, $final);
496 sub _where_to_dq_SCALAR {
497 shift->_value_to_dq(@_);
501 my ($self, $op, $v) = @_;
502 my @args = map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v);
504 # Ok. Welcome to stupid compat code land. An SQLA expr that would in the
505 # absence of this piece of crazy render to:
511 # { -a => { -b => { -c => $x } } }
513 # actually needs to render to:
517 # because SQL sucks, and databases are hateful, and SQLA is Just That DWIM.
519 # However, we don't want to catch 'A(x)' and turn it into 'A x'
521 # So the way we deal with this is to go through all our arguments, and
522 # then if the argument is -also- an apply, i.e. at least 'B', we check
523 # its arguments - and if there's only one of them, and that isn't an apply,
524 # then we convert to the bareword form. The end result should be:
527 # A( B( x ) ) -> A( B x )
528 # A( B( C( x ) ) ) -> A( B( C x ) )
529 # A( B( x + y ) ) -> A( B( x + y ) )
530 # A( B( x, y ) ) -> A( B( x, y ) )
532 # If this turns out not to be quite right, please add additional tests
533 # to either 01generate.t or 02where.t *and* update this comment.
535 foreach my $arg (@args) {
537 $arg->{type} eq DQ_OPERATOR and $arg->{operator}{'SQL.Naive'} eq 'apply'
538 and @{$arg->{args}} == 2 and $arg->{args}[1]{type} ne DQ_OPERATOR
540 $arg->{operator}{'SQL.Naive'} = (shift @{$arg->{args}})->{elements}->[0];
543 $self->_assert_pass_injection_guard($op);
544 return $self->_op_to_dq(
545 apply => $self->_ident_to_dq($op), @args
549 sub _where_hashpair_to_dq {
550 my ($self, $k, $v, $logic) = @_;
552 if ($k =~ /^-(.*)/s) {
554 if ($op eq 'AND' or $op eq 'OR') {
555 return $self->_expr_to_dq($v, $op);
556 } elsif ($op eq 'NEST') {
557 return $self->_expr_to_dq($v);
558 } elsif ($op eq 'NOT') {
559 return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
560 } elsif ($op eq 'BOOL') {
561 return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
562 } elsif ($op eq 'NOT_BOOL') {
563 return $self->_op_to_dq(
564 NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
566 } elsif ($op eq 'IDENT') {
567 return $self->_ident_to_dq($v);
568 } elsif ($op eq 'VALUE') {
569 return $self->_value_to_dq($v);
570 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
571 die "Use of [and|or|nest]_N modifiers is no longer supported";
573 return $self->_apply_to_dq($op, $v);
576 local our $Cur_Col_Meta = $k;
577 if (ref($v) eq 'ARRAY') {
579 return $self->_literal_to_dq($self->{sqlfalse});
580 } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
581 return $self->_expr_to_dq_ARRAYREF([
582 map +{ $k => $_ }, @{$v}[1..$#$v]
585 return $self->_expr_to_dq_ARRAYREF([
586 map +{ $k => $_ }, @$v
588 } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
592 parts => [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]
595 my ($op, $rhs) = do {
596 if (ref($v) eq 'HASH') {
598 return $self->_expr_to_dq_ARRAYREF([
599 map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
602 my ($op, $value) = %$v;
603 s/^-//, s/_/ /g for $op;
604 if ($op =~ /^(and|or)$/i) {
605 return $self->_expr_to_dq({ $k => $value }, $op);
607 my $special_op = List::Util::first {$op =~ $_->{regex}}
608 @{$self->{special_ops}}
610 return $self->_literal_to_dq(
611 [ $self->${\$special_op->{handler}}($k, $op, $value) ]
613 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
614 die "Use of [and|or|nest]_N modifiers is no longer supported";
621 if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
622 if (ref($rhs) ne 'ARRAY') {
624 # have to add parens if none present because -in => \"SELECT ..."
625 # got documented. mst hates everything.
626 if (ref($rhs) eq 'SCALAR') {
628 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
631 my ($x, @rest) = @{$$rhs};
632 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
633 $rhs = \[ $x, @rest ];
636 return $self->_op_to_dq(
637 $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
640 return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
641 return $self->_op_to_dq(
642 $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
644 } elsif ($op =~ s/^NOT (?!LIKE)//) {
645 return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
646 } elsif ($op eq 'IDENT') {
647 return $self->_op_to_dq(
648 $self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
650 } elsif ($op eq 'VALUE') {
651 return $self->_op_to_dq(
652 $self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
654 } elsif (!defined($rhs)) {
656 if ($op eq '=' or $op eq 'LIKE') {
658 } elsif ($op eq '!=') {
661 die "Can't do undef -> NULL transform for operator ${op}";
664 return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
666 if (ref($rhs) eq 'ARRAY') {
668 return $self->_literal_to_dq(
669 $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
671 } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
672 return $self->_expr_to_dq_ARRAYREF([
673 map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
675 } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
676 die "Use of [and|or|nest]_N modifiers is no longer supported";
678 return $self->_expr_to_dq_ARRAYREF([
679 map +{ $k => { $op => $_ } }, @$rhs
682 return $self->_op_to_dq(
683 $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
688 #======================================================================
690 #======================================================================
693 my ($self, $arg) = @_;
694 if (my $dq = $self->_order_by_to_dq($arg)) {
695 # SQLA generates ' ORDER BY foo'. The hilarity.
697 ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
698 : ' '.$self->_render_dq($dq);
704 sub _order_by_to_dq {
705 my ($self, $arg, $dir, $from) = @_;
711 ($dir ? (direction => $dir) : ()),
712 ($from ? (from => $from) : ()),
716 $dq->{by} = $self->_ident_to_dq($arg);
717 } elsif (ref($arg) eq 'ARRAY') {
719 local our $Order_Inner unless our $Order_Recursing;
720 local $Order_Recursing = 1;
722 foreach my $member (@$arg) {
724 my $next = $self->_order_by_to_dq($member, $dir, $from);
726 $inner->{from} = $next if $inner;
727 $inner = $Order_Inner || $next;
729 $Order_Inner = $inner;
731 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
732 $dq->{by} = $self->_literal_to_dq($$arg);
733 } elsif (ref($arg) eq 'SCALAR') {
734 $dq->{by} = $self->_literal_to_dq($$arg);
735 } elsif (ref($arg) eq 'HASH') {
736 my ($key, $val, @rest) = %$arg;
740 if (@rest or not $key =~ /^-(desc|asc)/i) {
741 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
744 return $self->_order_by_to_dq($val, $dir, $from);
746 die "Can't handle $arg in _order_by_to_dq";
751 #======================================================================
752 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
753 #======================================================================
755 sub _table { shift->_render_sqla(table => @_) }
758 my ($self, $from) = @_;
759 if (ref($from) eq 'ARRAY') {
760 die "Empty FROM list" unless my @f = @$from;
761 my $dq = $self->_table_to_dq(shift @f);
762 while (my $x = shift @f) {
765 join => [ $dq, $self->_table_to_dq($x) ]
769 } elsif (ref($from) eq 'SCALAR') {
776 $self->_ident_to_dq($from);
781 #======================================================================
783 #======================================================================
785 # highly optimized, as it's called way too often
787 # my ($self, $label) = @_;
789 return '' unless defined $_[1];
790 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
792 unless ($_[0]->{quote_char}) {
793 $_[0]->_assert_pass_injection_guard($_[1]);
797 my $qref = ref $_[0]->{quote_char};
800 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
802 elsif ($qref eq 'ARRAY') {
803 ($l, $r) = @{$_[0]->{quote_char}};
806 puke "Unsupported quote_char format: $_[0]->{quote_char}";
809 # parts containing * are naturally unquoted
810 return join( $_[0]->{name_sep}||'', map
811 { $_ eq '*' ? $_ : $l . $_ . $r }
812 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
817 # Conversion, if applicable
819 #my ($self, $arg) = @_;
821 # LDNOTE : modified the previous implementation below because
822 # it was not consistent : the first "return" is always an array,
823 # the second "return" is context-dependent. Anyway, _convert
824 # seems always used with just a single argument, so make it a
826 # return @_ unless $self->{convert};
827 # my $conv = $self->_sqlcase($self->{convert});
828 # my @ret = map { $conv.'('.$_.')' } @_;
829 # return wantarray ? @ret : $ret[0];
830 if ($_[0]->{convert}) {
831 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
838 #my ($self, $col, @vals) = @_;
840 #LDNOTE : changed original implementation below because it did not make
841 # sense when bindtype eq 'columns' and @vals > 1.
842 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
844 # called often - tighten code
845 return $_[0]->{bindtype} eq 'columns'
846 ? map {[$_[1], $_]} @_[2 .. $#_]
851 # Dies if any element of @bind is not in [colname => value] format
852 # if bindtype is 'columns'.
853 sub _assert_bindval_matches_bindtype {
854 # my ($self, @bind) = @_;
856 if ($self->{bindtype} eq 'columns') {
858 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
859 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
865 # Fix SQL case, if so requested
867 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
868 # don't touch the argument ... crooked logic, but let's not change it!
869 return $_[0]->{case} ? $_[1] : uc($_[1]);
872 #======================================================================
873 # VALUES, GENERATE, AUTOLOAD
874 #======================================================================
876 # LDNOTE: original code from nwiger, didn't touch code in that section
877 # I feel the AUTOLOAD stuff should not be the default, it should
878 # only be activated on explicit demand by user.
882 my $data = shift || return;
883 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
884 unless ref $data eq 'HASH';
887 foreach my $k ( sort keys %$data ) {
889 local our $Cur_Col_Meta = $k;
890 my ($sql, @bind) = $self->_render_sqla(
893 push @all_bind, @bind;
902 my(@sql, @sqlq, @sqlv);
906 if ($ref eq 'HASH') {
907 for my $k (sort keys %$_) {
910 my $label = $self->_quote($k);
912 # literal SQL with bind
913 my ($sql, @bind) = @$v;
914 $self->_assert_bindval_matches_bindtype(@bind);
915 push @sqlq, "$label = $sql";
917 } elsif ($r eq 'SCALAR') {
918 # literal SQL without bind
919 push @sqlq, "$label = $$v";
921 push @sqlq, "$label = ?";
922 push @sqlv, $self->_bindtype($k, $v);
925 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
926 } elsif ($ref eq 'ARRAY') {
927 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
930 if ($r eq 'ARRAY') { # literal SQL with bind
931 my ($sql, @bind) = @$v;
932 $self->_assert_bindval_matches_bindtype(@bind);
935 } elsif ($r eq 'SCALAR') { # literal SQL without bind
936 # embedded literal SQL
943 push @sql, '(' . join(', ', @sqlq) . ')';
944 } elsif ($ref eq 'SCALAR') {
948 # strings get case twiddled
949 push @sql, $self->_sqlcase($_);
953 my $sql = join ' ', @sql;
955 # this is pretty tricky
956 # if ask for an array, return ($stmt, @bind)
957 # otherwise, s/?/shift @sqlv/ to put it inline
959 return ($sql, @sqlv);
961 1 while $sql =~ s/\?/my $d = shift(@sqlv);
962 ref $d ? $d->[1] : $d/e;
971 # # This allows us to check for a local, then _form, attr
973 # my($name) = $AUTOLOAD =~ /.*::(.+)/;
974 # return $self->generate($name, @_);
985 SQL::Abstract - Generate SQL from Perl data structures
991 my $sql = SQL::Abstract->new;
993 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
995 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
997 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
999 my($stmt, @bind) = $sql->delete($table, \%where);
1001 # Then, use these in your DBI statements
1002 my $sth = $dbh->prepare($stmt);
1003 $sth->execute(@bind);
1005 # Just generate the WHERE clause
1006 my($stmt, @bind) = $sql->where(\%where, \@order);
1008 # Return values in the same order, for hashed queries
1009 # See PERFORMANCE section for more details
1010 my @bind = $sql->values(\%fieldvals);
1014 This module was inspired by the excellent L<DBIx::Abstract>.
1015 However, in using that module I found that what I really wanted
1016 to do was generate SQL, but still retain complete control over my
1017 statement handles and use the DBI interface. So, I set out to
1018 create an abstract SQL generation module.
1020 While based on the concepts used by L<DBIx::Abstract>, there are
1021 several important differences, especially when it comes to WHERE
1022 clauses. I have modified the concepts used to make the SQL easier
1023 to generate from Perl data structures and, IMO, more intuitive.
1024 The underlying idea is for this module to do what you mean, based
1025 on the data structures you provide it. The big advantage is that
1026 you don't have to modify your code every time your data changes,
1027 as this module figures it out.
1029 To begin with, an SQL INSERT is as easy as just specifying a hash
1030 of C<key=value> pairs:
1033 name => 'Jimbo Bobson',
1034 phone => '123-456-7890',
1035 address => '42 Sister Lane',
1036 city => 'St. Louis',
1037 state => 'Louisiana',
1040 The SQL can then be generated with this:
1042 my($stmt, @bind) = $sql->insert('people', \%data);
1044 Which would give you something like this:
1046 $stmt = "INSERT INTO people
1047 (address, city, name, phone, state)
1048 VALUES (?, ?, ?, ?, ?)";
1049 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1050 '123-456-7890', 'Louisiana');
1052 These are then used directly in your DBI code:
1054 my $sth = $dbh->prepare($stmt);
1055 $sth->execute(@bind);
1057 =head2 Inserting and Updating Arrays
1059 If your database has array types (like for example Postgres),
1060 activate the special option C<< array_datatypes => 1 >>
1061 when creating the C<SQL::Abstract> object.
1062 Then you may use an arrayref to insert and update database array types:
1064 my $sql = SQL::Abstract->new(array_datatypes => 1);
1066 planets => [qw/Mercury Venus Earth Mars/]
1069 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1073 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1075 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1078 =head2 Inserting and Updating SQL
1080 In order to apply SQL functions to elements of your C<%data> you may
1081 specify a reference to an arrayref for the given hash value. For example,
1082 if you need to execute the Oracle C<to_date> function on a value, you can
1083 say something like this:
1087 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1090 The first value in the array is the actual SQL. Any other values are
1091 optional and would be included in the bind values array. This gives
1094 my($stmt, @bind) = $sql->insert('people', \%data);
1096 $stmt = "INSERT INTO people (name, date_entered)
1097 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1098 @bind = ('Bill', '03/02/2003');
1100 An UPDATE is just as easy, all you change is the name of the function:
1102 my($stmt, @bind) = $sql->update('people', \%data);
1104 Notice that your C<%data> isn't touched; the module will generate
1105 the appropriately quirky SQL for you automatically. Usually you'll
1106 want to specify a WHERE clause for your UPDATE, though, which is
1107 where handling C<%where> hashes comes in handy...
1109 =head2 Complex where statements
1111 This module can generate pretty complicated WHERE statements
1112 easily. For example, simple C<key=value> pairs are taken to mean
1113 equality, and if you want to see if a field is within a set
1114 of values, you can use an arrayref. Let's say we wanted to
1115 SELECT some data based on this criteria:
1118 requestor => 'inna',
1119 worker => ['nwiger', 'rcwe', 'sfz'],
1120 status => { '!=', 'completed' }
1123 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1125 The above would give you something like this:
1127 $stmt = "SELECT * FROM tickets WHERE
1128 ( requestor = ? ) AND ( status != ? )
1129 AND ( worker = ? OR worker = ? OR worker = ? )";
1130 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1132 Which you could then use in DBI code like so:
1134 my $sth = $dbh->prepare($stmt);
1135 $sth->execute(@bind);
1141 The functions are simple. There's one for each major SQL operation,
1142 and a constructor you use first. The arguments are specified in a
1143 similar order to each function (table, then fields, then a where
1144 clause) to try and simplify things.
1149 =head2 new(option => 'value')
1151 The C<new()> function takes a list of options and values, and returns
1152 a new B<SQL::Abstract> object which can then be used to generate SQL
1153 through the methods below. The options accepted are:
1159 If set to 'lower', then SQL will be generated in all lowercase. By
1160 default SQL is generated in "textbook" case meaning something like:
1162 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1164 Any setting other than 'lower' is ignored.
1168 This determines what the default comparison operator is. By default
1169 it is C<=>, meaning that a hash like this:
1171 %where = (name => 'nwiger', email => 'nate@wiger.org');
1173 Will generate SQL like this:
1175 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1177 However, you may want loose comparisons by default, so if you set
1178 C<cmp> to C<like> you would get SQL such as:
1180 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1182 You can also override the comparsion on an individual basis - see
1183 the huge section on L</"WHERE CLAUSES"> at the bottom.
1185 =item sqltrue, sqlfalse
1187 Expressions for inserting boolean values within SQL statements.
1188 By default these are C<1=1> and C<1=0>. They are used
1189 by the special operators C<-in> and C<-not_in> for generating
1190 correct SQL even when the argument is an empty array (see below).
1194 This determines the default logical operator for multiple WHERE
1195 statements in arrays or hashes. If absent, the default logic is "or"
1196 for arrays, and "and" for hashes. This means that a WHERE
1200 event_date => {'>=', '2/13/99'},
1201 event_date => {'<=', '4/24/03'},
1204 will generate SQL like this:
1206 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1208 This is probably not what you want given this query, though (look
1209 at the dates). To change the "OR" to an "AND", simply specify:
1211 my $sql = SQL::Abstract->new(logic => 'and');
1213 Which will change the above C<WHERE> to:
1215 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1217 The logic can also be changed locally by inserting
1218 a modifier in front of an arrayref :
1220 @where = (-and => [event_date => {'>=', '2/13/99'},
1221 event_date => {'<=', '4/24/03'} ]);
1223 See the L</"WHERE CLAUSES"> section for explanations.
1227 This will automatically convert comparisons using the specified SQL
1228 function for both column and value. This is mostly used with an argument
1229 of C<upper> or C<lower>, so that the SQL will have the effect of
1230 case-insensitive "searches". For example, this:
1232 $sql = SQL::Abstract->new(convert => 'upper');
1233 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1235 Will turn out the following SQL:
1237 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1239 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1240 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1241 not validate this option; it will just pass through what you specify verbatim).
1245 This is a kludge because many databases suck. For example, you can't
1246 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1247 Instead, you have to use C<bind_param()>:
1249 $sth->bind_param(1, 'reg data');
1250 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1252 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1253 which loses track of which field each slot refers to. Fear not.
1255 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1256 Currently, you can specify either C<normal> (default) or C<columns>. If you
1257 specify C<columns>, you will get an array that looks like this:
1259 my $sql = SQL::Abstract->new(bindtype => 'columns');
1260 my($stmt, @bind) = $sql->insert(...);
1263 [ 'column1', 'value1' ],
1264 [ 'column2', 'value2' ],
1265 [ 'column3', 'value3' ],
1268 You can then iterate through this manually, using DBI's C<bind_param()>.
1270 $sth->prepare($stmt);
1273 my($col, $data) = @$_;
1274 if ($col eq 'details' || $col eq 'comments') {
1275 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1276 } elsif ($col eq 'image') {
1277 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1279 $sth->bind_param($i, $data);
1283 $sth->execute; # execute without @bind now
1285 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1286 Basically, the advantage is still that you don't have to care which fields
1287 are or are not included. You could wrap that above C<for> loop in a simple
1288 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1289 get a layer of abstraction over manual SQL specification.
1291 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1292 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1293 will expect the bind values in this format.
1297 This is the character that a table or column name will be quoted
1298 with. By default this is an empty string, but you could set it to
1299 the character C<`>, to generate SQL like this:
1301 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1303 Alternatively, you can supply an array ref of two items, the first being the left
1304 hand quote character, and the second the right hand quote character. For
1305 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1306 that generates SQL like this:
1308 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1310 Quoting is useful if you have tables or columns names that are reserved
1311 words in your database's SQL dialect.
1315 This is the character that separates a table and column name. It is
1316 necessary to specify this when the C<quote_char> option is selected,
1317 so that tables and column names can be individually quoted like this:
1319 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1321 =item injection_guard
1323 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1324 column name specified in a query structure. This is a safety mechanism to avoid
1325 injection attacks when mishandling user input e.g.:
1327 my %condition_as_column_value_pairs = get_values_from_user();
1328 $sqla->select( ... , \%condition_as_column_value_pairs );
1330 If the expression matches an exception is thrown. Note that literal SQL
1331 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1333 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1335 =item array_datatypes
1337 When this option is true, arrayrefs in INSERT or UPDATE are
1338 interpreted as array datatypes and are passed directly
1340 When this option is false, arrayrefs are interpreted
1341 as literal SQL, just like refs to arrayrefs
1342 (but this behavior is for backwards compatibility; when writing
1343 new queries, use the "reference to arrayref" syntax
1349 Takes a reference to a list of "special operators"
1350 to extend the syntax understood by L<SQL::Abstract>.
1351 See section L</"SPECIAL OPERATORS"> for details.
1355 Takes a reference to a list of "unary operators"
1356 to extend the syntax understood by L<SQL::Abstract>.
1357 See section L</"UNARY OPERATORS"> for details.
1363 =head2 insert($table, \@values || \%fieldvals, \%options)
1365 This is the simplest function. You simply give it a table name
1366 and either an arrayref of values or hashref of field/value pairs.
1367 It returns an SQL INSERT statement and a list of bind values.
1368 See the sections on L</"Inserting and Updating Arrays"> and
1369 L</"Inserting and Updating SQL"> for information on how to insert
1370 with those data types.
1372 The optional C<\%options> hash reference may contain additional
1373 options to generate the insert SQL. Currently supported options
1380 Takes either a scalar of raw SQL fields, or an array reference of
1381 field names, and adds on an SQL C<RETURNING> statement at the end.
1382 This allows you to return data generated by the insert statement
1383 (such as row IDs) without performing another C<SELECT> statement.
1384 Note, however, this is not part of the SQL standard and may not
1385 be supported by all database engines.
1389 =head2 update($table, \%fieldvals, \%where)
1391 This takes a table, hashref of field/value pairs, and an optional
1392 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1394 See the sections on L</"Inserting and Updating Arrays"> and
1395 L</"Inserting and Updating SQL"> for information on how to insert
1396 with those data types.
1398 =head2 select($source, $fields, $where, $order)
1400 This returns a SQL SELECT statement and associated list of bind values, as
1401 specified by the arguments :
1407 Specification of the 'FROM' part of the statement.
1408 The argument can be either a plain scalar (interpreted as a table
1409 name, will be quoted), or an arrayref (interpreted as a list
1410 of table names, joined by commas, quoted), or a scalarref
1411 (literal table name, not quoted), or a ref to an arrayref
1412 (list of literal table names, joined by commas, not quoted).
1416 Specification of the list of fields to retrieve from
1418 The argument can be either an arrayref (interpreted as a list
1419 of field names, will be joined by commas and quoted), or a
1420 plain scalar (literal SQL, not quoted).
1421 Please observe that this API is not as flexible as for
1422 the first argument C<$table>, for backwards compatibility reasons.
1426 Optional argument to specify the WHERE part of the query.
1427 The argument is most often a hashref, but can also be
1428 an arrayref or plain scalar --
1429 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1433 Optional argument to specify the ORDER BY part of the query.
1434 The argument can be a scalar, a hashref or an arrayref
1435 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1441 =head2 delete($table, \%where)
1443 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1444 It returns an SQL DELETE statement and list of bind values.
1446 =head2 where(\%where, \@order)
1448 This is used to generate just the WHERE clause. For example,
1449 if you have an arbitrary data structure and know what the
1450 rest of your SQL is going to look like, but want an easy way
1451 to produce a WHERE clause, use this. It returns an SQL WHERE
1452 clause and list of bind values.
1455 =head2 values(\%data)
1457 This just returns the values from the hash C<%data>, in the same
1458 order that would be returned from any of the other above queries.
1459 Using this allows you to markedly speed up your queries if you
1460 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1462 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1464 Warning: This is an experimental method and subject to change.
1466 This returns arbitrarily generated SQL. It's a really basic shortcut.
1467 It will return two different things, depending on return context:
1469 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1470 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1472 These would return the following:
1474 # First calling form
1475 $stmt = "CREATE TABLE test (?, ?)";
1476 @bind = (field1, field2);
1478 # Second calling form
1479 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1481 Depending on what you're trying to do, it's up to you to choose the correct
1482 format. In this example, the second form is what you would want.
1486 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1490 ALTER SESSION SET nls_date_format = 'MM/YY'
1492 You get the idea. Strings get their case twiddled, but everything
1493 else remains verbatim.
1495 =head1 WHERE CLAUSES
1499 This module uses a variation on the idea from L<DBIx::Abstract>. It
1500 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1501 module is that things in arrays are OR'ed, and things in hashes
1504 The easiest way to explain is to show lots of examples. After
1505 each C<%where> hash shown, it is assumed you used:
1507 my($stmt, @bind) = $sql->where(\%where);
1509 However, note that the C<%where> hash can be used directly in any
1510 of the other functions as well, as described above.
1512 =head2 Key-value pairs
1514 So, let's get started. To begin, a simple hash:
1518 status => 'completed'
1521 Is converted to SQL C<key = val> statements:
1523 $stmt = "WHERE user = ? AND status = ?";
1524 @bind = ('nwiger', 'completed');
1526 One common thing I end up doing is having a list of values that
1527 a field can be in. To do this, simply specify a list inside of
1532 status => ['assigned', 'in-progress', 'pending'];
1535 This simple code will create the following:
1537 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1538 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1540 A field associated to an empty arrayref will be considered a
1541 logical false and will generate 0=1.
1543 =head2 Tests for NULL values
1545 If the value part is C<undef> then this is converted to SQL <IS NULL>
1554 $stmt = "WHERE user = ? AND status IS NULL";
1557 To test if a column IS NOT NULL:
1561 status => { '!=', undef },
1564 =head2 Specific comparison operators
1566 If you want to specify a different type of operator for your comparison,
1567 you can use a hashref for a given column:
1571 status => { '!=', 'completed' }
1574 Which would generate:
1576 $stmt = "WHERE user = ? AND status != ?";
1577 @bind = ('nwiger', 'completed');
1579 To test against multiple values, just enclose the values in an arrayref:
1581 status => { '=', ['assigned', 'in-progress', 'pending'] };
1583 Which would give you:
1585 "WHERE status = ? OR status = ? OR status = ?"
1588 The hashref can also contain multiple pairs, in which case it is expanded
1589 into an C<AND> of its elements:
1593 status => { '!=', 'completed', -not_like => 'pending%' }
1596 # Or more dynamically, like from a form
1597 $where{user} = 'nwiger';
1598 $where{status}{'!='} = 'completed';
1599 $where{status}{'-not_like'} = 'pending%';
1601 # Both generate this
1602 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1603 @bind = ('nwiger', 'completed', 'pending%');
1606 To get an OR instead, you can combine it with the arrayref idea:
1610 priority => [ { '=', 2 }, { '>', 5 } ]
1613 Which would generate:
1615 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1616 @bind = ('2', '5', 'nwiger');
1618 If you want to include literal SQL (with or without bind values), just use a
1619 scalar reference or array reference as the value:
1622 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1623 date_expires => { '<' => \"now()" }
1626 Which would generate:
1628 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1629 @bind = ('11/26/2008');
1632 =head2 Logic and nesting operators
1634 In the example above,
1635 there is a subtle trap if you want to say something like
1636 this (notice the C<AND>):
1638 WHERE priority != ? AND priority != ?
1640 Because, in Perl you I<can't> do this:
1642 priority => { '!=', 2, '!=', 1 }
1644 As the second C<!=> key will obliterate the first. The solution
1645 is to use the special C<-modifier> form inside an arrayref:
1647 priority => [ -and => {'!=', 2},
1651 Normally, these would be joined by C<OR>, but the modifier tells it
1652 to use C<AND> instead. (Hint: You can use this in conjunction with the
1653 C<logic> option to C<new()> in order to change the way your queries
1654 work by default.) B<Important:> Note that the C<-modifier> goes
1655 B<INSIDE> the arrayref, as an extra first element. This will
1656 B<NOT> do what you think it might:
1658 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1660 Here is a quick list of equivalencies, since there is some overlap:
1663 status => {'!=', 'completed', 'not like', 'pending%' }
1664 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1667 status => {'=', ['assigned', 'in-progress']}
1668 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1669 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1673 =head2 Special operators : IN, BETWEEN, etc.
1675 You can also use the hashref format to compare a list of fields using the
1676 C<IN> comparison operator, by specifying the list as an arrayref:
1679 status => 'completed',
1680 reportid => { -in => [567, 2335, 2] }
1683 Which would generate:
1685 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1686 @bind = ('completed', '567', '2335', '2');
1688 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1691 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1692 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1693 'sqltrue' (by default : C<1=1>).
1695 In addition to the array you can supply a chunk of literal sql or
1696 literal sql with bind:
1699 customer => { -in => \[
1700 'SELECT cust_id FROM cust WHERE balance > ?',
1703 status => { -in => \'SELECT status_codes FROM states' },
1709 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1710 AND status IN ( SELECT status_codes FROM states )
1716 Another pair of operators is C<-between> and C<-not_between>,
1717 used with an arrayref of two values:
1721 completion_date => {
1722 -not_between => ['2002-10-01', '2003-02-06']
1728 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1730 Just like with C<-in> all plausible combinations of literal SQL
1734 start0 => { -between => [ 1, 2 ] },
1735 start1 => { -between => \["? AND ?", 1, 2] },
1736 start2 => { -between => \"lower(x) AND upper(y)" },
1737 start3 => { -between => [
1739 \["upper(?)", 'stuff' ],
1746 ( start0 BETWEEN ? AND ? )
1747 AND ( start1 BETWEEN ? AND ? )
1748 AND ( start2 BETWEEN lower(x) AND upper(y) )
1749 AND ( start3 BETWEEN lower(x) AND upper(?) )
1751 @bind = (1, 2, 1, 2, 'stuff');
1754 These are the two builtin "special operators"; but the
1755 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1757 =head2 Unary operators: bool
1759 If you wish to test against boolean columns or functions within your
1760 database you can use the C<-bool> and C<-not_bool> operators. For
1761 example to test the column C<is_user> being true and the column
1762 C<is_enabled> being false you would use:-
1766 -not_bool => 'is_enabled',
1771 WHERE is_user AND NOT is_enabled
1773 If a more complex combination is required, testing more conditions,
1774 then you should use the and/or operators:-
1781 -not_bool => 'four',
1787 WHERE one AND two AND three AND NOT four
1790 =head2 Nested conditions, -and/-or prefixes
1792 So far, we've seen how multiple conditions are joined with a top-level
1793 C<AND>. We can change this by putting the different conditions we want in
1794 hashes and then putting those hashes in an array. For example:
1799 status => { -like => ['pending%', 'dispatched'] },
1803 status => 'unassigned',
1807 This data structure would create the following:
1809 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1810 OR ( user = ? AND status = ? ) )";
1811 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1814 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
1815 to change the logic inside :
1821 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1822 -or => { workhrs => {'<', 50}, geo => 'EURO' },
1829 WHERE ( user = ? AND (
1830 ( workhrs > ? AND geo = ? )
1831 OR ( workhrs < ? OR geo = ? )
1834 =head3 Algebraic inconsistency, for historical reasons
1836 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
1837 operator goes C<outside> of the nested structure; whereas when connecting
1838 several constraints on one column, the C<-and> operator goes
1839 C<inside> the arrayref. Here is an example combining both features :
1842 -and => [a => 1, b => 2],
1843 -or => [c => 3, d => 4],
1844 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
1849 WHERE ( ( ( a = ? AND b = ? )
1850 OR ( c = ? OR d = ? )
1851 OR ( e LIKE ? AND e LIKE ? ) ) )
1853 This difference in syntax is unfortunate but must be preserved for
1854 historical reasons. So be careful : the two examples below would
1855 seem algebraically equivalent, but they are not
1857 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
1858 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
1860 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
1861 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
1864 =head2 Literal SQL and value type operators
1866 The basic premise of SQL::Abstract is that in WHERE specifications the "left
1867 side" is a column name and the "right side" is a value (normally rendered as
1868 a placeholder). This holds true for both hashrefs and arrayref pairs as you
1869 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
1870 alter this behavior. There are several ways of doing so.
1874 This is a virtual operator that signals the string to its right side is an
1875 identifier (a column name) and not a value. For example to compare two
1876 columns you would write:
1879 priority => { '<', 2 },
1880 requestor => { -ident => 'submitter' },
1885 $stmt = "WHERE priority < ? AND requestor = submitter";
1888 If you are maintaining legacy code you may see a different construct as
1889 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
1894 This is a virtual operator that signals that the construct to its right side
1895 is a value to be passed to DBI. This is for example necessary when you want
1896 to write a where clause against an array (for RDBMS that support such
1897 datatypes). For example:
1900 array => { -value => [1, 2, 3] }
1905 $stmt = 'WHERE array = ?';
1906 @bind = ([1, 2, 3]);
1908 Note that if you were to simply say:
1914 the result would porbably be not what you wanted:
1916 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
1921 Finally, sometimes only literal SQL will do. To include a random snippet
1922 of SQL verbatim, you specify it as a scalar reference. Consider this only
1923 as a last resort. Usually there is a better way. For example:
1926 priority => { '<', 2 },
1927 requestor => { -in => \'(SELECT name FROM hitmen)' },
1932 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
1935 Note that in this example, you only get one bind parameter back, since
1936 the verbatim SQL is passed as part of the statement.
1940 Never use untrusted input as a literal SQL argument - this is a massive
1941 security risk (there is no way to check literal snippets for SQL
1942 injections and other nastyness). If you need to deal with untrusted input
1943 use literal SQL with placeholders as described next.
1945 =head3 Literal SQL with placeholders and bind values (subqueries)
1947 If the literal SQL to be inserted has placeholders and bind values,
1948 use a reference to an arrayref (yes this is a double reference --
1949 not so common, but perfectly legal Perl). For example, to find a date
1950 in Postgres you can use something like this:
1953 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1958 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1961 Note that you must pass the bind values in the same format as they are returned
1962 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
1963 provide the bind values in the C<< [ column_meta => value ] >> format, where
1964 C<column_meta> is an opaque scalar value; most commonly the column name, but
1965 you can use any scalar value (including references and blessed references),
1966 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
1967 to C<columns> the above example will look like:
1970 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1973 Literal SQL is especially useful for nesting parenthesized clauses in the
1974 main SQL query. Here is a first example :
1976 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1980 bar => \["IN ($sub_stmt)" => @sub_bind],
1985 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1986 WHERE c2 < ? AND c3 LIKE ?))";
1987 @bind = (1234, 100, "foo%");
1989 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1990 are expressed in the same way. Of course the C<$sub_stmt> and
1991 its associated bind values can be generated through a former call
1994 my ($sub_stmt, @sub_bind)
1995 = $sql->select("t1", "c1", {c2 => {"<" => 100},
1996 c3 => {-like => "foo%"}});
1999 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2002 In the examples above, the subquery was used as an operator on a column;
2003 but the same principle also applies for a clause within the main C<%where>
2004 hash, like an EXISTS subquery :
2006 my ($sub_stmt, @sub_bind)
2007 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2008 my %where = ( -and => [
2010 \["EXISTS ($sub_stmt)" => @sub_bind],
2015 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2016 WHERE c1 = ? AND c2 > t0.c0))";
2020 Observe that the condition on C<c2> in the subquery refers to
2021 column C<t0.c0> of the main query : this is I<not> a bind
2022 value, so we have to express it through a scalar ref.
2023 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2024 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2025 what we wanted here.
2027 Finally, here is an example where a subquery is used
2028 for expressing unary negation:
2030 my ($sub_stmt, @sub_bind)
2031 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2032 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2034 lname => {like => '%son%'},
2035 \["NOT ($sub_stmt)" => @sub_bind],
2040 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2041 @bind = ('%son%', 10, 20)
2043 =head3 Deprecated usage of Literal SQL
2045 Below are some examples of archaic use of literal SQL. It is shown only as
2046 reference for those who deal with legacy code. Each example has a much
2047 better, cleaner and safer alternative that users should opt for in new code.
2053 my %where = ( requestor => \'IS NOT NULL' )
2055 $stmt = "WHERE requestor IS NOT NULL"
2057 This used to be the way of generating NULL comparisons, before the handling
2058 of C<undef> got formalized. For new code please use the superior syntax as
2059 described in L</Tests for NULL values>.
2063 my %where = ( requestor => \'= submitter' )
2065 $stmt = "WHERE requestor = submitter"
2067 This used to be the only way to compare columns. Use the superior L</-ident>
2068 method for all new code. For example an identifier declared in such a way
2069 will be properly quoted if L</quote_char> is properly set, while the legacy
2070 form will remain as supplied.
2074 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2076 $stmt = "WHERE completed > ? AND is_ready"
2077 @bind = ('2012-12-21')
2079 Using an empty string literal used to be the only way to express a boolean.
2080 For all new code please use the much more readable
2081 L<-bool|/Unary operators: bool> operator.
2087 These pages could go on for a while, since the nesting of the data
2088 structures this module can handle are pretty much unlimited (the
2089 module implements the C<WHERE> expansion as a recursive function
2090 internally). Your best bet is to "play around" with the module a
2091 little to see how the data structures behave, and choose the best
2092 format for your data based on that.
2094 And of course, all the values above will probably be replaced with
2095 variables gotten from forms or the command line. After all, if you
2096 knew everything ahead of time, you wouldn't have to worry about
2097 dynamically-generating SQL and could just hardwire it into your
2100 =head1 ORDER BY CLAUSES
2102 Some functions take an order by clause. This can either be a scalar (just a
2103 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2104 or an array of either of the two previous forms. Examples:
2106 Given | Will Generate
2107 ----------------------------------------------------------
2109 \'colA DESC' | ORDER BY colA DESC
2111 'colA' | ORDER BY colA
2113 [qw/colA colB/] | ORDER BY colA, colB
2115 {-asc => 'colA'} | ORDER BY colA ASC
2117 {-desc => 'colB'} | ORDER BY colB DESC
2119 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2121 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2124 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2125 { -desc => [qw/colB/], | colC ASC, colD ASC
2126 { -asc => [qw/colC colD/],|
2128 ===========================================================
2132 =head1 SPECIAL OPERATORS
2134 my $sqlmaker = SQL::Abstract->new(special_ops => [
2138 my ($self, $field, $op, $arg) = @_;
2144 handler => 'method_name',
2148 A "special operator" is a SQL syntactic clause that can be
2149 applied to a field, instead of a usual binary operator.
2152 WHERE field IN (?, ?, ?)
2153 WHERE field BETWEEN ? AND ?
2154 WHERE MATCH(field) AGAINST (?, ?)
2156 Special operators IN and BETWEEN are fairly standard and therefore
2157 are builtin within C<SQL::Abstract> (as the overridable methods
2158 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2159 like the MATCH .. AGAINST example above which is specific to MySQL,
2160 you can write your own operator handlers - supply a C<special_ops>
2161 argument to the C<new> method. That argument takes an arrayref of
2162 operator definitions; each operator definition is a hashref with two
2169 the regular expression to match the operator
2173 Either a coderef or a plain scalar method name. In both cases
2174 the expected return is C<< ($sql, @bind) >>.
2176 When supplied with a method name, it is simply called on the
2177 L<SQL::Abstract/> object as:
2179 $self->$method_name ($field, $op, $arg)
2183 $op is the part that matched the handler regex
2184 $field is the LHS of the operator
2187 When supplied with a coderef, it is called as:
2189 $coderef->($self, $field, $op, $arg)
2194 For example, here is an implementation
2195 of the MATCH .. AGAINST syntax for MySQL
2197 my $sqlmaker = SQL::Abstract->new(special_ops => [
2199 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2200 {regex => qr/^match$/i,
2202 my ($self, $field, $op, $arg) = @_;
2203 $arg = [$arg] if not ref $arg;
2204 my $label = $self->_quote($field);
2205 my ($placeholder) = $self->_convert('?');
2206 my $placeholders = join ", ", (($placeholder) x @$arg);
2207 my $sql = $self->_sqlcase('match') . " ($label) "
2208 . $self->_sqlcase('against') . " ($placeholders) ";
2209 my @bind = $self->_bindtype($field, @$arg);
2210 return ($sql, @bind);
2217 =head1 UNARY OPERATORS
2219 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2223 my ($self, $op, $arg) = @_;
2229 handler => 'method_name',
2233 A "unary operator" is a SQL syntactic clause that can be
2234 applied to a field - the operator goes before the field
2236 You can write your own operator handlers - supply a C<unary_ops>
2237 argument to the C<new> method. That argument takes an arrayref of
2238 operator definitions; each operator definition is a hashref with two
2245 the regular expression to match the operator
2249 Either a coderef or a plain scalar method name. In both cases
2250 the expected return is C<< $sql >>.
2252 When supplied with a method name, it is simply called on the
2253 L<SQL::Abstract/> object as:
2255 $self->$method_name ($op, $arg)
2259 $op is the part that matched the handler regex
2260 $arg is the RHS or argument of the operator
2262 When supplied with a coderef, it is called as:
2264 $coderef->($self, $op, $arg)
2272 Thanks to some benchmarking by Mark Stosberg, it turns out that
2273 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2274 I must admit this wasn't an intentional design issue, but it's a
2275 byproduct of the fact that you get to control your C<DBI> handles
2278 To maximize performance, use a code snippet like the following:
2280 # prepare a statement handle using the first row
2281 # and then reuse it for the rest of the rows
2283 for my $href (@array_of_hashrefs) {
2284 $stmt ||= $sql->insert('table', $href);
2285 $sth ||= $dbh->prepare($stmt);
2286 $sth->execute($sql->values($href));
2289 The reason this works is because the keys in your C<$href> are sorted
2290 internally by B<SQL::Abstract>. Thus, as long as your data retains
2291 the same structure, you only have to generate the SQL the first time
2292 around. On subsequent queries, simply use the C<values> function provided
2293 by this module to return your values in the correct order.
2295 However this depends on the values having the same type - if, for
2296 example, the values of a where clause may either have values
2297 (resulting in sql of the form C<column = ?> with a single bind
2298 value), or alternatively the values might be C<undef> (resulting in
2299 sql of the form C<column IS NULL> with no bind value) then the
2300 caching technique suggested will not work.
2304 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2305 really like this part (I do, at least). Building up a complex query
2306 can be as simple as the following:
2310 use CGI::FormBuilder;
2313 my $form = CGI::FormBuilder->new(...);
2314 my $sql = SQL::Abstract->new;
2316 if ($form->submitted) {
2317 my $field = $form->field;
2318 my $id = delete $field->{id};
2319 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2322 Of course, you would still have to connect using C<DBI> to run the
2323 query, but the point is that if you make your form look like your
2324 table, the actual query script can be extremely simplistic.
2326 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2327 a fast interface to returning and formatting data. I frequently
2328 use these three modules together to write complex database query
2329 apps in under 50 lines.
2335 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2337 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2343 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2344 Great care has been taken to preserve the I<published> behavior
2345 documented in previous versions in the 1.* family; however,
2346 some features that were previously undocumented, or behaved
2347 differently from the documentation, had to be changed in order
2348 to clarify the semantics. Hence, client code that was relying
2349 on some dark areas of C<SQL::Abstract> v1.*
2350 B<might behave differently> in v1.50.
2352 The main changes are :
2358 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2362 support for the { operator => \"..." } construct (to embed literal SQL)
2366 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2370 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2374 defensive programming : check arguments
2378 fixed bug with global logic, which was previously implemented
2379 through global variables yielding side-effects. Prior versions would
2380 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2381 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2382 Now this is interpreted
2383 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2388 fixed semantics of _bindtype on array args
2392 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2393 we just avoid shifting arrays within that tree.
2397 dropped the C<_modlogic> function
2401 =head1 ACKNOWLEDGEMENTS
2403 There are a number of individuals that have really helped out with
2404 this module. Unfortunately, most of them submitted bugs via CPAN
2405 so I have no idea who they are! But the people I do know are:
2407 Ash Berlin (order_by hash term support)
2408 Matt Trout (DBIx::Class support)
2409 Mark Stosberg (benchmarking)
2410 Chas Owens (initial "IN" operator support)
2411 Philip Collins (per-field SQL functions)
2412 Eric Kolve (hashref "AND" support)
2413 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2414 Dan Kubb (support for "quote_char" and "name_sep")
2415 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2416 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2417 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2418 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2419 Oliver Charles (support for "RETURNING" after "INSERT")
2425 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2429 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2431 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2433 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2434 While not an official support venue, C<DBIx::Class> makes heavy use of
2435 C<SQL::Abstract>, and as such list members there are very familiar with
2436 how to create queries.
2440 This module is free software; you may copy this under the same
2441 terms as perl itself (either the GNU General Public License or
2442 the Artistic License)