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)
10 use warnings FATAL => 'all';
13 use Data::Query::Constants qw(
14 DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_LITERAL DQ_JOIN DQ_SELECT DQ_ORDER
15 DQ_WHERE DQ_DELETE DQ_UPDATE DQ_INSERT
17 use Data::Query::ExprHelpers qw(perl_scalar_value);
19 #======================================================================
21 #======================================================================
23 our $VERSION = '1.72';
25 # This would confuse some packagers
26 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
30 # special operators (-in, -between). May be extended/overridden by user.
31 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
32 my @BUILTIN_SPECIAL_OPS = ();
34 # unaryish operators - key maps to handler
35 my @BUILTIN_UNARY_OPS = (
36 # the digits are backcompat stuff
37 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
38 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
39 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
40 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
41 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
42 { regex => qr/^ value $/ix, handler => '_where_op_VALUE' },
45 #======================================================================
46 # DEBUGGING AND ERROR REPORTING
47 #======================================================================
50 return unless $_[0]->{debug}; shift; # a little faster
51 my $func = (caller(1))[3];
52 warn "[$func] ", @_, "\n";
56 my($func) = (caller(1))[3];
57 Carp::carp "[$func] Warning: ", @_;
61 my($func) = (caller(1))[3];
62 Carp::croak "[$func] Fatal: ", @_;
66 #======================================================================
68 #======================================================================
72 my $class = ref($self) || $self;
73 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
75 # choose our case by keeping an option around
76 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
78 # default logic for interpreting arrayrefs
79 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
81 # how to return bind vars
82 # LDNOTE: changed nwiger code : why this 'delete' ??
83 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
84 $opt{bindtype} ||= 'normal';
86 # default comparison is "=", but can be overridden
89 # try to recognize which are the 'equality' and 'unequality' ops
90 # (temporary quickfix, should go through a more seasoned API)
91 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
92 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
95 $opt{sqltrue} ||= '1=1';
96 $opt{sqlfalse} ||= '0=1';
99 $opt{special_ops} ||= [];
100 # regexes are applied in order, thus push after user-defines
101 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
104 $opt{unary_ops} ||= [];
105 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
107 # rudimentary saniy-check for user supplied bits treated as functions/operators
108 # If a purported function matches this regular expression, an exception is thrown.
109 # Literal SQL is *NOT* subject to this check, only functions (and column names
110 # when quoting is not in effect)
113 # need to guard against ()'s in column names too, but this will break tons of
114 # hacks... ideas anyone?
115 $opt{injection_guard} ||= qr/
121 $opt{name_sep} ||= '.';
123 $opt{renderer} ||= do {
124 require Data::Query::Renderer::SQL::Naive;
125 my ($always, $chars);
126 for ($opt{quote_char}) {
127 $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
130 Data::Query::Renderer::SQL::Naive->new({
131 quote_chars => $chars, always_quote => $always,
132 ($opt{case} ? (lc_keywords => 1) : ()), # always 'lower' if it exists
136 return bless \%opt, $class;
140 my ($self, $dq) = @_;
144 my ($sql, @bind) = @{$self->{renderer}->render($dq)};
146 ($self->{bindtype} eq 'normal'
147 ? ($sql, map $_->{value}, @bind)
148 : ($sql, map [ $_->{value_meta}, $_->{value} ], @bind)
154 my ($self, $literal) = @_;
156 ($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
161 (@bind ? (values => [ $self->_bind_to_dq(@bind) ]) : ()),
166 my ($self, @bind) = @_;
168 $self->{bindtype} eq 'normal'
169 ? map perl_scalar_value($_), @bind
171 $self->_assert_bindval_matches_bindtype(@bind);
172 map perl_scalar_value(reverse @$_), @bind
177 my ($self, $value) = @_;
178 $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
182 my ($self, $ident) = @_;
183 $self->_assert_pass_injection_guard($ident)
184 unless $self->{renderer}{always_quote};
185 $self->_maybe_convert_dq({
186 type => DQ_IDENTIFIER,
187 elements => [ split /\Q$self->{name_sep}/, $ident ],
191 sub _maybe_convert_dq {
192 my ($self, $dq) = @_;
193 if (my $c = $self->{where_convert}) {
196 operator => { 'SQL.Naive' => 'apply' },
198 { type => DQ_IDENTIFIER, elements => [ $self->_sqlcase($c) ] },
208 my ($self, $op, @args) = @_;
209 $self->_assert_pass_injection_guard($op);
212 operator => { 'SQL.Naive' => $op },
217 sub _assert_pass_injection_guard {
218 if ($_[1] =~ $_[0]->{injection_guard}) {
219 my $class = ref $_[0];
220 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
221 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
222 . "{injection_guard} attribute to ${class}->new()"
227 #======================================================================
229 #======================================================================
233 $self->_render_dq($self->_insert_to_dq(@_));
237 my ($self, $table, $data, $options) = @_;
238 my (@names, @values);
239 if (ref($data) eq 'HASH') {
240 @names = sort keys %$data;
241 foreach my $k (@names) {
242 local our $Cur_Col_Meta = $k;
243 push @values, $self->_mutation_rhs_to_dq($data->{$k});
245 } elsif (ref($data) eq 'ARRAY') {
246 local our $Cur_Col_Meta;
247 @values = map $self->_mutation_rhs_to_dq($_), @$data;
249 die "Not handled yet";
252 if (my $r_source = $options->{returning}) {
254 map +(ref($_) ? $self->_expr_to_dq($_) : $self->_ident_to_dq($_)),
255 (ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
260 target => $self->_ident_to_dq($table),
261 (@names ? (names => [ map $self->_ident_to_dq($_), @names ]) : ()),
262 values => [ \@values ],
263 ($returning ? (returning => $returning) : ()),
267 sub _mutation_rhs_to_dq {
269 if (ref($v) eq 'ARRAY') {
270 if ($self->{array_datatypes}) {
271 return $self->_value_to_dq($v);
273 $v = \do { my $x = $v };
275 if (ref($v) eq 'HASH') {
276 my ($op, $arg, @rest) = %$v;
278 puke 'Operator calls in update/insert must be in the form { -op => $arg }'
279 if (@rest or not $op =~ /^\-(.+)/);
281 return $self->_expr_to_dq($v);
284 #======================================================================
286 #======================================================================
291 $self->_render_dq($self->_update_to_dq(@_));
295 my ($self, $table, $data, $where) = @_;
297 puke "Unsupported data type specified to \$sql->update"
298 unless ref $data eq 'HASH';
302 foreach my $k (sort keys %$data) {
304 local our $Cur_Col_Meta = $k;
305 push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
310 target => $self->_ident_to_dq($table),
312 where => $self->_where_to_dq($where),
317 #======================================================================
319 #======================================================================
322 my ($self, $table, $where) = @_;
324 my $source_dq = $self->_table_to_dq($table);
326 if (my $where_dq = $self->_where_to_dq($where)) {
339 return $self->_render_dq($self->_select_to_dq(@_));
343 my ($self, $table, $fields, $where, $order) = @_;
346 my $source_dq = $self->_source_to_dq($table, $where);
351 map $self->_ident_to_dq($_),
352 ref($fields) eq 'ARRAY' ? @$fields : $fields
358 $final_dq = $self->_order_by_to_dq($order, undef, $final_dq);
364 #======================================================================
366 #======================================================================
371 $self->_render_dq($self->_delete_to_dq(@_));
375 my ($self, $table, $where) = @_;
378 target => $self->_table_to_dq($table),
379 where => $self->_where_to_dq($where),
384 #======================================================================
386 #======================================================================
390 # Finally, a separate routine just to handle WHERE clauses
392 my ($self, $where, $order) = @_;
398 ($sql, @bind) = $self->_recurse_where($where) if defined($where);
399 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
403 $sql .= $self->_order_by($order);
406 return wantarray ? ($sql, @bind) : $sql;
410 my ($self, $where, $logic) = @_;
412 return $self->_render_dq($self->_where_to_dq($where, $logic));
416 my ($self, $where, $logic) = @_;
418 return undef unless defined($where);
420 # turn the convert misfeature on - only used in WHERE clauses
421 local $self->{where_convert} = $self->{convert};
423 return $self->_expr_to_dq($where, $logic);
427 my ($self, $where, $logic) = @_;
429 if (ref($where) eq 'ARRAY') {
430 return $self->_expr_to_dq_ARRAYREF($where, $logic);
431 } elsif (ref($where) eq 'HASH') {
432 return $self->_expr_to_dq_HASHREF($where, $logic);
434 ref($where) eq 'SCALAR'
435 or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
437 return $self->_literal_to_dq($$where);
438 } elsif (!ref($where) or Scalar::Util::blessed($where)) {
439 return $self->_value_to_dq($where);
441 die "Can't handle $where";
444 sub _expr_to_dq_ARRAYREF {
445 my ($self, $where, $logic) = @_;
447 $logic = uc($logic || $self->{logic} || 'OR');
448 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
450 return unless @$where;
452 my ($first, @rest) = @$where;
454 return $self->_expr_to_dq($first) unless @rest;
458 $self->_where_hashpair_to_dq($first => shift(@rest));
460 $self->_expr_to_dq($first);
464 return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
467 $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
471 sub _expr_to_dq_HASHREF {
472 my ($self, $where, $logic) = @_;
474 $logic = uc($logic) if $logic;
477 $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
480 return $dq[0] unless @dq > 1;
482 my $final = pop(@dq);
484 foreach my $dq (reverse @dq) {
485 $final = $self->_op_to_dq($logic||'AND', $dq, $final);
491 sub _where_to_dq_SCALAR {
492 shift->_value_to_dq(@_);
495 sub _where_op_IDENT {
497 my ($op, $rhs) = splice @_, -2;
499 puke "-$op takes a single scalar argument (a quotable identifier)";
502 # in case we are called as a top level special op (no '=')
505 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
513 sub _where_op_VALUE {
515 my ($op, $rhs) = splice @_, -2;
517 # in case we are called as a top level special op (no '=')
522 ($lhs || $self->{_nested_func_lhs}),
529 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
533 $self->_convert('?'),
539 sub _where_hashpair_to_dq {
540 my ($self, $k, $v, $logic) = @_;
542 if ($k =~ /^-(.*)/s) {
544 if ($op eq 'AND' or $op eq 'OR') {
545 return $self->_expr_to_dq($v, $op);
546 } elsif ($op eq 'NEST') {
547 return $self->_expr_to_dq($v);
548 } elsif ($op eq 'NOT') {
549 return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
550 } elsif ($op eq 'BOOL') {
551 return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
552 } elsif ($op eq 'NOT_BOOL') {
553 return $self->_op_to_dq(
554 NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
556 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
557 die "Use of [and|or|nest]_N modifiers is no longer supported";
560 if (ref($v) eq 'HASH' and keys(%$v) == 1 and (keys %$v)[0] =~ /^-(.*)/s) {
562 my ($inner) = values %$v;
565 (map $self->_expr_to_dq($_),
566 (ref($inner) eq 'ARRAY' ? @$inner : $inner))
569 (map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v))
572 $self->_assert_pass_injection_guard($op);
573 return $self->_op_to_dq(
574 apply => $self->_ident_to_dq($op), @args
578 local our $Cur_Col_Meta = $k;
579 if (ref($v) eq 'ARRAY') {
581 return $self->_literal_to_dq($self->{sqlfalse});
582 } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
583 return $self->_expr_to_dq_ARRAYREF([
584 map +{ $k => $_ }, @{$v}[1..$#$v]
587 return $self->_expr_to_dq_ARRAYREF([
588 map +{ $k => $_ }, @$v
590 } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
594 parts => [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]
597 my ($op, $rhs) = do {
598 if (ref($v) eq 'HASH') {
600 return $self->_expr_to_dq_ARRAYREF([
601 map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
604 my ($op, $value) = %$v;
605 s/^-//, s/_/ /g for $op;
606 if ($op =~ /^(and|or)$/i) {
607 return $self->_expr_to_dq({ $k => $value }, $op);
609 my $special_op = List::Util::first {$op =~ $_->{regex}}
610 @{$self->{special_ops}}
612 return $self->_literal_to_dq(
613 [ $self->${\$special_op->{handler}}($k, $op, $value) ]
615 } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
616 die "Use of [and|or|nest]_N modifiers is no longer supported";
623 if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
624 if (ref($rhs) ne 'ARRAY') {
626 # have to add parens if none present because -in => \"SELECT ..."
627 # got documented. mst hates everything.
628 if (ref($rhs) eq 'SCALAR') {
630 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
633 my ($x, @rest) = @{$$rhs};
634 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
635 $rhs = \[ $x, @rest ];
638 return $self->_op_to_dq(
639 $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
642 return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
643 return $self->_op_to_dq(
644 $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
646 } elsif ($op =~ s/^NOT (?!LIKE)//) {
647 return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
648 } elsif (!defined($rhs)) {
650 if ($op eq '=' or $op eq 'LIKE') {
652 } elsif ($op eq '!=') {
655 die "Can't do undef -> NULL transform for operator ${op}";
658 return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
660 if (ref($rhs) eq 'ARRAY') {
662 return $self->_literal_to_dq(
663 $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
665 } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
666 return $self->_expr_to_dq_ARRAYREF([
667 map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
669 } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
670 die "Use of [and|or|nest]_N modifiers is no longer supported";
672 return $self->_expr_to_dq_ARRAYREF([
673 map +{ $k => { $op => $_ } }, @$rhs
676 return $self->_op_to_dq(
677 $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
682 #======================================================================
684 #======================================================================
687 my ($self, $arg) = @_;
688 if (my $dq = $self->_order_by_to_dq($arg)) {
689 # SQLA generates ' ORDER BY foo'. The hilarity.
691 ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
692 : ' '.$self->_render_dq($dq);
698 sub _order_by_to_dq {
699 my ($self, $arg, $dir, $from) = @_;
705 ($dir ? (direction => $dir) : ()),
706 ($from ? (from => $from) : ()),
710 $dq->{by} = $self->_ident_to_dq($arg);
711 } elsif (ref($arg) eq 'ARRAY') {
713 local our $Order_Inner unless our $Order_Recursing;
714 local $Order_Recursing = 1;
716 foreach my $member (@$arg) {
718 my $next = $self->_order_by_to_dq($member, $dir, $from);
720 $inner->{from} = $next if $inner;
721 $inner = $Order_Inner || $next;
723 $Order_Inner = $inner;
725 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
726 $dq->{by} = $self->_literal_to_dq($$arg);
727 } elsif (ref($arg) eq 'SCALAR') {
728 $dq->{by} = $self->_literal_to_dq($$arg);
729 } elsif (ref($arg) eq 'HASH') {
730 my ($key, $val, @rest) = %$arg;
734 if (@rest or not $key =~ /^-(desc|asc)/i) {
735 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
738 return $self->_order_by_to_dq($val, $dir, $from);
740 die "Can't handle $arg in _order_by_to_dq";
745 #======================================================================
746 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
747 #======================================================================
750 my ($self, $from) = @_;
751 $self->_render_dq($self->_table_to_dq($from));
755 my ($self, $from) = @_;
756 $self->_SWITCH_refkind($from, {
758 die "Empty FROM list" unless my @f = @$from;
759 my $dq = $self->_ident_to_dq(shift @f);
760 while (my $x = shift @f) {
763 join => [ $dq, $self->_ident_to_dq($x) ]
768 SCALAR => sub { $self->_ident_to_dq($from) },
780 #======================================================================
782 #======================================================================
784 # highly optimized, as it's called way too often
786 # my ($self, $label) = @_;
788 return '' unless defined $_[1];
789 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
791 unless ($_[0]->{quote_char}) {
792 $_[0]->_assert_pass_injection_guard($_[1]);
796 my $qref = ref $_[0]->{quote_char};
799 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
801 elsif ($qref eq 'ARRAY') {
802 ($l, $r) = @{$_[0]->{quote_char}};
805 puke "Unsupported quote_char format: $_[0]->{quote_char}";
808 # parts containing * are naturally unquoted
809 return join( $_[0]->{name_sep}||'', map
810 { $_ eq '*' ? $_ : $l . $_ . $r }
811 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
816 # Conversion, if applicable
818 #my ($self, $arg) = @_;
820 # LDNOTE : modified the previous implementation below because
821 # it was not consistent : the first "return" is always an array,
822 # the second "return" is context-dependent. Anyway, _convert
823 # seems always used with just a single argument, so make it a
825 # return @_ unless $self->{convert};
826 # my $conv = $self->_sqlcase($self->{convert});
827 # my @ret = map { $conv.'('.$_.')' } @_;
828 # return wantarray ? @ret : $ret[0];
829 if ($_[0]->{convert}) {
830 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
837 #my ($self, $col, @vals) = @_;
839 #LDNOTE : changed original implementation below because it did not make
840 # sense when bindtype eq 'columns' and @vals > 1.
841 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
843 # called often - tighten code
844 return $_[0]->{bindtype} eq 'columns'
845 ? map {[$_[1], $_]} @_[2 .. $#_]
850 # Dies if any element of @bind is not in [colname => value] format
851 # if bindtype is 'columns'.
852 sub _assert_bindval_matches_bindtype {
853 # my ($self, @bind) = @_;
855 if ($self->{bindtype} eq 'columns') {
857 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
858 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
864 sub _join_sql_clauses {
865 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
867 if (@$clauses_aref > 1) {
868 my $join = " " . $self->_sqlcase($logic) . " ";
869 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
870 return ($sql, @$bind_aref);
872 elsif (@$clauses_aref) {
873 return ($clauses_aref->[0], @$bind_aref); # no parentheses
876 return (); # if no SQL, ignore @$bind_aref
881 # Fix SQL case, if so requested
883 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
884 # don't touch the argument ... crooked logic, but let's not change it!
885 return $_[0]->{case} ? $_[1] : uc($_[1]);
889 #======================================================================
890 # DISPATCHING FROM REFKIND
891 #======================================================================
894 my ($self, $data) = @_;
896 return 'UNDEF' unless defined $data;
898 # blessed objects are treated like scalars
899 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
901 return 'SCALAR' unless $ref;
904 while ($ref eq 'REF') {
906 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
910 return ($ref||'SCALAR') . ('REF' x $n_steps);
914 my ($self, $data) = @_;
915 my @try = ($self->_refkind($data));
916 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
917 push @try, 'FALLBACK';
921 sub _METHOD_FOR_refkind {
922 my ($self, $meth_prefix, $data) = @_;
925 for (@{$self->_try_refkind($data)}) {
926 $method = $self->can($meth_prefix."_".$_)
930 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
934 sub _SWITCH_refkind {
935 my ($self, $data, $dispatch_table) = @_;
938 for (@{$self->_try_refkind($data)}) {
939 $coderef = $dispatch_table->{$_}
943 puke "no dispatch entry for ".$self->_refkind($data)
952 #======================================================================
953 # VALUES, GENERATE, AUTOLOAD
954 #======================================================================
956 # LDNOTE: original code from nwiger, didn't touch code in that section
957 # I feel the AUTOLOAD stuff should not be the default, it should
958 # only be activated on explicit demand by user.
962 my $data = shift || return;
963 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
964 unless ref $data eq 'HASH';
967 foreach my $k ( sort keys %$data ) {
969 $self->_SWITCH_refkind($v, {
971 if ($self->{array_datatypes}) { # array datatype
972 push @all_bind, $self->_bindtype($k, $v);
974 else { # literal SQL with bind
975 my ($sql, @bind) = @$v;
976 $self->_assert_bindval_matches_bindtype(@bind);
977 push @all_bind, @bind;
980 ARRAYREFREF => sub { # literal SQL with bind
981 my ($sql, @bind) = @${$v};
982 $self->_assert_bindval_matches_bindtype(@bind);
983 push @all_bind, @bind;
985 SCALARREF => sub { # literal SQL without bind
987 SCALAR_or_UNDEF => sub {
988 push @all_bind, $self->_bindtype($k, $v);
999 my(@sql, @sqlq, @sqlv);
1003 if ($ref eq 'HASH') {
1004 for my $k (sort keys %$_) {
1007 my $label = $self->_quote($k);
1008 if ($r eq 'ARRAY') {
1009 # literal SQL with bind
1010 my ($sql, @bind) = @$v;
1011 $self->_assert_bindval_matches_bindtype(@bind);
1012 push @sqlq, "$label = $sql";
1014 } elsif ($r eq 'SCALAR') {
1015 # literal SQL without bind
1016 push @sqlq, "$label = $$v";
1018 push @sqlq, "$label = ?";
1019 push @sqlv, $self->_bindtype($k, $v);
1022 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1023 } elsif ($ref eq 'ARRAY') {
1024 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1027 if ($r eq 'ARRAY') { # literal SQL with bind
1028 my ($sql, @bind) = @$v;
1029 $self->_assert_bindval_matches_bindtype(@bind);
1032 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1033 # embedded literal SQL
1040 push @sql, '(' . join(', ', @sqlq) . ')';
1041 } elsif ($ref eq 'SCALAR') {
1045 # strings get case twiddled
1046 push @sql, $self->_sqlcase($_);
1050 my $sql = join ' ', @sql;
1052 # this is pretty tricky
1053 # if ask for an array, return ($stmt, @bind)
1054 # otherwise, s/?/shift @sqlv/ to put it inline
1056 return ($sql, @sqlv);
1058 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1059 ref $d ? $d->[1] : $d/e;
1068 # # This allows us to check for a local, then _form, attr
1070 # my($name) = $AUTOLOAD =~ /.*::(.+)/;
1071 # return $self->generate($name, @_);
1082 SQL::Abstract - Generate SQL from Perl data structures
1088 my $sql = SQL::Abstract->new;
1090 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1092 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1094 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1096 my($stmt, @bind) = $sql->delete($table, \%where);
1098 # Then, use these in your DBI statements
1099 my $sth = $dbh->prepare($stmt);
1100 $sth->execute(@bind);
1102 # Just generate the WHERE clause
1103 my($stmt, @bind) = $sql->where(\%where, \@order);
1105 # Return values in the same order, for hashed queries
1106 # See PERFORMANCE section for more details
1107 my @bind = $sql->values(\%fieldvals);
1111 This module was inspired by the excellent L<DBIx::Abstract>.
1112 However, in using that module I found that what I really wanted
1113 to do was generate SQL, but still retain complete control over my
1114 statement handles and use the DBI interface. So, I set out to
1115 create an abstract SQL generation module.
1117 While based on the concepts used by L<DBIx::Abstract>, there are
1118 several important differences, especially when it comes to WHERE
1119 clauses. I have modified the concepts used to make the SQL easier
1120 to generate from Perl data structures and, IMO, more intuitive.
1121 The underlying idea is for this module to do what you mean, based
1122 on the data structures you provide it. The big advantage is that
1123 you don't have to modify your code every time your data changes,
1124 as this module figures it out.
1126 To begin with, an SQL INSERT is as easy as just specifying a hash
1127 of C<key=value> pairs:
1130 name => 'Jimbo Bobson',
1131 phone => '123-456-7890',
1132 address => '42 Sister Lane',
1133 city => 'St. Louis',
1134 state => 'Louisiana',
1137 The SQL can then be generated with this:
1139 my($stmt, @bind) = $sql->insert('people', \%data);
1141 Which would give you something like this:
1143 $stmt = "INSERT INTO people
1144 (address, city, name, phone, state)
1145 VALUES (?, ?, ?, ?, ?)";
1146 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1147 '123-456-7890', 'Louisiana');
1149 These are then used directly in your DBI code:
1151 my $sth = $dbh->prepare($stmt);
1152 $sth->execute(@bind);
1154 =head2 Inserting and Updating Arrays
1156 If your database has array types (like for example Postgres),
1157 activate the special option C<< array_datatypes => 1 >>
1158 when creating the C<SQL::Abstract> object.
1159 Then you may use an arrayref to insert and update database array types:
1161 my $sql = SQL::Abstract->new(array_datatypes => 1);
1163 planets => [qw/Mercury Venus Earth Mars/]
1166 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1170 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1172 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1175 =head2 Inserting and Updating SQL
1177 In order to apply SQL functions to elements of your C<%data> you may
1178 specify a reference to an arrayref for the given hash value. For example,
1179 if you need to execute the Oracle C<to_date> function on a value, you can
1180 say something like this:
1184 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1187 The first value in the array is the actual SQL. Any other values are
1188 optional and would be included in the bind values array. This gives
1191 my($stmt, @bind) = $sql->insert('people', \%data);
1193 $stmt = "INSERT INTO people (name, date_entered)
1194 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1195 @bind = ('Bill', '03/02/2003');
1197 An UPDATE is just as easy, all you change is the name of the function:
1199 my($stmt, @bind) = $sql->update('people', \%data);
1201 Notice that your C<%data> isn't touched; the module will generate
1202 the appropriately quirky SQL for you automatically. Usually you'll
1203 want to specify a WHERE clause for your UPDATE, though, which is
1204 where handling C<%where> hashes comes in handy...
1206 =head2 Complex where statements
1208 This module can generate pretty complicated WHERE statements
1209 easily. For example, simple C<key=value> pairs are taken to mean
1210 equality, and if you want to see if a field is within a set
1211 of values, you can use an arrayref. Let's say we wanted to
1212 SELECT some data based on this criteria:
1215 requestor => 'inna',
1216 worker => ['nwiger', 'rcwe', 'sfz'],
1217 status => { '!=', 'completed' }
1220 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1222 The above would give you something like this:
1224 $stmt = "SELECT * FROM tickets WHERE
1225 ( requestor = ? ) AND ( status != ? )
1226 AND ( worker = ? OR worker = ? OR worker = ? )";
1227 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1229 Which you could then use in DBI code like so:
1231 my $sth = $dbh->prepare($stmt);
1232 $sth->execute(@bind);
1238 The functions are simple. There's one for each major SQL operation,
1239 and a constructor you use first. The arguments are specified in a
1240 similar order to each function (table, then fields, then a where
1241 clause) to try and simplify things.
1246 =head2 new(option => 'value')
1248 The C<new()> function takes a list of options and values, and returns
1249 a new B<SQL::Abstract> object which can then be used to generate SQL
1250 through the methods below. The options accepted are:
1256 If set to 'lower', then SQL will be generated in all lowercase. By
1257 default SQL is generated in "textbook" case meaning something like:
1259 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1261 Any setting other than 'lower' is ignored.
1265 This determines what the default comparison operator is. By default
1266 it is C<=>, meaning that a hash like this:
1268 %where = (name => 'nwiger', email => 'nate@wiger.org');
1270 Will generate SQL like this:
1272 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1274 However, you may want loose comparisons by default, so if you set
1275 C<cmp> to C<like> you would get SQL such as:
1277 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1279 You can also override the comparsion on an individual basis - see
1280 the huge section on L</"WHERE CLAUSES"> at the bottom.
1282 =item sqltrue, sqlfalse
1284 Expressions for inserting boolean values within SQL statements.
1285 By default these are C<1=1> and C<1=0>. They are used
1286 by the special operators C<-in> and C<-not_in> for generating
1287 correct SQL even when the argument is an empty array (see below).
1291 This determines the default logical operator for multiple WHERE
1292 statements in arrays or hashes. If absent, the default logic is "or"
1293 for arrays, and "and" for hashes. This means that a WHERE
1297 event_date => {'>=', '2/13/99'},
1298 event_date => {'<=', '4/24/03'},
1301 will generate SQL like this:
1303 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1305 This is probably not what you want given this query, though (look
1306 at the dates). To change the "OR" to an "AND", simply specify:
1308 my $sql = SQL::Abstract->new(logic => 'and');
1310 Which will change the above C<WHERE> to:
1312 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1314 The logic can also be changed locally by inserting
1315 a modifier in front of an arrayref :
1317 @where = (-and => [event_date => {'>=', '2/13/99'},
1318 event_date => {'<=', '4/24/03'} ]);
1320 See the L</"WHERE CLAUSES"> section for explanations.
1324 This will automatically convert comparisons using the specified SQL
1325 function for both column and value. This is mostly used with an argument
1326 of C<upper> or C<lower>, so that the SQL will have the effect of
1327 case-insensitive "searches". For example, this:
1329 $sql = SQL::Abstract->new(convert => 'upper');
1330 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1332 Will turn out the following SQL:
1334 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1336 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1337 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1338 not validate this option; it will just pass through what you specify verbatim).
1342 This is a kludge because many databases suck. For example, you can't
1343 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1344 Instead, you have to use C<bind_param()>:
1346 $sth->bind_param(1, 'reg data');
1347 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1349 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1350 which loses track of which field each slot refers to. Fear not.
1352 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1353 Currently, you can specify either C<normal> (default) or C<columns>. If you
1354 specify C<columns>, you will get an array that looks like this:
1356 my $sql = SQL::Abstract->new(bindtype => 'columns');
1357 my($stmt, @bind) = $sql->insert(...);
1360 [ 'column1', 'value1' ],
1361 [ 'column2', 'value2' ],
1362 [ 'column3', 'value3' ],
1365 You can then iterate through this manually, using DBI's C<bind_param()>.
1367 $sth->prepare($stmt);
1370 my($col, $data) = @$_;
1371 if ($col eq 'details' || $col eq 'comments') {
1372 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1373 } elsif ($col eq 'image') {
1374 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1376 $sth->bind_param($i, $data);
1380 $sth->execute; # execute without @bind now
1382 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1383 Basically, the advantage is still that you don't have to care which fields
1384 are or are not included. You could wrap that above C<for> loop in a simple
1385 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1386 get a layer of abstraction over manual SQL specification.
1388 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1389 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1390 will expect the bind values in this format.
1394 This is the character that a table or column name will be quoted
1395 with. By default this is an empty string, but you could set it to
1396 the character C<`>, to generate SQL like this:
1398 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1400 Alternatively, you can supply an array ref of two items, the first being the left
1401 hand quote character, and the second the right hand quote character. For
1402 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1403 that generates SQL like this:
1405 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1407 Quoting is useful if you have tables or columns names that are reserved
1408 words in your database's SQL dialect.
1412 This is the character that separates a table and column name. It is
1413 necessary to specify this when the C<quote_char> option is selected,
1414 so that tables and column names can be individually quoted like this:
1416 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1418 =item injection_guard
1420 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1421 column name specified in a query structure. This is a safety mechanism to avoid
1422 injection attacks when mishandling user input e.g.:
1424 my %condition_as_column_value_pairs = get_values_from_user();
1425 $sqla->select( ... , \%condition_as_column_value_pairs );
1427 If the expression matches an exception is thrown. Note that literal SQL
1428 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1430 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1432 =item array_datatypes
1434 When this option is true, arrayrefs in INSERT or UPDATE are
1435 interpreted as array datatypes and are passed directly
1437 When this option is false, arrayrefs are interpreted
1438 as literal SQL, just like refs to arrayrefs
1439 (but this behavior is for backwards compatibility; when writing
1440 new queries, use the "reference to arrayref" syntax
1446 Takes a reference to a list of "special operators"
1447 to extend the syntax understood by L<SQL::Abstract>.
1448 See section L</"SPECIAL OPERATORS"> for details.
1452 Takes a reference to a list of "unary operators"
1453 to extend the syntax understood by L<SQL::Abstract>.
1454 See section L</"UNARY OPERATORS"> for details.
1460 =head2 insert($table, \@values || \%fieldvals, \%options)
1462 This is the simplest function. You simply give it a table name
1463 and either an arrayref of values or hashref of field/value pairs.
1464 It returns an SQL INSERT statement and a list of bind values.
1465 See the sections on L</"Inserting and Updating Arrays"> and
1466 L</"Inserting and Updating SQL"> for information on how to insert
1467 with those data types.
1469 The optional C<\%options> hash reference may contain additional
1470 options to generate the insert SQL. Currently supported options
1477 Takes either a scalar of raw SQL fields, or an array reference of
1478 field names, and adds on an SQL C<RETURNING> statement at the end.
1479 This allows you to return data generated by the insert statement
1480 (such as row IDs) without performing another C<SELECT> statement.
1481 Note, however, this is not part of the SQL standard and may not
1482 be supported by all database engines.
1486 =head2 update($table, \%fieldvals, \%where)
1488 This takes a table, hashref of field/value pairs, and an optional
1489 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1491 See the sections on L</"Inserting and Updating Arrays"> and
1492 L</"Inserting and Updating SQL"> for information on how to insert
1493 with those data types.
1495 =head2 select($source, $fields, $where, $order)
1497 This returns a SQL SELECT statement and associated list of bind values, as
1498 specified by the arguments :
1504 Specification of the 'FROM' part of the statement.
1505 The argument can be either a plain scalar (interpreted as a table
1506 name, will be quoted), or an arrayref (interpreted as a list
1507 of table names, joined by commas, quoted), or a scalarref
1508 (literal table name, not quoted), or a ref to an arrayref
1509 (list of literal table names, joined by commas, not quoted).
1513 Specification of the list of fields to retrieve from
1515 The argument can be either an arrayref (interpreted as a list
1516 of field names, will be joined by commas and quoted), or a
1517 plain scalar (literal SQL, not quoted).
1518 Please observe that this API is not as flexible as for
1519 the first argument C<$table>, for backwards compatibility reasons.
1523 Optional argument to specify the WHERE part of the query.
1524 The argument is most often a hashref, but can also be
1525 an arrayref or plain scalar --
1526 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1530 Optional argument to specify the ORDER BY part of the query.
1531 The argument can be a scalar, a hashref or an arrayref
1532 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1538 =head2 delete($table, \%where)
1540 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1541 It returns an SQL DELETE statement and list of bind values.
1543 =head2 where(\%where, \@order)
1545 This is used to generate just the WHERE clause. For example,
1546 if you have an arbitrary data structure and know what the
1547 rest of your SQL is going to look like, but want an easy way
1548 to produce a WHERE clause, use this. It returns an SQL WHERE
1549 clause and list of bind values.
1552 =head2 values(\%data)
1554 This just returns the values from the hash C<%data>, in the same
1555 order that would be returned from any of the other above queries.
1556 Using this allows you to markedly speed up your queries if you
1557 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1559 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1561 Warning: This is an experimental method and subject to change.
1563 This returns arbitrarily generated SQL. It's a really basic shortcut.
1564 It will return two different things, depending on return context:
1566 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1567 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1569 These would return the following:
1571 # First calling form
1572 $stmt = "CREATE TABLE test (?, ?)";
1573 @bind = (field1, field2);
1575 # Second calling form
1576 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1578 Depending on what you're trying to do, it's up to you to choose the correct
1579 format. In this example, the second form is what you would want.
1583 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1587 ALTER SESSION SET nls_date_format = 'MM/YY'
1589 You get the idea. Strings get their case twiddled, but everything
1590 else remains verbatim.
1592 =head1 WHERE CLAUSES
1596 This module uses a variation on the idea from L<DBIx::Abstract>. It
1597 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1598 module is that things in arrays are OR'ed, and things in hashes
1601 The easiest way to explain is to show lots of examples. After
1602 each C<%where> hash shown, it is assumed you used:
1604 my($stmt, @bind) = $sql->where(\%where);
1606 However, note that the C<%where> hash can be used directly in any
1607 of the other functions as well, as described above.
1609 =head2 Key-value pairs
1611 So, let's get started. To begin, a simple hash:
1615 status => 'completed'
1618 Is converted to SQL C<key = val> statements:
1620 $stmt = "WHERE user = ? AND status = ?";
1621 @bind = ('nwiger', 'completed');
1623 One common thing I end up doing is having a list of values that
1624 a field can be in. To do this, simply specify a list inside of
1629 status => ['assigned', 'in-progress', 'pending'];
1632 This simple code will create the following:
1634 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1635 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1637 A field associated to an empty arrayref will be considered a
1638 logical false and will generate 0=1.
1640 =head2 Tests for NULL values
1642 If the value part is C<undef> then this is converted to SQL <IS NULL>
1651 $stmt = "WHERE user = ? AND status IS NULL";
1654 To test if a column IS NOT NULL:
1658 status => { '!=', undef },
1661 =head2 Specific comparison operators
1663 If you want to specify a different type of operator for your comparison,
1664 you can use a hashref for a given column:
1668 status => { '!=', 'completed' }
1671 Which would generate:
1673 $stmt = "WHERE user = ? AND status != ?";
1674 @bind = ('nwiger', 'completed');
1676 To test against multiple values, just enclose the values in an arrayref:
1678 status => { '=', ['assigned', 'in-progress', 'pending'] };
1680 Which would give you:
1682 "WHERE status = ? OR status = ? OR status = ?"
1685 The hashref can also contain multiple pairs, in which case it is expanded
1686 into an C<AND> of its elements:
1690 status => { '!=', 'completed', -not_like => 'pending%' }
1693 # Or more dynamically, like from a form
1694 $where{user} = 'nwiger';
1695 $where{status}{'!='} = 'completed';
1696 $where{status}{'-not_like'} = 'pending%';
1698 # Both generate this
1699 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1700 @bind = ('nwiger', 'completed', 'pending%');
1703 To get an OR instead, you can combine it with the arrayref idea:
1707 priority => [ { '=', 2 }, { '>', 5 } ]
1710 Which would generate:
1712 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1713 @bind = ('2', '5', 'nwiger');
1715 If you want to include literal SQL (with or without bind values), just use a
1716 scalar reference or array reference as the value:
1719 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1720 date_expires => { '<' => \"now()" }
1723 Which would generate:
1725 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1726 @bind = ('11/26/2008');
1729 =head2 Logic and nesting operators
1731 In the example above,
1732 there is a subtle trap if you want to say something like
1733 this (notice the C<AND>):
1735 WHERE priority != ? AND priority != ?
1737 Because, in Perl you I<can't> do this:
1739 priority => { '!=', 2, '!=', 1 }
1741 As the second C<!=> key will obliterate the first. The solution
1742 is to use the special C<-modifier> form inside an arrayref:
1744 priority => [ -and => {'!=', 2},
1748 Normally, these would be joined by C<OR>, but the modifier tells it
1749 to use C<AND> instead. (Hint: You can use this in conjunction with the
1750 C<logic> option to C<new()> in order to change the way your queries
1751 work by default.) B<Important:> Note that the C<-modifier> goes
1752 B<INSIDE> the arrayref, as an extra first element. This will
1753 B<NOT> do what you think it might:
1755 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1757 Here is a quick list of equivalencies, since there is some overlap:
1760 status => {'!=', 'completed', 'not like', 'pending%' }
1761 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1764 status => {'=', ['assigned', 'in-progress']}
1765 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1766 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1770 =head2 Special operators : IN, BETWEEN, etc.
1772 You can also use the hashref format to compare a list of fields using the
1773 C<IN> comparison operator, by specifying the list as an arrayref:
1776 status => 'completed',
1777 reportid => { -in => [567, 2335, 2] }
1780 Which would generate:
1782 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1783 @bind = ('completed', '567', '2335', '2');
1785 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1788 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1789 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1790 'sqltrue' (by default : C<1=1>).
1792 In addition to the array you can supply a chunk of literal sql or
1793 literal sql with bind:
1796 customer => { -in => \[
1797 'SELECT cust_id FROM cust WHERE balance > ?',
1800 status => { -in => \'SELECT status_codes FROM states' },
1806 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1807 AND status IN ( SELECT status_codes FROM states )
1813 Another pair of operators is C<-between> and C<-not_between>,
1814 used with an arrayref of two values:
1818 completion_date => {
1819 -not_between => ['2002-10-01', '2003-02-06']
1825 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1827 Just like with C<-in> all plausible combinations of literal SQL
1831 start0 => { -between => [ 1, 2 ] },
1832 start1 => { -between => \["? AND ?", 1, 2] },
1833 start2 => { -between => \"lower(x) AND upper(y)" },
1834 start3 => { -between => [
1836 \["upper(?)", 'stuff' ],
1843 ( start0 BETWEEN ? AND ? )
1844 AND ( start1 BETWEEN ? AND ? )
1845 AND ( start2 BETWEEN lower(x) AND upper(y) )
1846 AND ( start3 BETWEEN lower(x) AND upper(?) )
1848 @bind = (1, 2, 1, 2, 'stuff');
1851 These are the two builtin "special operators"; but the
1852 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1854 =head2 Unary operators: bool
1856 If you wish to test against boolean columns or functions within your
1857 database you can use the C<-bool> and C<-not_bool> operators. For
1858 example to test the column C<is_user> being true and the column
1859 C<is_enabled> being false you would use:-
1863 -not_bool => 'is_enabled',
1868 WHERE is_user AND NOT is_enabled
1870 If a more complex combination is required, testing more conditions,
1871 then you should use the and/or operators:-
1878 -not_bool => 'four',
1884 WHERE one AND two AND three AND NOT four
1887 =head2 Nested conditions, -and/-or prefixes
1889 So far, we've seen how multiple conditions are joined with a top-level
1890 C<AND>. We can change this by putting the different conditions we want in
1891 hashes and then putting those hashes in an array. For example:
1896 status => { -like => ['pending%', 'dispatched'] },
1900 status => 'unassigned',
1904 This data structure would create the following:
1906 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1907 OR ( user = ? AND status = ? ) )";
1908 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1911 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
1912 to change the logic inside :
1918 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1919 -or => { workhrs => {'<', 50}, geo => 'EURO' },
1926 WHERE ( user = ? AND (
1927 ( workhrs > ? AND geo = ? )
1928 OR ( workhrs < ? OR geo = ? )
1931 =head3 Algebraic inconsistency, for historical reasons
1933 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
1934 operator goes C<outside> of the nested structure; whereas when connecting
1935 several constraints on one column, the C<-and> operator goes
1936 C<inside> the arrayref. Here is an example combining both features :
1939 -and => [a => 1, b => 2],
1940 -or => [c => 3, d => 4],
1941 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
1946 WHERE ( ( ( a = ? AND b = ? )
1947 OR ( c = ? OR d = ? )
1948 OR ( e LIKE ? AND e LIKE ? ) ) )
1950 This difference in syntax is unfortunate but must be preserved for
1951 historical reasons. So be careful : the two examples below would
1952 seem algebraically equivalent, but they are not
1954 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
1955 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
1957 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
1958 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
1961 =head2 Literal SQL and value type operators
1963 The basic premise of SQL::Abstract is that in WHERE specifications the "left
1964 side" is a column name and the "right side" is a value (normally rendered as
1965 a placeholder). This holds true for both hashrefs and arrayref pairs as you
1966 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
1967 alter this behavior. There are several ways of doing so.
1971 This is a virtual operator that signals the string to its right side is an
1972 identifier (a column name) and not a value. For example to compare two
1973 columns you would write:
1976 priority => { '<', 2 },
1977 requestor => { -ident => 'submitter' },
1982 $stmt = "WHERE priority < ? AND requestor = submitter";
1985 If you are maintaining legacy code you may see a different construct as
1986 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
1991 This is a virtual operator that signals that the construct to its right side
1992 is a value to be passed to DBI. This is for example necessary when you want
1993 to write a where clause against an array (for RDBMS that support such
1994 datatypes). For example:
1997 array => { -value => [1, 2, 3] }
2002 $stmt = 'WHERE array = ?';
2003 @bind = ([1, 2, 3]);
2005 Note that if you were to simply say:
2011 the result would porbably be not what you wanted:
2013 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2018 Finally, sometimes only literal SQL will do. To include a random snippet
2019 of SQL verbatim, you specify it as a scalar reference. Consider this only
2020 as a last resort. Usually there is a better way. For example:
2023 priority => { '<', 2 },
2024 requestor => { -in => \'(SELECT name FROM hitmen)' },
2029 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2032 Note that in this example, you only get one bind parameter back, since
2033 the verbatim SQL is passed as part of the statement.
2037 Never use untrusted input as a literal SQL argument - this is a massive
2038 security risk (there is no way to check literal snippets for SQL
2039 injections and other nastyness). If you need to deal with untrusted input
2040 use literal SQL with placeholders as described next.
2042 =head3 Literal SQL with placeholders and bind values (subqueries)
2044 If the literal SQL to be inserted has placeholders and bind values,
2045 use a reference to an arrayref (yes this is a double reference --
2046 not so common, but perfectly legal Perl). For example, to find a date
2047 in Postgres you can use something like this:
2050 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2055 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2058 Note that you must pass the bind values in the same format as they are returned
2059 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2060 provide the bind values in the C<< [ column_meta => value ] >> format, where
2061 C<column_meta> is an opaque scalar value; most commonly the column name, but
2062 you can use any scalar value (including references and blessed references),
2063 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2064 to C<columns> the above example will look like:
2067 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2070 Literal SQL is especially useful for nesting parenthesized clauses in the
2071 main SQL query. Here is a first example :
2073 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2077 bar => \["IN ($sub_stmt)" => @sub_bind],
2082 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2083 WHERE c2 < ? AND c3 LIKE ?))";
2084 @bind = (1234, 100, "foo%");
2086 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2087 are expressed in the same way. Of course the C<$sub_stmt> and
2088 its associated bind values can be generated through a former call
2091 my ($sub_stmt, @sub_bind)
2092 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2093 c3 => {-like => "foo%"}});
2096 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2099 In the examples above, the subquery was used as an operator on a column;
2100 but the same principle also applies for a clause within the main C<%where>
2101 hash, like an EXISTS subquery :
2103 my ($sub_stmt, @sub_bind)
2104 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2105 my %where = ( -and => [
2107 \["EXISTS ($sub_stmt)" => @sub_bind],
2112 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2113 WHERE c1 = ? AND c2 > t0.c0))";
2117 Observe that the condition on C<c2> in the subquery refers to
2118 column C<t0.c0> of the main query : this is I<not> a bind
2119 value, so we have to express it through a scalar ref.
2120 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2121 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2122 what we wanted here.
2124 Finally, here is an example where a subquery is used
2125 for expressing unary negation:
2127 my ($sub_stmt, @sub_bind)
2128 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2129 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2131 lname => {like => '%son%'},
2132 \["NOT ($sub_stmt)" => @sub_bind],
2137 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2138 @bind = ('%son%', 10, 20)
2140 =head3 Deprecated usage of Literal SQL
2142 Below are some examples of archaic use of literal SQL. It is shown only as
2143 reference for those who deal with legacy code. Each example has a much
2144 better, cleaner and safer alternative that users should opt for in new code.
2150 my %where = ( requestor => \'IS NOT NULL' )
2152 $stmt = "WHERE requestor IS NOT NULL"
2154 This used to be the way of generating NULL comparisons, before the handling
2155 of C<undef> got formalized. For new code please use the superior syntax as
2156 described in L</Tests for NULL values>.
2160 my %where = ( requestor => \'= submitter' )
2162 $stmt = "WHERE requestor = submitter"
2164 This used to be the only way to compare columns. Use the superior L</-ident>
2165 method for all new code. For example an identifier declared in such a way
2166 will be properly quoted if L</quote_char> is properly set, while the legacy
2167 form will remain as supplied.
2171 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2173 $stmt = "WHERE completed > ? AND is_ready"
2174 @bind = ('2012-12-21')
2176 Using an empty string literal used to be the only way to express a boolean.
2177 For all new code please use the much more readable
2178 L<-bool|/Unary operators: bool> operator.
2184 These pages could go on for a while, since the nesting of the data
2185 structures this module can handle are pretty much unlimited (the
2186 module implements the C<WHERE> expansion as a recursive function
2187 internally). Your best bet is to "play around" with the module a
2188 little to see how the data structures behave, and choose the best
2189 format for your data based on that.
2191 And of course, all the values above will probably be replaced with
2192 variables gotten from forms or the command line. After all, if you
2193 knew everything ahead of time, you wouldn't have to worry about
2194 dynamically-generating SQL and could just hardwire it into your
2197 =head1 ORDER BY CLAUSES
2199 Some functions take an order by clause. This can either be a scalar (just a
2200 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2201 or an array of either of the two previous forms. Examples:
2203 Given | Will Generate
2204 ----------------------------------------------------------
2206 \'colA DESC' | ORDER BY colA DESC
2208 'colA' | ORDER BY colA
2210 [qw/colA colB/] | ORDER BY colA, colB
2212 {-asc => 'colA'} | ORDER BY colA ASC
2214 {-desc => 'colB'} | ORDER BY colB DESC
2216 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2218 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2221 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2222 { -desc => [qw/colB/], | colC ASC, colD ASC
2223 { -asc => [qw/colC colD/],|
2225 ===========================================================
2229 =head1 SPECIAL OPERATORS
2231 my $sqlmaker = SQL::Abstract->new(special_ops => [
2235 my ($self, $field, $op, $arg) = @_;
2241 handler => 'method_name',
2245 A "special operator" is a SQL syntactic clause that can be
2246 applied to a field, instead of a usual binary operator.
2249 WHERE field IN (?, ?, ?)
2250 WHERE field BETWEEN ? AND ?
2251 WHERE MATCH(field) AGAINST (?, ?)
2253 Special operators IN and BETWEEN are fairly standard and therefore
2254 are builtin within C<SQL::Abstract> (as the overridable methods
2255 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2256 like the MATCH .. AGAINST example above which is specific to MySQL,
2257 you can write your own operator handlers - supply a C<special_ops>
2258 argument to the C<new> method. That argument takes an arrayref of
2259 operator definitions; each operator definition is a hashref with two
2266 the regular expression to match the operator
2270 Either a coderef or a plain scalar method name. In both cases
2271 the expected return is C<< ($sql, @bind) >>.
2273 When supplied with a method name, it is simply called on the
2274 L<SQL::Abstract/> object as:
2276 $self->$method_name ($field, $op, $arg)
2280 $op is the part that matched the handler regex
2281 $field is the LHS of the operator
2284 When supplied with a coderef, it is called as:
2286 $coderef->($self, $field, $op, $arg)
2291 For example, here is an implementation
2292 of the MATCH .. AGAINST syntax for MySQL
2294 my $sqlmaker = SQL::Abstract->new(special_ops => [
2296 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2297 {regex => qr/^match$/i,
2299 my ($self, $field, $op, $arg) = @_;
2300 $arg = [$arg] if not ref $arg;
2301 my $label = $self->_quote($field);
2302 my ($placeholder) = $self->_convert('?');
2303 my $placeholders = join ", ", (($placeholder) x @$arg);
2304 my $sql = $self->_sqlcase('match') . " ($label) "
2305 . $self->_sqlcase('against') . " ($placeholders) ";
2306 my @bind = $self->_bindtype($field, @$arg);
2307 return ($sql, @bind);
2314 =head1 UNARY OPERATORS
2316 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2320 my ($self, $op, $arg) = @_;
2326 handler => 'method_name',
2330 A "unary operator" is a SQL syntactic clause that can be
2331 applied to a field - the operator goes before the field
2333 You can write your own operator handlers - supply a C<unary_ops>
2334 argument to the C<new> method. That argument takes an arrayref of
2335 operator definitions; each operator definition is a hashref with two
2342 the regular expression to match the operator
2346 Either a coderef or a plain scalar method name. In both cases
2347 the expected return is C<< $sql >>.
2349 When supplied with a method name, it is simply called on the
2350 L<SQL::Abstract/> object as:
2352 $self->$method_name ($op, $arg)
2356 $op is the part that matched the handler regex
2357 $arg is the RHS or argument of the operator
2359 When supplied with a coderef, it is called as:
2361 $coderef->($self, $op, $arg)
2369 Thanks to some benchmarking by Mark Stosberg, it turns out that
2370 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2371 I must admit this wasn't an intentional design issue, but it's a
2372 byproduct of the fact that you get to control your C<DBI> handles
2375 To maximize performance, use a code snippet like the following:
2377 # prepare a statement handle using the first row
2378 # and then reuse it for the rest of the rows
2380 for my $href (@array_of_hashrefs) {
2381 $stmt ||= $sql->insert('table', $href);
2382 $sth ||= $dbh->prepare($stmt);
2383 $sth->execute($sql->values($href));
2386 The reason this works is because the keys in your C<$href> are sorted
2387 internally by B<SQL::Abstract>. Thus, as long as your data retains
2388 the same structure, you only have to generate the SQL the first time
2389 around. On subsequent queries, simply use the C<values> function provided
2390 by this module to return your values in the correct order.
2392 However this depends on the values having the same type - if, for
2393 example, the values of a where clause may either have values
2394 (resulting in sql of the form C<column = ?> with a single bind
2395 value), or alternatively the values might be C<undef> (resulting in
2396 sql of the form C<column IS NULL> with no bind value) then the
2397 caching technique suggested will not work.
2401 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2402 really like this part (I do, at least). Building up a complex query
2403 can be as simple as the following:
2407 use CGI::FormBuilder;
2410 my $form = CGI::FormBuilder->new(...);
2411 my $sql = SQL::Abstract->new;
2413 if ($form->submitted) {
2414 my $field = $form->field;
2415 my $id = delete $field->{id};
2416 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2419 Of course, you would still have to connect using C<DBI> to run the
2420 query, but the point is that if you make your form look like your
2421 table, the actual query script can be extremely simplistic.
2423 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2424 a fast interface to returning and formatting data. I frequently
2425 use these three modules together to write complex database query
2426 apps in under 50 lines.
2432 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2434 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2440 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2441 Great care has been taken to preserve the I<published> behavior
2442 documented in previous versions in the 1.* family; however,
2443 some features that were previously undocumented, or behaved
2444 differently from the documentation, had to be changed in order
2445 to clarify the semantics. Hence, client code that was relying
2446 on some dark areas of C<SQL::Abstract> v1.*
2447 B<might behave differently> in v1.50.
2449 The main changes are :
2455 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2459 support for the { operator => \"..." } construct (to embed literal SQL)
2463 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2467 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2471 defensive programming : check arguments
2475 fixed bug with global logic, which was previously implemented
2476 through global variables yielding side-effects. Prior versions would
2477 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2478 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2479 Now this is interpreted
2480 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2485 fixed semantics of _bindtype on array args
2489 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2490 we just avoid shifting arrays within that tree.
2494 dropped the C<_modlogic> function
2498 =head1 ACKNOWLEDGEMENTS
2500 There are a number of individuals that have really helped out with
2501 this module. Unfortunately, most of them submitted bugs via CPAN
2502 so I have no idea who they are! But the people I do know are:
2504 Ash Berlin (order_by hash term support)
2505 Matt Trout (DBIx::Class support)
2506 Mark Stosberg (benchmarking)
2507 Chas Owens (initial "IN" operator support)
2508 Philip Collins (per-field SQL functions)
2509 Eric Kolve (hashref "AND" support)
2510 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2511 Dan Kubb (support for "quote_char" and "name_sep")
2512 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2513 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2514 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2515 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2516 Oliver Charles (support for "RETURNING" after "INSERT")
2522 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2526 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2528 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2530 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2531 While not an official support venue, C<DBIx::Class> makes heavy use of
2532 C<SQL::Abstract>, and as such list members there are very familiar with
2533 how to create queries.
2537 This module is free software; you may copy this under the same
2538 terms as perl itself (either the GNU General Public License or
2539 the Artistic License)