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, undef, $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 => @_) }
342 my ($table, $fields, $where, $order) = @_;
344 my $source_dq = $self->_source_to_dq(@_);
346 my $ordered_dq = do {
348 $self->_order_by_to_dq($order, undef, $source_dq);
354 return $self->_select_list_to_dq($fields, $ordered_dq);
357 sub _select_list_to_dq {
358 my ($self, $fields, $from_dq) = @_;
364 select => [ $self->_select_field_list_to_dq($fields) ],
369 sub _select_field_list_to_dq {
370 my ($self, $fields) = @_;
371 map $self->_select_field_to_dq($_),
372 ref($fields) eq 'ARRAY' ? @$fields : $fields;
375 sub _select_field_to_dq {
376 my ($self, $field) = @_;
378 ? $self->_literal_to_dq($$field)
379 : $self->_ident_to_dq($field)
382 #======================================================================
384 #======================================================================
387 sub delete { shift->_render_sqla(delete => @_) }
390 my ($self, $table, $where) = @_;
393 target => $self->_table_to_dq($table),
394 where => $self->_where_to_dq($where),
399 #======================================================================
401 #======================================================================
405 # Finally, a separate routine just to handle WHERE clauses
407 my ($self, $where, $order) = @_;
413 ($sql, @bind) = $self->_recurse_where($where) if defined($where);
414 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
418 $sql .= $self->_order_by($order);
421 return wantarray ? ($sql, @bind) : $sql;
424 sub _recurse_where { shift->_render_sqla(where => @_) }
427 my ($self, $where, $logic) = @_;
429 return undef unless defined($where);
431 # turn the convert misfeature on - only used in WHERE clauses
432 local $self->{where_convert} = $self->{convert};
434 return $self->_expr_to_dq($where, $logic);
438 my ($self, $where, $logic) = @_;
440 if (ref($where) eq 'ARRAY') {
441 return $self->_expr_to_dq_ARRAYREF($where, $logic);
442 } elsif (ref($where) eq 'HASH') {
443 return $self->_expr_to_dq_HASHREF($where, $logic);
445 ref($where) eq 'SCALAR'
446 or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
448 return $self->_literal_to_dq($$where);
449 } elsif (!ref($where) or Scalar::Util::blessed($where)) {
450 return $self->_value_to_dq($where);
452 die "Can't handle $where";
455 sub _expr_to_dq_ARRAYREF {
456 my ($self, $where, $logic) = @_;
458 $logic = uc($logic || $self->{logic} || 'OR');
459 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
461 return unless @$where;
463 my ($first, @rest) = @$where;
465 return $self->_expr_to_dq($first) unless @rest;
469 $self->_where_hashpair_to_dq($first => shift(@rest));
471 $self->_expr_to_dq($first);
475 return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
478 $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
482 sub _expr_to_dq_HASHREF {
483 my ($self, $where, $logic) = @_;
485 $logic = uc($logic) if $logic;
488 $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
491 return $dq[0] unless @dq > 1;
493 my $final = pop(@dq);
495 foreach my $dq (reverse @dq) {
496 $final = $self->_op_to_dq($logic||'AND', $dq, $final);
502 sub _where_to_dq_SCALAR {
503 shift->_value_to_dq(@_);
507 my ($self, $op, $v) = @_;
508 my @args = map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v);
510 # Ok. Welcome to stupid compat code land. An SQLA expr that would in the
511 # absence of this piece of crazy render to:
517 # { -a => { -b => { -c => $x } } }
519 # actually needs to render to:
523 # because SQL sucks, and databases are hateful, and SQLA is Just That DWIM.
525 # However, we don't want to catch 'A(x)' and turn it into 'A x'
527 # So the way we deal with this is to go through all our arguments, and
528 # then if the argument is -also- an apply, i.e. at least 'B', we check
529 # its arguments - and if there's only one of them, and that isn't an apply,
530 # then we convert to the bareword form. The end result should be:
533 # A( B( x ) ) -> A( B x )
534 # A( B( C( x ) ) ) -> A( B( C x ) )
535 # A( B( x + y ) ) -> A( B( x + y ) )
536 # A( B( x, y ) ) -> A( B( x, y ) )
538 # If this turns out not to be quite right, please add additional tests
539 # to either 01generate.t or 02where.t *and* update this comment.
541 foreach my $arg (@args) {
543 $arg->{type} eq DQ_OPERATOR and $arg->{operator}{'SQL.Naive'} eq 'apply'
544 and @{$arg->{args}} == 2 and $arg->{args}[1]{type} ne DQ_OPERATOR
546 $arg->{operator}{'SQL.Naive'} = (shift @{$arg->{args}})->{elements}->[0];
549 $self->_assert_pass_injection_guard($op);
550 return $self->_op_to_dq(
551 apply => $self->_ident_to_dq($op), @args
555 sub _where_hashpair_to_dq {
556 my ($self, $k, $v, $logic) = @_;
558 if ($k =~ /^-(.*)/s) {
560 if ($op eq 'AND' or $op eq 'OR') {
561 return $self->_expr_to_dq($v, $op);
562 } elsif ($op eq 'NEST') {
563 return $self->_expr_to_dq($v);
564 } elsif ($op eq 'NOT') {
565 return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
566 } elsif ($op eq 'BOOL') {
567 return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
568 } elsif ($op eq 'NOT_BOOL') {
569 return $self->_op_to_dq(
570 NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
572 } elsif ($op eq 'IDENT') {
573 return $self->_ident_to_dq($v);
574 } elsif ($op eq 'VALUE') {
575 return $self->_value_to_dq($v);
576 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
577 die "Use of [and|or|nest]_N modifiers is no longer supported";
579 return $self->_apply_to_dq($op, $v);
582 local our $Cur_Col_Meta = $k;
583 if (ref($v) eq 'ARRAY') {
585 return $self->_literal_to_dq($self->{sqlfalse});
586 } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
587 return $self->_expr_to_dq_ARRAYREF([
588 map +{ $k => $_ }, @{$v}[1..$#$v]
591 return $self->_expr_to_dq_ARRAYREF([
592 map +{ $k => $_ }, @$v
594 } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
598 parts => [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]
601 my ($op, $rhs) = do {
602 if (ref($v) eq 'HASH') {
604 return $self->_expr_to_dq_ARRAYREF([
605 map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
608 my ($op, $value) = %$v;
609 s/^-//, s/_/ /g for $op;
610 if ($op =~ /^(and|or)$/i) {
611 return $self->_expr_to_dq({ $k => $value }, $op);
613 my $special_op = List::Util::first {$op =~ $_->{regex}}
614 @{$self->{special_ops}}
616 return $self->_literal_to_dq(
617 [ $self->${\$special_op->{handler}}($k, $op, $value) ]
619 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
620 die "Use of [and|or|nest]_N modifiers is no longer supported";
627 if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
628 if (ref($rhs) ne 'ARRAY') {
630 # have to add parens if none present because -in => \"SELECT ..."
631 # got documented. mst hates everything.
632 if (ref($rhs) eq 'SCALAR') {
634 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
637 my ($x, @rest) = @{$$rhs};
638 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
639 $rhs = \[ $x, @rest ];
642 return $self->_op_to_dq(
643 $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
646 return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
647 return $self->_op_to_dq(
648 $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
650 } elsif ($op =~ s/^NOT (?!LIKE)//) {
651 return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
652 } elsif ($op eq 'IDENT') {
653 return $self->_op_to_dq(
654 $self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
656 } elsif ($op eq 'VALUE') {
657 return $self->_op_to_dq(
658 $self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
660 } elsif (!defined($rhs)) {
662 if ($op eq '=' or $op eq 'LIKE') {
664 } elsif ($op eq '!=') {
667 die "Can't do undef -> NULL transform for operator ${op}";
670 return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
672 if (ref($rhs) eq 'ARRAY') {
674 return $self->_literal_to_dq(
675 $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
677 } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
678 return $self->_expr_to_dq_ARRAYREF([
679 map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
681 } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
682 die "Use of [and|or|nest]_N modifiers is no longer supported";
684 return $self->_expr_to_dq_ARRAYREF([
685 map +{ $k => { $op => $_ } }, @$rhs
688 return $self->_op_to_dq(
689 $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
694 #======================================================================
696 #======================================================================
699 my ($self, $arg) = @_;
700 if (my $dq = $self->_order_by_to_dq($arg)) {
701 # SQLA generates ' ORDER BY foo'. The hilarity.
703 ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
704 : ' '.$self->_render_dq($dq);
710 sub _order_by_to_dq {
711 my ($self, $arg, $dir, $from) = @_;
717 ($dir ? (direction => $dir) : ()),
718 ($from ? (from => $from) : ()),
722 $dq->{by} = $self->_ident_to_dq($arg);
723 } elsif (ref($arg) eq 'ARRAY') {
725 local our $Order_Inner unless our $Order_Recursing;
726 local $Order_Recursing = 1;
728 foreach my $member (@$arg) {
730 my $next = $self->_order_by_to_dq($member, $dir, $from);
732 $inner->{from} = $next if $inner;
733 $inner = $Order_Inner || $next;
735 $Order_Inner = $inner;
737 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
738 $dq->{by} = $self->_literal_to_dq($$arg);
739 } elsif (ref($arg) eq 'SCALAR') {
740 $dq->{by} = $self->_literal_to_dq($$arg);
741 } elsif (ref($arg) eq 'HASH') {
742 my ($key, $val, @rest) = %$arg;
746 if (@rest or not $key =~ /^-(desc|asc)/i) {
747 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
750 return $self->_order_by_to_dq($val, $dir, $from);
752 die "Can't handle $arg in _order_by_to_dq";
757 #======================================================================
758 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
759 #======================================================================
761 sub _table { shift->_render_sqla(table => @_) }
764 my ($self, $from) = @_;
765 if (ref($from) eq 'ARRAY') {
766 die "Empty FROM list" unless my @f = @$from;
767 my $dq = $self->_table_to_dq(shift @f);
768 while (my $x = shift @f) {
771 join => [ $dq, $self->_table_to_dq($x) ]
775 } elsif (ref($from) eq 'SCALAR') {
782 $self->_ident_to_dq($from);
787 #======================================================================
789 #======================================================================
791 # highly optimized, as it's called way too often
793 # my ($self, $label) = @_;
795 return '' unless defined $_[1];
796 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
798 unless ($_[0]->{quote_char}) {
799 $_[0]->_assert_pass_injection_guard($_[1]);
803 my $qref = ref $_[0]->{quote_char};
806 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
808 elsif ($qref eq 'ARRAY') {
809 ($l, $r) = @{$_[0]->{quote_char}};
812 puke "Unsupported quote_char format: $_[0]->{quote_char}";
815 # parts containing * are naturally unquoted
816 return join( $_[0]->{name_sep}||'', map
817 { $_ eq '*' ? $_ : $l . $_ . $r }
818 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
823 # Conversion, if applicable
825 #my ($self, $arg) = @_;
827 # LDNOTE : modified the previous implementation below because
828 # it was not consistent : the first "return" is always an array,
829 # the second "return" is context-dependent. Anyway, _convert
830 # seems always used with just a single argument, so make it a
832 # return @_ unless $self->{convert};
833 # my $conv = $self->_sqlcase($self->{convert});
834 # my @ret = map { $conv.'('.$_.')' } @_;
835 # return wantarray ? @ret : $ret[0];
836 if ($_[0]->{convert}) {
837 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
844 #my ($self, $col, @vals) = @_;
846 #LDNOTE : changed original implementation below because it did not make
847 # sense when bindtype eq 'columns' and @vals > 1.
848 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
850 # called often - tighten code
851 return $_[0]->{bindtype} eq 'columns'
852 ? map {[$_[1], $_]} @_[2 .. $#_]
857 # Dies if any element of @bind is not in [colname => value] format
858 # if bindtype is 'columns'.
859 sub _assert_bindval_matches_bindtype {
860 # my ($self, @bind) = @_;
862 if ($self->{bindtype} eq 'columns') {
864 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
865 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
871 # Fix SQL case, if so requested
873 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
874 # don't touch the argument ... crooked logic, but let's not change it!
875 return $_[0]->{case} ? $_[1] : uc($_[1]);
878 #======================================================================
879 # VALUES, GENERATE, AUTOLOAD
880 #======================================================================
882 # LDNOTE: original code from nwiger, didn't touch code in that section
883 # I feel the AUTOLOAD stuff should not be the default, it should
884 # only be activated on explicit demand by user.
888 my $data = shift || return;
889 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
890 unless ref $data eq 'HASH';
893 foreach my $k ( sort keys %$data ) {
895 local our $Cur_Col_Meta = $k;
896 my ($sql, @bind) = $self->_render_sqla(
899 push @all_bind, @bind;
908 my(@sql, @sqlq, @sqlv);
912 if ($ref eq 'HASH') {
913 for my $k (sort keys %$_) {
916 my $label = $self->_quote($k);
918 # literal SQL with bind
919 my ($sql, @bind) = @$v;
920 $self->_assert_bindval_matches_bindtype(@bind);
921 push @sqlq, "$label = $sql";
923 } elsif ($r eq 'SCALAR') {
924 # literal SQL without bind
925 push @sqlq, "$label = $$v";
927 push @sqlq, "$label = ?";
928 push @sqlv, $self->_bindtype($k, $v);
931 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
932 } elsif ($ref eq 'ARRAY') {
933 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
936 if ($r eq 'ARRAY') { # literal SQL with bind
937 my ($sql, @bind) = @$v;
938 $self->_assert_bindval_matches_bindtype(@bind);
941 } elsif ($r eq 'SCALAR') { # literal SQL without bind
942 # embedded literal SQL
949 push @sql, '(' . join(', ', @sqlq) . ')';
950 } elsif ($ref eq 'SCALAR') {
954 # strings get case twiddled
955 push @sql, $self->_sqlcase($_);
959 my $sql = join ' ', @sql;
961 # this is pretty tricky
962 # if ask for an array, return ($stmt, @bind)
963 # otherwise, s/?/shift @sqlv/ to put it inline
965 return ($sql, @sqlv);
967 1 while $sql =~ s/\?/my $d = shift(@sqlv);
968 ref $d ? $d->[1] : $d/e;
977 # # This allows us to check for a local, then _form, attr
979 # my($name) = $AUTOLOAD =~ /.*::(.+)/;
980 # return $self->generate($name, @_);
991 SQL::Abstract - Generate SQL from Perl data structures
997 my $sql = SQL::Abstract->new;
999 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1001 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1003 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1005 my($stmt, @bind) = $sql->delete($table, \%where);
1007 # Then, use these in your DBI statements
1008 my $sth = $dbh->prepare($stmt);
1009 $sth->execute(@bind);
1011 # Just generate the WHERE clause
1012 my($stmt, @bind) = $sql->where(\%where, \@order);
1014 # Return values in the same order, for hashed queries
1015 # See PERFORMANCE section for more details
1016 my @bind = $sql->values(\%fieldvals);
1020 This module was inspired by the excellent L<DBIx::Abstract>.
1021 However, in using that module I found that what I really wanted
1022 to do was generate SQL, but still retain complete control over my
1023 statement handles and use the DBI interface. So, I set out to
1024 create an abstract SQL generation module.
1026 While based on the concepts used by L<DBIx::Abstract>, there are
1027 several important differences, especially when it comes to WHERE
1028 clauses. I have modified the concepts used to make the SQL easier
1029 to generate from Perl data structures and, IMO, more intuitive.
1030 The underlying idea is for this module to do what you mean, based
1031 on the data structures you provide it. The big advantage is that
1032 you don't have to modify your code every time your data changes,
1033 as this module figures it out.
1035 To begin with, an SQL INSERT is as easy as just specifying a hash
1036 of C<key=value> pairs:
1039 name => 'Jimbo Bobson',
1040 phone => '123-456-7890',
1041 address => '42 Sister Lane',
1042 city => 'St. Louis',
1043 state => 'Louisiana',
1046 The SQL can then be generated with this:
1048 my($stmt, @bind) = $sql->insert('people', \%data);
1050 Which would give you something like this:
1052 $stmt = "INSERT INTO people
1053 (address, city, name, phone, state)
1054 VALUES (?, ?, ?, ?, ?)";
1055 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1056 '123-456-7890', 'Louisiana');
1058 These are then used directly in your DBI code:
1060 my $sth = $dbh->prepare($stmt);
1061 $sth->execute(@bind);
1063 =head2 Inserting and Updating Arrays
1065 If your database has array types (like for example Postgres),
1066 activate the special option C<< array_datatypes => 1 >>
1067 when creating the C<SQL::Abstract> object.
1068 Then you may use an arrayref to insert and update database array types:
1070 my $sql = SQL::Abstract->new(array_datatypes => 1);
1072 planets => [qw/Mercury Venus Earth Mars/]
1075 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1079 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1081 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1084 =head2 Inserting and Updating SQL
1086 In order to apply SQL functions to elements of your C<%data> you may
1087 specify a reference to an arrayref for the given hash value. For example,
1088 if you need to execute the Oracle C<to_date> function on a value, you can
1089 say something like this:
1093 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1096 The first value in the array is the actual SQL. Any other values are
1097 optional and would be included in the bind values array. This gives
1100 my($stmt, @bind) = $sql->insert('people', \%data);
1102 $stmt = "INSERT INTO people (name, date_entered)
1103 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1104 @bind = ('Bill', '03/02/2003');
1106 An UPDATE is just as easy, all you change is the name of the function:
1108 my($stmt, @bind) = $sql->update('people', \%data);
1110 Notice that your C<%data> isn't touched; the module will generate
1111 the appropriately quirky SQL for you automatically. Usually you'll
1112 want to specify a WHERE clause for your UPDATE, though, which is
1113 where handling C<%where> hashes comes in handy...
1115 =head2 Complex where statements
1117 This module can generate pretty complicated WHERE statements
1118 easily. For example, simple C<key=value> pairs are taken to mean
1119 equality, and if you want to see if a field is within a set
1120 of values, you can use an arrayref. Let's say we wanted to
1121 SELECT some data based on this criteria:
1124 requestor => 'inna',
1125 worker => ['nwiger', 'rcwe', 'sfz'],
1126 status => { '!=', 'completed' }
1129 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1131 The above would give you something like this:
1133 $stmt = "SELECT * FROM tickets WHERE
1134 ( requestor = ? ) AND ( status != ? )
1135 AND ( worker = ? OR worker = ? OR worker = ? )";
1136 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1138 Which you could then use in DBI code like so:
1140 my $sth = $dbh->prepare($stmt);
1141 $sth->execute(@bind);
1147 The functions are simple. There's one for each major SQL operation,
1148 and a constructor you use first. The arguments are specified in a
1149 similar order to each function (table, then fields, then a where
1150 clause) to try and simplify things.
1155 =head2 new(option => 'value')
1157 The C<new()> function takes a list of options and values, and returns
1158 a new B<SQL::Abstract> object which can then be used to generate SQL
1159 through the methods below. The options accepted are:
1165 If set to 'lower', then SQL will be generated in all lowercase. By
1166 default SQL is generated in "textbook" case meaning something like:
1168 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1170 Any setting other than 'lower' is ignored.
1174 This determines what the default comparison operator is. By default
1175 it is C<=>, meaning that a hash like this:
1177 %where = (name => 'nwiger', email => 'nate@wiger.org');
1179 Will generate SQL like this:
1181 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1183 However, you may want loose comparisons by default, so if you set
1184 C<cmp> to C<like> you would get SQL such as:
1186 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1188 You can also override the comparsion on an individual basis - see
1189 the huge section on L</"WHERE CLAUSES"> at the bottom.
1191 =item sqltrue, sqlfalse
1193 Expressions for inserting boolean values within SQL statements.
1194 By default these are C<1=1> and C<1=0>. They are used
1195 by the special operators C<-in> and C<-not_in> for generating
1196 correct SQL even when the argument is an empty array (see below).
1200 This determines the default logical operator for multiple WHERE
1201 statements in arrays or hashes. If absent, the default logic is "or"
1202 for arrays, and "and" for hashes. This means that a WHERE
1206 event_date => {'>=', '2/13/99'},
1207 event_date => {'<=', '4/24/03'},
1210 will generate SQL like this:
1212 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1214 This is probably not what you want given this query, though (look
1215 at the dates). To change the "OR" to an "AND", simply specify:
1217 my $sql = SQL::Abstract->new(logic => 'and');
1219 Which will change the above C<WHERE> to:
1221 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1223 The logic can also be changed locally by inserting
1224 a modifier in front of an arrayref :
1226 @where = (-and => [event_date => {'>=', '2/13/99'},
1227 event_date => {'<=', '4/24/03'} ]);
1229 See the L</"WHERE CLAUSES"> section for explanations.
1233 This will automatically convert comparisons using the specified SQL
1234 function for both column and value. This is mostly used with an argument
1235 of C<upper> or C<lower>, so that the SQL will have the effect of
1236 case-insensitive "searches". For example, this:
1238 $sql = SQL::Abstract->new(convert => 'upper');
1239 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1241 Will turn out the following SQL:
1243 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1245 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1246 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1247 not validate this option; it will just pass through what you specify verbatim).
1251 This is a kludge because many databases suck. For example, you can't
1252 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1253 Instead, you have to use C<bind_param()>:
1255 $sth->bind_param(1, 'reg data');
1256 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1258 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1259 which loses track of which field each slot refers to. Fear not.
1261 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1262 Currently, you can specify either C<normal> (default) or C<columns>. If you
1263 specify C<columns>, you will get an array that looks like this:
1265 my $sql = SQL::Abstract->new(bindtype => 'columns');
1266 my($stmt, @bind) = $sql->insert(...);
1269 [ 'column1', 'value1' ],
1270 [ 'column2', 'value2' ],
1271 [ 'column3', 'value3' ],
1274 You can then iterate through this manually, using DBI's C<bind_param()>.
1276 $sth->prepare($stmt);
1279 my($col, $data) = @$_;
1280 if ($col eq 'details' || $col eq 'comments') {
1281 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1282 } elsif ($col eq 'image') {
1283 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1285 $sth->bind_param($i, $data);
1289 $sth->execute; # execute without @bind now
1291 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1292 Basically, the advantage is still that you don't have to care which fields
1293 are or are not included. You could wrap that above C<for> loop in a simple
1294 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1295 get a layer of abstraction over manual SQL specification.
1297 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1298 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1299 will expect the bind values in this format.
1303 This is the character that a table or column name will be quoted
1304 with. By default this is an empty string, but you could set it to
1305 the character C<`>, to generate SQL like this:
1307 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1309 Alternatively, you can supply an array ref of two items, the first being the left
1310 hand quote character, and the second the right hand quote character. For
1311 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1312 that generates SQL like this:
1314 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1316 Quoting is useful if you have tables or columns names that are reserved
1317 words in your database's SQL dialect.
1321 This is the character that separates a table and column name. It is
1322 necessary to specify this when the C<quote_char> option is selected,
1323 so that tables and column names can be individually quoted like this:
1325 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1327 =item injection_guard
1329 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1330 column name specified in a query structure. This is a safety mechanism to avoid
1331 injection attacks when mishandling user input e.g.:
1333 my %condition_as_column_value_pairs = get_values_from_user();
1334 $sqla->select( ... , \%condition_as_column_value_pairs );
1336 If the expression matches an exception is thrown. Note that literal SQL
1337 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1339 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1341 =item array_datatypes
1343 When this option is true, arrayrefs in INSERT or UPDATE are
1344 interpreted as array datatypes and are passed directly
1346 When this option is false, arrayrefs are interpreted
1347 as literal SQL, just like refs to arrayrefs
1348 (but this behavior is for backwards compatibility; when writing
1349 new queries, use the "reference to arrayref" syntax
1355 Takes a reference to a list of "special operators"
1356 to extend the syntax understood by L<SQL::Abstract>.
1357 See section L</"SPECIAL OPERATORS"> for details.
1361 Takes a reference to a list of "unary operators"
1362 to extend the syntax understood by L<SQL::Abstract>.
1363 See section L</"UNARY OPERATORS"> for details.
1369 =head2 insert($table, \@values || \%fieldvals, \%options)
1371 This is the simplest function. You simply give it a table name
1372 and either an arrayref of values or hashref of field/value pairs.
1373 It returns an SQL INSERT statement and a list of bind values.
1374 See the sections on L</"Inserting and Updating Arrays"> and
1375 L</"Inserting and Updating SQL"> for information on how to insert
1376 with those data types.
1378 The optional C<\%options> hash reference may contain additional
1379 options to generate the insert SQL. Currently supported options
1386 Takes either a scalar of raw SQL fields, or an array reference of
1387 field names, and adds on an SQL C<RETURNING> statement at the end.
1388 This allows you to return data generated by the insert statement
1389 (such as row IDs) without performing another C<SELECT> statement.
1390 Note, however, this is not part of the SQL standard and may not
1391 be supported by all database engines.
1395 =head2 update($table, \%fieldvals, \%where)
1397 This takes a table, hashref of field/value pairs, and an optional
1398 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1400 See the sections on L</"Inserting and Updating Arrays"> and
1401 L</"Inserting and Updating SQL"> for information on how to insert
1402 with those data types.
1404 =head2 select($source, $fields, $where, $order)
1406 This returns a SQL SELECT statement and associated list of bind values, as
1407 specified by the arguments :
1413 Specification of the 'FROM' part of the statement.
1414 The argument can be either a plain scalar (interpreted as a table
1415 name, will be quoted), or an arrayref (interpreted as a list
1416 of table names, joined by commas, quoted), or a scalarref
1417 (literal table name, not quoted), or a ref to an arrayref
1418 (list of literal table names, joined by commas, not quoted).
1422 Specification of the list of fields to retrieve from
1424 The argument can be either an arrayref (interpreted as a list
1425 of field names, will be joined by commas and quoted), or a
1426 plain scalar (literal SQL, not quoted).
1427 Please observe that this API is not as flexible as for
1428 the first argument C<$table>, for backwards compatibility reasons.
1432 Optional argument to specify the WHERE part of the query.
1433 The argument is most often a hashref, but can also be
1434 an arrayref or plain scalar --
1435 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1439 Optional argument to specify the ORDER BY part of the query.
1440 The argument can be a scalar, a hashref or an arrayref
1441 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1447 =head2 delete($table, \%where)
1449 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1450 It returns an SQL DELETE statement and list of bind values.
1452 =head2 where(\%where, \@order)
1454 This is used to generate just the WHERE clause. For example,
1455 if you have an arbitrary data structure and know what the
1456 rest of your SQL is going to look like, but want an easy way
1457 to produce a WHERE clause, use this. It returns an SQL WHERE
1458 clause and list of bind values.
1461 =head2 values(\%data)
1463 This just returns the values from the hash C<%data>, in the same
1464 order that would be returned from any of the other above queries.
1465 Using this allows you to markedly speed up your queries if you
1466 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1468 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1470 Warning: This is an experimental method and subject to change.
1472 This returns arbitrarily generated SQL. It's a really basic shortcut.
1473 It will return two different things, depending on return context:
1475 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1476 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1478 These would return the following:
1480 # First calling form
1481 $stmt = "CREATE TABLE test (?, ?)";
1482 @bind = (field1, field2);
1484 # Second calling form
1485 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1487 Depending on what you're trying to do, it's up to you to choose the correct
1488 format. In this example, the second form is what you would want.
1492 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1496 ALTER SESSION SET nls_date_format = 'MM/YY'
1498 You get the idea. Strings get their case twiddled, but everything
1499 else remains verbatim.
1501 =head1 WHERE CLAUSES
1505 This module uses a variation on the idea from L<DBIx::Abstract>. It
1506 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1507 module is that things in arrays are OR'ed, and things in hashes
1510 The easiest way to explain is to show lots of examples. After
1511 each C<%where> hash shown, it is assumed you used:
1513 my($stmt, @bind) = $sql->where(\%where);
1515 However, note that the C<%where> hash can be used directly in any
1516 of the other functions as well, as described above.
1518 =head2 Key-value pairs
1520 So, let's get started. To begin, a simple hash:
1524 status => 'completed'
1527 Is converted to SQL C<key = val> statements:
1529 $stmt = "WHERE user = ? AND status = ?";
1530 @bind = ('nwiger', 'completed');
1532 One common thing I end up doing is having a list of values that
1533 a field can be in. To do this, simply specify a list inside of
1538 status => ['assigned', 'in-progress', 'pending'];
1541 This simple code will create the following:
1543 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1544 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1546 A field associated to an empty arrayref will be considered a
1547 logical false and will generate 0=1.
1549 =head2 Tests for NULL values
1551 If the value part is C<undef> then this is converted to SQL <IS NULL>
1560 $stmt = "WHERE user = ? AND status IS NULL";
1563 To test if a column IS NOT NULL:
1567 status => { '!=', undef },
1570 =head2 Specific comparison operators
1572 If you want to specify a different type of operator for your comparison,
1573 you can use a hashref for a given column:
1577 status => { '!=', 'completed' }
1580 Which would generate:
1582 $stmt = "WHERE user = ? AND status != ?";
1583 @bind = ('nwiger', 'completed');
1585 To test against multiple values, just enclose the values in an arrayref:
1587 status => { '=', ['assigned', 'in-progress', 'pending'] };
1589 Which would give you:
1591 "WHERE status = ? OR status = ? OR status = ?"
1594 The hashref can also contain multiple pairs, in which case it is expanded
1595 into an C<AND> of its elements:
1599 status => { '!=', 'completed', -not_like => 'pending%' }
1602 # Or more dynamically, like from a form
1603 $where{user} = 'nwiger';
1604 $where{status}{'!='} = 'completed';
1605 $where{status}{'-not_like'} = 'pending%';
1607 # Both generate this
1608 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1609 @bind = ('nwiger', 'completed', 'pending%');
1612 To get an OR instead, you can combine it with the arrayref idea:
1616 priority => [ { '=', 2 }, { '>', 5 } ]
1619 Which would generate:
1621 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1622 @bind = ('2', '5', 'nwiger');
1624 If you want to include literal SQL (with or without bind values), just use a
1625 scalar reference or array reference as the value:
1628 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1629 date_expires => { '<' => \"now()" }
1632 Which would generate:
1634 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1635 @bind = ('11/26/2008');
1638 =head2 Logic and nesting operators
1640 In the example above,
1641 there is a subtle trap if you want to say something like
1642 this (notice the C<AND>):
1644 WHERE priority != ? AND priority != ?
1646 Because, in Perl you I<can't> do this:
1648 priority => { '!=', 2, '!=', 1 }
1650 As the second C<!=> key will obliterate the first. The solution
1651 is to use the special C<-modifier> form inside an arrayref:
1653 priority => [ -and => {'!=', 2},
1657 Normally, these would be joined by C<OR>, but the modifier tells it
1658 to use C<AND> instead. (Hint: You can use this in conjunction with the
1659 C<logic> option to C<new()> in order to change the way your queries
1660 work by default.) B<Important:> Note that the C<-modifier> goes
1661 B<INSIDE> the arrayref, as an extra first element. This will
1662 B<NOT> do what you think it might:
1664 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1666 Here is a quick list of equivalencies, since there is some overlap:
1669 status => {'!=', 'completed', 'not like', 'pending%' }
1670 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1673 status => {'=', ['assigned', 'in-progress']}
1674 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1675 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1679 =head2 Special operators : IN, BETWEEN, etc.
1681 You can also use the hashref format to compare a list of fields using the
1682 C<IN> comparison operator, by specifying the list as an arrayref:
1685 status => 'completed',
1686 reportid => { -in => [567, 2335, 2] }
1689 Which would generate:
1691 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1692 @bind = ('completed', '567', '2335', '2');
1694 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1697 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1698 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1699 'sqltrue' (by default : C<1=1>).
1701 In addition to the array you can supply a chunk of literal sql or
1702 literal sql with bind:
1705 customer => { -in => \[
1706 'SELECT cust_id FROM cust WHERE balance > ?',
1709 status => { -in => \'SELECT status_codes FROM states' },
1715 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1716 AND status IN ( SELECT status_codes FROM states )
1722 Another pair of operators is C<-between> and C<-not_between>,
1723 used with an arrayref of two values:
1727 completion_date => {
1728 -not_between => ['2002-10-01', '2003-02-06']
1734 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1736 Just like with C<-in> all plausible combinations of literal SQL
1740 start0 => { -between => [ 1, 2 ] },
1741 start1 => { -between => \["? AND ?", 1, 2] },
1742 start2 => { -between => \"lower(x) AND upper(y)" },
1743 start3 => { -between => [
1745 \["upper(?)", 'stuff' ],
1752 ( start0 BETWEEN ? AND ? )
1753 AND ( start1 BETWEEN ? AND ? )
1754 AND ( start2 BETWEEN lower(x) AND upper(y) )
1755 AND ( start3 BETWEEN lower(x) AND upper(?) )
1757 @bind = (1, 2, 1, 2, 'stuff');
1760 These are the two builtin "special operators"; but the
1761 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1763 =head2 Unary operators: bool
1765 If you wish to test against boolean columns or functions within your
1766 database you can use the C<-bool> and C<-not_bool> operators. For
1767 example to test the column C<is_user> being true and the column
1768 C<is_enabled> being false you would use:-
1772 -not_bool => 'is_enabled',
1777 WHERE is_user AND NOT is_enabled
1779 If a more complex combination is required, testing more conditions,
1780 then you should use the and/or operators:-
1787 -not_bool => 'four',
1793 WHERE one AND two AND three AND NOT four
1796 =head2 Nested conditions, -and/-or prefixes
1798 So far, we've seen how multiple conditions are joined with a top-level
1799 C<AND>. We can change this by putting the different conditions we want in
1800 hashes and then putting those hashes in an array. For example:
1805 status => { -like => ['pending%', 'dispatched'] },
1809 status => 'unassigned',
1813 This data structure would create the following:
1815 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1816 OR ( user = ? AND status = ? ) )";
1817 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1820 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
1821 to change the logic inside :
1827 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1828 -or => { workhrs => {'<', 50}, geo => 'EURO' },
1835 WHERE ( user = ? AND (
1836 ( workhrs > ? AND geo = ? )
1837 OR ( workhrs < ? OR geo = ? )
1840 =head3 Algebraic inconsistency, for historical reasons
1842 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
1843 operator goes C<outside> of the nested structure; whereas when connecting
1844 several constraints on one column, the C<-and> operator goes
1845 C<inside> the arrayref. Here is an example combining both features :
1848 -and => [a => 1, b => 2],
1849 -or => [c => 3, d => 4],
1850 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
1855 WHERE ( ( ( a = ? AND b = ? )
1856 OR ( c = ? OR d = ? )
1857 OR ( e LIKE ? AND e LIKE ? ) ) )
1859 This difference in syntax is unfortunate but must be preserved for
1860 historical reasons. So be careful : the two examples below would
1861 seem algebraically equivalent, but they are not
1863 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
1864 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
1866 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
1867 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
1870 =head2 Literal SQL and value type operators
1872 The basic premise of SQL::Abstract is that in WHERE specifications the "left
1873 side" is a column name and the "right side" is a value (normally rendered as
1874 a placeholder). This holds true for both hashrefs and arrayref pairs as you
1875 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
1876 alter this behavior. There are several ways of doing so.
1880 This is a virtual operator that signals the string to its right side is an
1881 identifier (a column name) and not a value. For example to compare two
1882 columns you would write:
1885 priority => { '<', 2 },
1886 requestor => { -ident => 'submitter' },
1891 $stmt = "WHERE priority < ? AND requestor = submitter";
1894 If you are maintaining legacy code you may see a different construct as
1895 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
1900 This is a virtual operator that signals that the construct to its right side
1901 is a value to be passed to DBI. This is for example necessary when you want
1902 to write a where clause against an array (for RDBMS that support such
1903 datatypes). For example:
1906 array => { -value => [1, 2, 3] }
1911 $stmt = 'WHERE array = ?';
1912 @bind = ([1, 2, 3]);
1914 Note that if you were to simply say:
1920 the result would porbably be not what you wanted:
1922 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
1927 Finally, sometimes only literal SQL will do. To include a random snippet
1928 of SQL verbatim, you specify it as a scalar reference. Consider this only
1929 as a last resort. Usually there is a better way. For example:
1932 priority => { '<', 2 },
1933 requestor => { -in => \'(SELECT name FROM hitmen)' },
1938 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
1941 Note that in this example, you only get one bind parameter back, since
1942 the verbatim SQL is passed as part of the statement.
1946 Never use untrusted input as a literal SQL argument - this is a massive
1947 security risk (there is no way to check literal snippets for SQL
1948 injections and other nastyness). If you need to deal with untrusted input
1949 use literal SQL with placeholders as described next.
1951 =head3 Literal SQL with placeholders and bind values (subqueries)
1953 If the literal SQL to be inserted has placeholders and bind values,
1954 use a reference to an arrayref (yes this is a double reference --
1955 not so common, but perfectly legal Perl). For example, to find a date
1956 in Postgres you can use something like this:
1959 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1964 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1967 Note that you must pass the bind values in the same format as they are returned
1968 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
1969 provide the bind values in the C<< [ column_meta => value ] >> format, where
1970 C<column_meta> is an opaque scalar value; most commonly the column name, but
1971 you can use any scalar value (including references and blessed references),
1972 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
1973 to C<columns> the above example will look like:
1976 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1979 Literal SQL is especially useful for nesting parenthesized clauses in the
1980 main SQL query. Here is a first example :
1982 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1986 bar => \["IN ($sub_stmt)" => @sub_bind],
1991 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1992 WHERE c2 < ? AND c3 LIKE ?))";
1993 @bind = (1234, 100, "foo%");
1995 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1996 are expressed in the same way. Of course the C<$sub_stmt> and
1997 its associated bind values can be generated through a former call
2000 my ($sub_stmt, @sub_bind)
2001 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2002 c3 => {-like => "foo%"}});
2005 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2008 In the examples above, the subquery was used as an operator on a column;
2009 but the same principle also applies for a clause within the main C<%where>
2010 hash, like an EXISTS subquery :
2012 my ($sub_stmt, @sub_bind)
2013 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2014 my %where = ( -and => [
2016 \["EXISTS ($sub_stmt)" => @sub_bind],
2021 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2022 WHERE c1 = ? AND c2 > t0.c0))";
2026 Observe that the condition on C<c2> in the subquery refers to
2027 column C<t0.c0> of the main query : this is I<not> a bind
2028 value, so we have to express it through a scalar ref.
2029 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2030 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2031 what we wanted here.
2033 Finally, here is an example where a subquery is used
2034 for expressing unary negation:
2036 my ($sub_stmt, @sub_bind)
2037 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2038 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2040 lname => {like => '%son%'},
2041 \["NOT ($sub_stmt)" => @sub_bind],
2046 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2047 @bind = ('%son%', 10, 20)
2049 =head3 Deprecated usage of Literal SQL
2051 Below are some examples of archaic use of literal SQL. It is shown only as
2052 reference for those who deal with legacy code. Each example has a much
2053 better, cleaner and safer alternative that users should opt for in new code.
2059 my %where = ( requestor => \'IS NOT NULL' )
2061 $stmt = "WHERE requestor IS NOT NULL"
2063 This used to be the way of generating NULL comparisons, before the handling
2064 of C<undef> got formalized. For new code please use the superior syntax as
2065 described in L</Tests for NULL values>.
2069 my %where = ( requestor => \'= submitter' )
2071 $stmt = "WHERE requestor = submitter"
2073 This used to be the only way to compare columns. Use the superior L</-ident>
2074 method for all new code. For example an identifier declared in such a way
2075 will be properly quoted if L</quote_char> is properly set, while the legacy
2076 form will remain as supplied.
2080 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2082 $stmt = "WHERE completed > ? AND is_ready"
2083 @bind = ('2012-12-21')
2085 Using an empty string literal used to be the only way to express a boolean.
2086 For all new code please use the much more readable
2087 L<-bool|/Unary operators: bool> operator.
2093 These pages could go on for a while, since the nesting of the data
2094 structures this module can handle are pretty much unlimited (the
2095 module implements the C<WHERE> expansion as a recursive function
2096 internally). Your best bet is to "play around" with the module a
2097 little to see how the data structures behave, and choose the best
2098 format for your data based on that.
2100 And of course, all the values above will probably be replaced with
2101 variables gotten from forms or the command line. After all, if you
2102 knew everything ahead of time, you wouldn't have to worry about
2103 dynamically-generating SQL and could just hardwire it into your
2106 =head1 ORDER BY CLAUSES
2108 Some functions take an order by clause. This can either be a scalar (just a
2109 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2110 or an array of either of the two previous forms. Examples:
2112 Given | Will Generate
2113 ----------------------------------------------------------
2115 \'colA DESC' | ORDER BY colA DESC
2117 'colA' | ORDER BY colA
2119 [qw/colA colB/] | ORDER BY colA, colB
2121 {-asc => 'colA'} | ORDER BY colA ASC
2123 {-desc => 'colB'} | ORDER BY colB DESC
2125 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2127 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2130 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2131 { -desc => [qw/colB/], | colC ASC, colD ASC
2132 { -asc => [qw/colC colD/],|
2134 ===========================================================
2138 =head1 SPECIAL OPERATORS
2140 my $sqlmaker = SQL::Abstract->new(special_ops => [
2144 my ($self, $field, $op, $arg) = @_;
2150 handler => 'method_name',
2154 A "special operator" is a SQL syntactic clause that can be
2155 applied to a field, instead of a usual binary operator.
2158 WHERE field IN (?, ?, ?)
2159 WHERE field BETWEEN ? AND ?
2160 WHERE MATCH(field) AGAINST (?, ?)
2162 Special operators IN and BETWEEN are fairly standard and therefore
2163 are builtin within C<SQL::Abstract> (as the overridable methods
2164 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2165 like the MATCH .. AGAINST example above which is specific to MySQL,
2166 you can write your own operator handlers - supply a C<special_ops>
2167 argument to the C<new> method. That argument takes an arrayref of
2168 operator definitions; each operator definition is a hashref with two
2175 the regular expression to match the operator
2179 Either a coderef or a plain scalar method name. In both cases
2180 the expected return is C<< ($sql, @bind) >>.
2182 When supplied with a method name, it is simply called on the
2183 L<SQL::Abstract/> object as:
2185 $self->$method_name ($field, $op, $arg)
2189 $op is the part that matched the handler regex
2190 $field is the LHS of the operator
2193 When supplied with a coderef, it is called as:
2195 $coderef->($self, $field, $op, $arg)
2200 For example, here is an implementation
2201 of the MATCH .. AGAINST syntax for MySQL
2203 my $sqlmaker = SQL::Abstract->new(special_ops => [
2205 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2206 {regex => qr/^match$/i,
2208 my ($self, $field, $op, $arg) = @_;
2209 $arg = [$arg] if not ref $arg;
2210 my $label = $self->_quote($field);
2211 my ($placeholder) = $self->_convert('?');
2212 my $placeholders = join ", ", (($placeholder) x @$arg);
2213 my $sql = $self->_sqlcase('match') . " ($label) "
2214 . $self->_sqlcase('against') . " ($placeholders) ";
2215 my @bind = $self->_bindtype($field, @$arg);
2216 return ($sql, @bind);
2223 =head1 UNARY OPERATORS
2225 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2229 my ($self, $op, $arg) = @_;
2235 handler => 'method_name',
2239 A "unary operator" is a SQL syntactic clause that can be
2240 applied to a field - the operator goes before the field
2242 You can write your own operator handlers - supply a C<unary_ops>
2243 argument to the C<new> method. That argument takes an arrayref of
2244 operator definitions; each operator definition is a hashref with two
2251 the regular expression to match the operator
2255 Either a coderef or a plain scalar method name. In both cases
2256 the expected return is C<< $sql >>.
2258 When supplied with a method name, it is simply called on the
2259 L<SQL::Abstract/> object as:
2261 $self->$method_name ($op, $arg)
2265 $op is the part that matched the handler regex
2266 $arg is the RHS or argument of the operator
2268 When supplied with a coderef, it is called as:
2270 $coderef->($self, $op, $arg)
2278 Thanks to some benchmarking by Mark Stosberg, it turns out that
2279 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2280 I must admit this wasn't an intentional design issue, but it's a
2281 byproduct of the fact that you get to control your C<DBI> handles
2284 To maximize performance, use a code snippet like the following:
2286 # prepare a statement handle using the first row
2287 # and then reuse it for the rest of the rows
2289 for my $href (@array_of_hashrefs) {
2290 $stmt ||= $sql->insert('table', $href);
2291 $sth ||= $dbh->prepare($stmt);
2292 $sth->execute($sql->values($href));
2295 The reason this works is because the keys in your C<$href> are sorted
2296 internally by B<SQL::Abstract>. Thus, as long as your data retains
2297 the same structure, you only have to generate the SQL the first time
2298 around. On subsequent queries, simply use the C<values> function provided
2299 by this module to return your values in the correct order.
2301 However this depends on the values having the same type - if, for
2302 example, the values of a where clause may either have values
2303 (resulting in sql of the form C<column = ?> with a single bind
2304 value), or alternatively the values might be C<undef> (resulting in
2305 sql of the form C<column IS NULL> with no bind value) then the
2306 caching technique suggested will not work.
2310 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2311 really like this part (I do, at least). Building up a complex query
2312 can be as simple as the following:
2316 use CGI::FormBuilder;
2319 my $form = CGI::FormBuilder->new(...);
2320 my $sql = SQL::Abstract->new;
2322 if ($form->submitted) {
2323 my $field = $form->field;
2324 my $id = delete $field->{id};
2325 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2328 Of course, you would still have to connect using C<DBI> to run the
2329 query, but the point is that if you make your form look like your
2330 table, the actual query script can be extremely simplistic.
2332 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2333 a fast interface to returning and formatting data. I frequently
2334 use these three modules together to write complex database query
2335 apps in under 50 lines.
2341 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2343 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2349 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2350 Great care has been taken to preserve the I<published> behavior
2351 documented in previous versions in the 1.* family; however,
2352 some features that were previously undocumented, or behaved
2353 differently from the documentation, had to be changed in order
2354 to clarify the semantics. Hence, client code that was relying
2355 on some dark areas of C<SQL::Abstract> v1.*
2356 B<might behave differently> in v1.50.
2358 The main changes are :
2364 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2368 support for the { operator => \"..." } construct (to embed literal SQL)
2372 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2376 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2380 defensive programming : check arguments
2384 fixed bug with global logic, which was previously implemented
2385 through global variables yielding side-effects. Prior versions would
2386 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2387 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2388 Now this is interpreted
2389 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2394 fixed semantics of _bindtype on array args
2398 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2399 we just avoid shifting arrays within that tree.
2403 dropped the C<_modlogic> function
2407 =head1 ACKNOWLEDGEMENTS
2409 There are a number of individuals that have really helped out with
2410 this module. Unfortunately, most of them submitted bugs via CPAN
2411 so I have no idea who they are! But the people I do know are:
2413 Ash Berlin (order_by hash term support)
2414 Matt Trout (DBIx::Class support)
2415 Mark Stosberg (benchmarking)
2416 Chas Owens (initial "IN" operator support)
2417 Philip Collins (per-field SQL functions)
2418 Eric Kolve (hashref "AND" support)
2419 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2420 Dan Kubb (support for "quote_char" and "name_sep")
2421 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2422 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2423 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2424 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2425 Oliver Charles (support for "RETURNING" after "INSERT")
2431 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2435 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2437 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2439 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2440 While not an official support venue, C<DBIx::Class> makes heavy use of
2441 C<SQL::Abstract>, and as such list members there are very familiar with
2442 how to create queries.
2446 This module is free software; you may copy this under the same
2447 terms as perl itself (either the GNU General Public License or
2448 the Artistic License)