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
16 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 # special operators (-in, -between). May be extended/overridden by user.
30 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
31 my @BUILTIN_SPECIAL_OPS = (
32 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
33 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
34 {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
35 {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
38 # unaryish operators - key maps to handler
39 my @BUILTIN_UNARY_OPS = (
40 # the digits are backcompat stuff
41 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
42 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
43 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
44 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
45 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
46 { regex => qr/^ value $/ix, handler => '_where_op_VALUE' },
49 #======================================================================
50 # DEBUGGING AND ERROR REPORTING
51 #======================================================================
54 return unless $_[0]->{debug}; shift; # a little faster
55 my $func = (caller(1))[3];
56 warn "[$func] ", @_, "\n";
60 my($func) = (caller(1))[3];
61 Carp::carp "[$func] Warning: ", @_;
65 my($func) = (caller(1))[3];
66 Carp::croak "[$func] Fatal: ", @_;
70 #======================================================================
72 #======================================================================
76 my $class = ref($self) || $self;
77 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
79 # choose our case by keeping an option around
80 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
82 # default logic for interpreting arrayrefs
83 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
85 # how to return bind vars
86 # LDNOTE: changed nwiger code : why this 'delete' ??
87 # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
88 $opt{bindtype} ||= 'normal';
90 # default comparison is "=", but can be overridden
93 # try to recognize which are the 'equality' and 'unequality' ops
94 # (temporary quickfix, should go through a more seasoned API)
95 $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
96 $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
99 $opt{sqltrue} ||= '1=1';
100 $opt{sqlfalse} ||= '0=1';
103 $opt{special_ops} ||= [];
104 # regexes are applied in order, thus push after user-defines
105 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
108 $opt{unary_ops} ||= [];
109 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
111 # rudimentary saniy-check for user supplied bits treated as functions/operators
112 # If a purported function matches this regular expression, an exception is thrown.
113 # Literal SQL is *NOT* subject to this check, only functions (and column names
114 # when quoting is not in effect)
117 # need to guard against ()'s in column names too, but this will break tons of
118 # hacks... ideas anyone?
119 $opt{injection_guard} ||= qr/
125 $opt{name_sep} ||= '.';
127 $opt{renderer} ||= do {
128 require Data::Query::Renderer::SQL::Naive;
129 my ($always, $chars);
130 for ($opt{quote_char}) {
131 $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
134 Data::Query::Renderer::SQL::Naive->new({
135 quote_chars => $chars, always_quote => $always,
139 return bless \%opt, $class;
143 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) ]) : ()),
165 sub _literal_with_prepend_to_dq {
166 my ($self, $prepend, $literal) = @_;
168 $self->_literal_to_dq(
169 [ join(' ', $prepend, $literal->[0]), @{$literal}[1..$#$literal] ]
172 $self->_literal_to_dq(
173 join(' ', $prepend, $literal)
179 my ($self, @bind) = @_;
181 $self->{bindtype} eq 'normal'
182 ? map perl_scalar_value($_), @bind
184 $self->_assert_bindval_matches_bindtype(@bind);
185 map perl_scalar_value(reverse @$_), @bind
190 my ($self, $value) = @_;
191 perl_scalar_value($value, our $Cur_Col_Meta);
195 my ($self, $ident) = @_;
197 type => DQ_IDENTIFIER,
198 elements => [ split /\Q$self->{name_sep}/, $ident ],
202 sub _assert_pass_injection_guard {
203 if ($_[1] =~ $_[0]->{injection_guard}) {
204 my $class = ref $_[0];
205 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
206 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
207 . "{injection_guard} attribute to ${class}->new()"
212 #======================================================================
214 #======================================================================
218 my $table = $self->_table(shift);
219 my $data = shift || return;
222 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
223 my ($sql, @bind) = $self->$method($data);
224 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
226 if ($options->{returning}) {
227 my ($s, @b) = $self->_insert_returning ($options);
232 return wantarray ? ($sql, @bind) : $sql;
235 sub _insert_returning {
236 my ($self, $options) = @_;
238 my $f = $options->{returning};
240 my $fieldlist = $self->_SWITCH_refkind($f, {
241 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
242 SCALAR => sub {$self->_quote($f)},
243 SCALARREF => sub {$$f},
245 return $self->_sqlcase(' returning ') . $fieldlist;
248 sub _insert_HASHREF { # explicit list of fields and then values
249 my ($self, $data) = @_;
251 my @fields = sort keys %$data;
253 my ($sql, @bind) = $self->_insert_values($data);
256 $_ = $self->_quote($_) foreach @fields;
257 $sql = "( ".join(", ", @fields).") ".$sql;
259 return ($sql, @bind);
262 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
263 my ($self, $data) = @_;
265 # no names (arrayref) so can't generate bindtype
266 $self->{bindtype} ne 'columns'
267 or belch "can't do 'columns' bindtype when called with arrayref";
269 # fold the list of values into a hash of column name - value pairs
270 # (where the column names are artificially generated, and their
271 # lexicographical ordering keep the ordering of the original list)
272 my $i = "a"; # incremented values will be in lexicographical order
273 my $data_in_hash = { map { ($i++ => $_) } @$data };
275 return $self->_insert_values($data_in_hash);
278 sub _insert_ARRAYREFREF { # literal SQL with bind
279 my ($self, $data) = @_;
281 my ($sql, @bind) = @${$data};
282 $self->_assert_bindval_matches_bindtype(@bind);
284 return ($sql, @bind);
288 sub _insert_SCALARREF { # literal SQL without bind
289 my ($self, $data) = @_;
295 my ($self, $data) = @_;
297 my (@values, @all_bind);
298 foreach my $column (sort keys %$data) {
299 my $v = $data->{$column};
301 $self->_SWITCH_refkind($v, {
304 if ($self->{array_datatypes}) { # if array datatype are activated
306 push @all_bind, $self->_bindtype($column, $v);
308 else { # else literal SQL with bind
309 my ($sql, @bind) = @$v;
310 $self->_assert_bindval_matches_bindtype(@bind);
312 push @all_bind, @bind;
316 ARRAYREFREF => sub { # literal SQL with bind
317 my ($sql, @bind) = @${$v};
318 $self->_assert_bindval_matches_bindtype(@bind);
320 push @all_bind, @bind;
323 # THINK : anything useful to do with a HASHREF ?
324 HASHREF => sub { # (nothing, but old SQLA passed it through)
325 #TODO in SQLA >= 2.0 it will die instead
326 belch "HASH ref as bind value in insert is not supported";
328 push @all_bind, $self->_bindtype($column, $v);
331 SCALARREF => sub { # literal SQL without bind
335 SCALAR_or_UNDEF => sub {
337 push @all_bind, $self->_bindtype($column, $v);
344 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
345 return ($sql, @all_bind);
350 #======================================================================
352 #======================================================================
357 my $table = $self->_table(shift);
358 my $data = shift || return;
361 # first build the 'SET' part of the sql statement
362 my (@set, @all_bind);
363 puke "Unsupported data type specified to \$sql->update"
364 unless ref $data eq 'HASH';
366 for my $k (sort keys %$data) {
369 my $label = $self->_quote($k);
371 $self->_SWITCH_refkind($v, {
373 if ($self->{array_datatypes}) { # array datatype
374 push @set, "$label = ?";
375 push @all_bind, $self->_bindtype($k, $v);
377 else { # literal SQL with bind
378 my ($sql, @bind) = @$v;
379 $self->_assert_bindval_matches_bindtype(@bind);
380 push @set, "$label = $sql";
381 push @all_bind, @bind;
384 ARRAYREFREF => sub { # literal SQL with bind
385 my ($sql, @bind) = @${$v};
386 $self->_assert_bindval_matches_bindtype(@bind);
387 push @set, "$label = $sql";
388 push @all_bind, @bind;
390 SCALARREF => sub { # literal SQL without bind
391 push @set, "$label = $$v";
394 my ($op, $arg, @rest) = %$v;
396 puke 'Operator calls in update must be in the form { -op => $arg }'
397 if (@rest or not $op =~ /^\-(.+)/);
399 local $self->{_nested_func_lhs} = $k;
400 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
402 push @set, "$label = $sql";
403 push @all_bind, @bind;
405 SCALAR_or_UNDEF => sub {
406 push @set, "$label = ?";
407 push @all_bind, $self->_bindtype($k, $v);
413 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
417 my($where_sql, @where_bind) = $self->where($where);
419 push @all_bind, @where_bind;
422 return wantarray ? ($sql, @all_bind) : $sql;
428 #======================================================================
430 #======================================================================
436 my $fields = shift || '*';
440 my($where_sql, @bind) = $self->where($where, $order);
442 my $sql = $self->_render_dq({
445 map $self->_ident_to_dq($_),
446 ref($fields) eq 'ARRAY' ? @$fields : $fields
448 from => $self->_table_to_dq($table),
453 return wantarray ? ($sql, @bind) : $sql;
456 #======================================================================
458 #======================================================================
463 my $table = $self->_table(shift);
467 my($where_sql, @bind) = $self->where($where);
468 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
470 return wantarray ? ($sql, @bind) : $sql;
474 #======================================================================
476 #======================================================================
480 # Finally, a separate routine just to handle WHERE clauses
482 my ($self, $where, $order) = @_;
488 ($sql, @bind) = $self->_recurse_where($where) if defined($where);
489 $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
493 $sql .= $self->_order_by($order);
496 return wantarray ? ($sql, @bind) : $sql;
501 my ($self, $where, $logic) = @_;
503 return $self->_render_dq($self->_where_to_dq($where, $logic));
507 my ($self, $where, $logic) = @_;
509 if (ref($where) eq 'ARRAY') {
510 return $self->_where_to_dq_ARRAYREF($where, $logic);
511 } elsif (ref($where) eq 'HASH') {
512 return $self->_where_to_dq_HASHREF($where, $logic);
514 ref($where) eq 'SCALAR'
515 or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
517 return $self->_literal_to_dq($$where);
518 } elsif (!ref($where) or Scalar::Util::blessed($where)) {
519 return $self->_value_to_dq($where);
521 die "Can't handle $where";
524 sub _where_to_dq_ARRAYREF {
525 my ($self, $where, $logic) = @_;
527 $logic = uc($logic || 'OR');
528 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
530 return unless @$where;
532 my ($first, @rest) = @$where;
534 return $self->_where_to_dq($first) unless @rest;
538 $self->_where_hashpair_to_dq($first => shift(@rest));
540 $self->_where_to_dq($first);
544 return $self->_where_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
548 operator => { 'SQL.Naive' => $logic },
549 args => [ $first_dq, $self->_where_to_dq_ARRAYREF(\@rest, $logic) ]
553 sub _where_to_dq_HASHREF {
554 my ($self, $where, $logic) = @_;
556 $logic = uc($logic || 'AND');
559 $self->_where_hashpair_to_dq($_ => $where->{$_})
562 return $dq[0] unless @dq > 1;
564 my $final = pop(@dq);
566 foreach my $dq (reverse @dq) {
569 operator => { 'SQL.Naive' => $logic },
570 args => [ $dq, $final ]
577 sub _where_to_dq_SCALAR {
578 shift->_value_to_dq(@_);
581 sub _where_op_IDENT {
583 my ($op, $rhs) = splice @_, -2;
585 puke "-$op takes a single scalar argument (a quotable identifier)";
588 # in case we are called as a top level special op (no '=')
591 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
599 sub _where_op_VALUE {
601 my ($op, $rhs) = splice @_, -2;
603 # in case we are called as a top level special op (no '=')
608 ($lhs || $self->{_nested_func_lhs}),
615 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
619 $self->_convert('?'),
625 sub _where_hashpair_to_dq {
626 my ($self, $k, $v) = @_;
630 if ($op eq 'AND' or $op eq 'OR') {
631 return $self->_where_to_dq($v, $op);
632 } elsif ($op eq 'NEST') {
633 return $self->_where_to_dq($v);
634 } elsif ($op eq 'NOT') {
637 operator => { 'SQL.Naive' => 'NOT' },
638 args => [ $self->_where_to_dq($v) ]
640 } elsif ($op eq 'BOOL') {
641 return ref($v) ? $self->_where_to_dq($v) : $self->_ident_to_dq($v);
642 } elsif ($op eq 'NOT_BOOL') {
645 operator => { 'SQL.Naive' => 'NOT' },
646 args => [ ref($v) ? $self->_where_to_dq($v) : $self->_ident_to_dq($v) ]
650 if (ref($v) eq 'HASH' and keys(%$v) == 1 and (keys %$v)[0] =~ /-(.*)/) {
651 my ($inner) = values %$v;
654 operator => { 'SQL.Naive' => uc($1) },
656 (map $self->_where_to_dq($_),
657 (ref($inner) eq 'ARRAY' ? @$inner : $inner))
661 (map $self->_where_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v))
666 operator => { 'SQL.Naive' => 'apply' },
668 $self->_ident_to_dq($op), @args
673 local our $Cur_Col_Meta = $k;
674 if (ref($v) eq 'ARRAY') {
676 return $self->_literal_to_dq($self->{sqlfalse});
677 } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
678 return $self->_where_to_dq_ARRAYREF([
679 map +{ $k => $_ }, @{$v}[1..$#$v]
682 return $self->_where_to_dq_ARRAYREF([
683 map +{ $k => $_ }, @$v
685 } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
686 # we have to do the quoting here, since Data::Query only understands
687 # literals that form a complete part of the SQL - there's no current
688 # way to say "render these bits and interpolate into the literal". I'm
689 # not as yet convinced that this is a problem; we'll see.
690 return $self->_literal_with_prepend_to_dq($self->_quote($k), $$v);
692 my ($op, $rhs) = do {
693 if (ref($v) eq 'HASH') {
695 return $self->_where_to_dq_ARRAYREF([
696 map +{ $k => { $_ => $v->{$_} } }, keys %$v
699 (uc((keys %$v)[0]), (values %$v)[0]);
704 s/^-//, s/_/ /g for $op;
705 if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
706 if (ref($rhs) ne 'ARRAY') {
708 # have to add parens if none present because -in => \"SELECT ..."
709 # got documented. mst hates everything.
710 if (ref($rhs) eq 'SCALAR') {
712 $x = "($x)" unless $x =~ /^\s*\(/;
715 my ($x, @rest) = @{$$rhs};
716 $x = "($x)" unless $x =~ /^\s*\(/;
717 $rhs = \[ $x, @rest ];
720 return $self->_literal_with_prepend_to_dq("$k $op", $$rhs);
722 return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
725 operator => { 'SQL.Naive' => $op },
726 args => [ $self->_ident_to_dq($k), map $self->_where_to_dq($_), @$rhs ]
728 } elsif ($op =~ s/^NOT (?!LIKE)//) {
729 return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
730 } elsif (!defined($rhs)) {
732 if ($op eq '=' or $op eq 'LIKE') {
734 } elsif ($op eq '!=') {
737 die "Can't do undef -> NULL transform for operator ${op}";
742 operator => { 'SQL.Naive' => $null_op },
743 args => [ $self->_ident_to_dq($k) ]
746 if (ref($rhs) eq 'ARRAY') {
748 return $self->_literal_to_dq(
749 $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
751 } elsif (defined($rhs->[0]) and $rhs->[0] =~ /-(and|or)/i) {
752 return $self->_where_to_dq_ARRAYREF([
753 map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
756 return $self->_where_to_dq_ARRAYREF([
757 map +{ $k => { $op => $_ } }, @$rhs
762 operator => { 'SQL.Naive' => $op },
763 args => [ $self->_ident_to_dq($k), $self->_where_to_dq($rhs) ]
768 #======================================================================
770 #======================================================================
773 my ($self, $arg) = @_;
774 if (my $dq = $self->_order_by_to_dq($arg)) {
775 # SQLA generates ' ORDER BY foo'. The hilarity.
777 ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
778 : ' '.$self->_render_dq($dq);
784 sub _order_by_to_dq {
785 my ($self, $arg, $dir) = @_;
791 ($dir ? (direction => $dir) : ()),
795 $dq->{by} = $self->_ident_to_dq($arg);
796 } elsif (ref($arg) eq 'ARRAY') {
798 local our $Order_Inner unless our $Order_Recursing;
799 local $Order_Recursing = 1;
801 foreach my $member (@$arg) {
803 my $next = $self->_order_by_to_dq($member, $dir);
805 $inner->{from} = $next if $inner;
806 $inner = $Order_Inner || $next;
808 $Order_Inner = $inner;
810 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
811 $dq->{by} = $self->_literal_to_dq($$arg);
812 } elsif (ref($arg) eq 'SCALAR') {
813 $dq->{by} = $self->_literal_to_dq($$arg);
814 } elsif (ref($arg) eq 'HASH') {
815 my ($key, $val, @rest) = %$arg;
819 if (@rest or not $key =~ /^-(desc|asc)/i) {
820 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
823 return $self->_order_by_to_dq($val, $dir);
825 die "Can't handle $arg in _order_by_to_dq";
830 #======================================================================
831 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
832 #======================================================================
835 my ($self, $from) = @_;
836 $self->_render_dq($self->_table_to_dq($from));
840 my ($self, $from) = @_;
841 $self->_SWITCH_refkind($from, {
843 die "Empty FROM list" unless my @f = @$from;
844 my $dq = $self->_ident_to_dq(shift @f);
845 while (my $x = shift @f) {
848 join => [ $dq, $self->_ident_to_dq($x) ]
853 SCALAR => sub { $self->_ident_to_dq($from) },
865 #======================================================================
867 #======================================================================
869 # highly optimized, as it's called way too often
871 # my ($self, $label) = @_;
873 return '' unless defined $_[1];
874 return ${$_[1]} if ref($_[1]) eq 'SCALAR';
876 unless ($_[0]->{quote_char}) {
877 $_[0]->_assert_pass_injection_guard($_[1]);
881 my $qref = ref $_[0]->{quote_char};
884 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
886 elsif ($qref eq 'ARRAY') {
887 ($l, $r) = @{$_[0]->{quote_char}};
890 puke "Unsupported quote_char format: $_[0]->{quote_char}";
893 # parts containing * are naturally unquoted
894 return join( $_[0]->{name_sep}||'', map
895 { $_ eq '*' ? $_ : $l . $_ . $r }
896 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
901 # Conversion, if applicable
903 #my ($self, $arg) = @_;
905 # LDNOTE : modified the previous implementation below because
906 # it was not consistent : the first "return" is always an array,
907 # the second "return" is context-dependent. Anyway, _convert
908 # seems always used with just a single argument, so make it a
910 # return @_ unless $self->{convert};
911 # my $conv = $self->_sqlcase($self->{convert});
912 # my @ret = map { $conv.'('.$_.')' } @_;
913 # return wantarray ? @ret : $ret[0];
914 if ($_[0]->{convert}) {
915 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
922 #my ($self, $col, @vals) = @_;
924 #LDNOTE : changed original implementation below because it did not make
925 # sense when bindtype eq 'columns' and @vals > 1.
926 # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
928 # called often - tighten code
929 return $_[0]->{bindtype} eq 'columns'
930 ? map {[$_[1], $_]} @_[2 .. $#_]
935 # Dies if any element of @bind is not in [colname => value] format
936 # if bindtype is 'columns'.
937 sub _assert_bindval_matches_bindtype {
938 # my ($self, @bind) = @_;
940 if ($self->{bindtype} eq 'columns') {
942 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
943 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
949 sub _join_sql_clauses {
950 my ($self, $logic, $clauses_aref, $bind_aref) = @_;
952 if (@$clauses_aref > 1) {
953 my $join = " " . $self->_sqlcase($logic) . " ";
954 my $sql = '( ' . join($join, @$clauses_aref) . ' )';
955 return ($sql, @$bind_aref);
957 elsif (@$clauses_aref) {
958 return ($clauses_aref->[0], @$bind_aref); # no parentheses
961 return (); # if no SQL, ignore @$bind_aref
966 # Fix SQL case, if so requested
968 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
969 # don't touch the argument ... crooked logic, but let's not change it!
970 return $_[0]->{case} ? $_[1] : uc($_[1]);
974 #======================================================================
975 # DISPATCHING FROM REFKIND
976 #======================================================================
979 my ($self, $data) = @_;
981 return 'UNDEF' unless defined $data;
983 # blessed objects are treated like scalars
984 my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
986 return 'SCALAR' unless $ref;
989 while ($ref eq 'REF') {
991 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
995 return ($ref||'SCALAR') . ('REF' x $n_steps);
999 my ($self, $data) = @_;
1000 my @try = ($self->_refkind($data));
1001 push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1002 push @try, 'FALLBACK';
1006 sub _METHOD_FOR_refkind {
1007 my ($self, $meth_prefix, $data) = @_;
1010 for (@{$self->_try_refkind($data)}) {
1011 $method = $self->can($meth_prefix."_".$_)
1015 return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1019 sub _SWITCH_refkind {
1020 my ($self, $data, $dispatch_table) = @_;
1023 for (@{$self->_try_refkind($data)}) {
1024 $coderef = $dispatch_table->{$_}
1028 puke "no dispatch entry for ".$self->_refkind($data)
1037 #======================================================================
1038 # VALUES, GENERATE, AUTOLOAD
1039 #======================================================================
1041 # LDNOTE: original code from nwiger, didn't touch code in that section
1042 # I feel the AUTOLOAD stuff should not be the default, it should
1043 # only be activated on explicit demand by user.
1047 my $data = shift || return;
1048 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1049 unless ref $data eq 'HASH';
1052 foreach my $k ( sort keys %$data ) {
1053 my $v = $data->{$k};
1054 $self->_SWITCH_refkind($v, {
1056 if ($self->{array_datatypes}) { # array datatype
1057 push @all_bind, $self->_bindtype($k, $v);
1059 else { # literal SQL with bind
1060 my ($sql, @bind) = @$v;
1061 $self->_assert_bindval_matches_bindtype(@bind);
1062 push @all_bind, @bind;
1065 ARRAYREFREF => sub { # literal SQL with bind
1066 my ($sql, @bind) = @${$v};
1067 $self->_assert_bindval_matches_bindtype(@bind);
1068 push @all_bind, @bind;
1070 SCALARREF => sub { # literal SQL without bind
1072 SCALAR_or_UNDEF => sub {
1073 push @all_bind, $self->_bindtype($k, $v);
1084 my(@sql, @sqlq, @sqlv);
1088 if ($ref eq 'HASH') {
1089 for my $k (sort keys %$_) {
1092 my $label = $self->_quote($k);
1093 if ($r eq 'ARRAY') {
1094 # literal SQL with bind
1095 my ($sql, @bind) = @$v;
1096 $self->_assert_bindval_matches_bindtype(@bind);
1097 push @sqlq, "$label = $sql";
1099 } elsif ($r eq 'SCALAR') {
1100 # literal SQL without bind
1101 push @sqlq, "$label = $$v";
1103 push @sqlq, "$label = ?";
1104 push @sqlv, $self->_bindtype($k, $v);
1107 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1108 } elsif ($ref eq 'ARRAY') {
1109 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1112 if ($r eq 'ARRAY') { # literal SQL with bind
1113 my ($sql, @bind) = @$v;
1114 $self->_assert_bindval_matches_bindtype(@bind);
1117 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1118 # embedded literal SQL
1125 push @sql, '(' . join(', ', @sqlq) . ')';
1126 } elsif ($ref eq 'SCALAR') {
1130 # strings get case twiddled
1131 push @sql, $self->_sqlcase($_);
1135 my $sql = join ' ', @sql;
1137 # this is pretty tricky
1138 # if ask for an array, return ($stmt, @bind)
1139 # otherwise, s/?/shift @sqlv/ to put it inline
1141 return ($sql, @sqlv);
1143 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1144 ref $d ? $d->[1] : $d/e;
1153 # This allows us to check for a local, then _form, attr
1155 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1156 return $self->generate($name, @_);
1167 SQL::Abstract - Generate SQL from Perl data structures
1173 my $sql = SQL::Abstract->new;
1175 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1177 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1179 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1181 my($stmt, @bind) = $sql->delete($table, \%where);
1183 # Then, use these in your DBI statements
1184 my $sth = $dbh->prepare($stmt);
1185 $sth->execute(@bind);
1187 # Just generate the WHERE clause
1188 my($stmt, @bind) = $sql->where(\%where, \@order);
1190 # Return values in the same order, for hashed queries
1191 # See PERFORMANCE section for more details
1192 my @bind = $sql->values(\%fieldvals);
1196 This module was inspired by the excellent L<DBIx::Abstract>.
1197 However, in using that module I found that what I really wanted
1198 to do was generate SQL, but still retain complete control over my
1199 statement handles and use the DBI interface. So, I set out to
1200 create an abstract SQL generation module.
1202 While based on the concepts used by L<DBIx::Abstract>, there are
1203 several important differences, especially when it comes to WHERE
1204 clauses. I have modified the concepts used to make the SQL easier
1205 to generate from Perl data structures and, IMO, more intuitive.
1206 The underlying idea is for this module to do what you mean, based
1207 on the data structures you provide it. The big advantage is that
1208 you don't have to modify your code every time your data changes,
1209 as this module figures it out.
1211 To begin with, an SQL INSERT is as easy as just specifying a hash
1212 of C<key=value> pairs:
1215 name => 'Jimbo Bobson',
1216 phone => '123-456-7890',
1217 address => '42 Sister Lane',
1218 city => 'St. Louis',
1219 state => 'Louisiana',
1222 The SQL can then be generated with this:
1224 my($stmt, @bind) = $sql->insert('people', \%data);
1226 Which would give you something like this:
1228 $stmt = "INSERT INTO people
1229 (address, city, name, phone, state)
1230 VALUES (?, ?, ?, ?, ?)";
1231 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1232 '123-456-7890', 'Louisiana');
1234 These are then used directly in your DBI code:
1236 my $sth = $dbh->prepare($stmt);
1237 $sth->execute(@bind);
1239 =head2 Inserting and Updating Arrays
1241 If your database has array types (like for example Postgres),
1242 activate the special option C<< array_datatypes => 1 >>
1243 when creating the C<SQL::Abstract> object.
1244 Then you may use an arrayref to insert and update database array types:
1246 my $sql = SQL::Abstract->new(array_datatypes => 1);
1248 planets => [qw/Mercury Venus Earth Mars/]
1251 my($stmt, @bind) = $sql->insert('solar_system', \%data);
1255 $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1257 @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1260 =head2 Inserting and Updating SQL
1262 In order to apply SQL functions to elements of your C<%data> you may
1263 specify a reference to an arrayref for the given hash value. For example,
1264 if you need to execute the Oracle C<to_date> function on a value, you can
1265 say something like this:
1269 date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1272 The first value in the array is the actual SQL. Any other values are
1273 optional and would be included in the bind values array. This gives
1276 my($stmt, @bind) = $sql->insert('people', \%data);
1278 $stmt = "INSERT INTO people (name, date_entered)
1279 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1280 @bind = ('Bill', '03/02/2003');
1282 An UPDATE is just as easy, all you change is the name of the function:
1284 my($stmt, @bind) = $sql->update('people', \%data);
1286 Notice that your C<%data> isn't touched; the module will generate
1287 the appropriately quirky SQL for you automatically. Usually you'll
1288 want to specify a WHERE clause for your UPDATE, though, which is
1289 where handling C<%where> hashes comes in handy...
1291 =head2 Complex where statements
1293 This module can generate pretty complicated WHERE statements
1294 easily. For example, simple C<key=value> pairs are taken to mean
1295 equality, and if you want to see if a field is within a set
1296 of values, you can use an arrayref. Let's say we wanted to
1297 SELECT some data based on this criteria:
1300 requestor => 'inna',
1301 worker => ['nwiger', 'rcwe', 'sfz'],
1302 status => { '!=', 'completed' }
1305 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1307 The above would give you something like this:
1309 $stmt = "SELECT * FROM tickets WHERE
1310 ( requestor = ? ) AND ( status != ? )
1311 AND ( worker = ? OR worker = ? OR worker = ? )";
1312 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1314 Which you could then use in DBI code like so:
1316 my $sth = $dbh->prepare($stmt);
1317 $sth->execute(@bind);
1323 The functions are simple. There's one for each major SQL operation,
1324 and a constructor you use first. The arguments are specified in a
1325 similar order to each function (table, then fields, then a where
1326 clause) to try and simplify things.
1331 =head2 new(option => 'value')
1333 The C<new()> function takes a list of options and values, and returns
1334 a new B<SQL::Abstract> object which can then be used to generate SQL
1335 through the methods below. The options accepted are:
1341 If set to 'lower', then SQL will be generated in all lowercase. By
1342 default SQL is generated in "textbook" case meaning something like:
1344 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1346 Any setting other than 'lower' is ignored.
1350 This determines what the default comparison operator is. By default
1351 it is C<=>, meaning that a hash like this:
1353 %where = (name => 'nwiger', email => 'nate@wiger.org');
1355 Will generate SQL like this:
1357 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1359 However, you may want loose comparisons by default, so if you set
1360 C<cmp> to C<like> you would get SQL such as:
1362 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1364 You can also override the comparsion on an individual basis - see
1365 the huge section on L</"WHERE CLAUSES"> at the bottom.
1367 =item sqltrue, sqlfalse
1369 Expressions for inserting boolean values within SQL statements.
1370 By default these are C<1=1> and C<1=0>. They are used
1371 by the special operators C<-in> and C<-not_in> for generating
1372 correct SQL even when the argument is an empty array (see below).
1376 This determines the default logical operator for multiple WHERE
1377 statements in arrays or hashes. If absent, the default logic is "or"
1378 for arrays, and "and" for hashes. This means that a WHERE
1382 event_date => {'>=', '2/13/99'},
1383 event_date => {'<=', '4/24/03'},
1386 will generate SQL like this:
1388 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1390 This is probably not what you want given this query, though (look
1391 at the dates). To change the "OR" to an "AND", simply specify:
1393 my $sql = SQL::Abstract->new(logic => 'and');
1395 Which will change the above C<WHERE> to:
1397 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1399 The logic can also be changed locally by inserting
1400 a modifier in front of an arrayref :
1402 @where = (-and => [event_date => {'>=', '2/13/99'},
1403 event_date => {'<=', '4/24/03'} ]);
1405 See the L</"WHERE CLAUSES"> section for explanations.
1409 This will automatically convert comparisons using the specified SQL
1410 function for both column and value. This is mostly used with an argument
1411 of C<upper> or C<lower>, so that the SQL will have the effect of
1412 case-insensitive "searches". For example, this:
1414 $sql = SQL::Abstract->new(convert => 'upper');
1415 %where = (keywords => 'MaKe iT CAse inSeNSItive');
1417 Will turn out the following SQL:
1419 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1421 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1422 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1423 not validate this option; it will just pass through what you specify verbatim).
1427 This is a kludge because many databases suck. For example, you can't
1428 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1429 Instead, you have to use C<bind_param()>:
1431 $sth->bind_param(1, 'reg data');
1432 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1434 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1435 which loses track of which field each slot refers to. Fear not.
1437 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1438 Currently, you can specify either C<normal> (default) or C<columns>. If you
1439 specify C<columns>, you will get an array that looks like this:
1441 my $sql = SQL::Abstract->new(bindtype => 'columns');
1442 my($stmt, @bind) = $sql->insert(...);
1445 [ 'column1', 'value1' ],
1446 [ 'column2', 'value2' ],
1447 [ 'column3', 'value3' ],
1450 You can then iterate through this manually, using DBI's C<bind_param()>.
1452 $sth->prepare($stmt);
1455 my($col, $data) = @$_;
1456 if ($col eq 'details' || $col eq 'comments') {
1457 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1458 } elsif ($col eq 'image') {
1459 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1461 $sth->bind_param($i, $data);
1465 $sth->execute; # execute without @bind now
1467 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1468 Basically, the advantage is still that you don't have to care which fields
1469 are or are not included. You could wrap that above C<for> loop in a simple
1470 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1471 get a layer of abstraction over manual SQL specification.
1473 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1474 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1475 will expect the bind values in this format.
1479 This is the character that a table or column name will be quoted
1480 with. By default this is an empty string, but you could set it to
1481 the character C<`>, to generate SQL like this:
1483 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1485 Alternatively, you can supply an array ref of two items, the first being the left
1486 hand quote character, and the second the right hand quote character. For
1487 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1488 that generates SQL like this:
1490 SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1492 Quoting is useful if you have tables or columns names that are reserved
1493 words in your database's SQL dialect.
1497 This is the character that separates a table and column name. It is
1498 necessary to specify this when the C<quote_char> option is selected,
1499 so that tables and column names can be individually quoted like this:
1501 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1503 =item injection_guard
1505 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1506 column name specified in a query structure. This is a safety mechanism to avoid
1507 injection attacks when mishandling user input e.g.:
1509 my %condition_as_column_value_pairs = get_values_from_user();
1510 $sqla->select( ... , \%condition_as_column_value_pairs );
1512 If the expression matches an exception is thrown. Note that literal SQL
1513 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1515 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1517 =item array_datatypes
1519 When this option is true, arrayrefs in INSERT or UPDATE are
1520 interpreted as array datatypes and are passed directly
1522 When this option is false, arrayrefs are interpreted
1523 as literal SQL, just like refs to arrayrefs
1524 (but this behavior is for backwards compatibility; when writing
1525 new queries, use the "reference to arrayref" syntax
1531 Takes a reference to a list of "special operators"
1532 to extend the syntax understood by L<SQL::Abstract>.
1533 See section L</"SPECIAL OPERATORS"> for details.
1537 Takes a reference to a list of "unary operators"
1538 to extend the syntax understood by L<SQL::Abstract>.
1539 See section L</"UNARY OPERATORS"> for details.
1545 =head2 insert($table, \@values || \%fieldvals, \%options)
1547 This is the simplest function. You simply give it a table name
1548 and either an arrayref of values or hashref of field/value pairs.
1549 It returns an SQL INSERT statement and a list of bind values.
1550 See the sections on L</"Inserting and Updating Arrays"> and
1551 L</"Inserting and Updating SQL"> for information on how to insert
1552 with those data types.
1554 The optional C<\%options> hash reference may contain additional
1555 options to generate the insert SQL. Currently supported options
1562 Takes either a scalar of raw SQL fields, or an array reference of
1563 field names, and adds on an SQL C<RETURNING> statement at the end.
1564 This allows you to return data generated by the insert statement
1565 (such as row IDs) without performing another C<SELECT> statement.
1566 Note, however, this is not part of the SQL standard and may not
1567 be supported by all database engines.
1571 =head2 update($table, \%fieldvals, \%where)
1573 This takes a table, hashref of field/value pairs, and an optional
1574 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1576 See the sections on L</"Inserting and Updating Arrays"> and
1577 L</"Inserting and Updating SQL"> for information on how to insert
1578 with those data types.
1580 =head2 select($source, $fields, $where, $order)
1582 This returns a SQL SELECT statement and associated list of bind values, as
1583 specified by the arguments :
1589 Specification of the 'FROM' part of the statement.
1590 The argument can be either a plain scalar (interpreted as a table
1591 name, will be quoted), or an arrayref (interpreted as a list
1592 of table names, joined by commas, quoted), or a scalarref
1593 (literal table name, not quoted), or a ref to an arrayref
1594 (list of literal table names, joined by commas, not quoted).
1598 Specification of the list of fields to retrieve from
1600 The argument can be either an arrayref (interpreted as a list
1601 of field names, will be joined by commas and quoted), or a
1602 plain scalar (literal SQL, not quoted).
1603 Please observe that this API is not as flexible as for
1604 the first argument C<$table>, for backwards compatibility reasons.
1608 Optional argument to specify the WHERE part of the query.
1609 The argument is most often a hashref, but can also be
1610 an arrayref or plain scalar --
1611 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1615 Optional argument to specify the ORDER BY part of the query.
1616 The argument can be a scalar, a hashref or an arrayref
1617 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1623 =head2 delete($table, \%where)
1625 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1626 It returns an SQL DELETE statement and list of bind values.
1628 =head2 where(\%where, \@order)
1630 This is used to generate just the WHERE clause. For example,
1631 if you have an arbitrary data structure and know what the
1632 rest of your SQL is going to look like, but want an easy way
1633 to produce a WHERE clause, use this. It returns an SQL WHERE
1634 clause and list of bind values.
1637 =head2 values(\%data)
1639 This just returns the values from the hash C<%data>, in the same
1640 order that would be returned from any of the other above queries.
1641 Using this allows you to markedly speed up your queries if you
1642 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1644 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1646 Warning: This is an experimental method and subject to change.
1648 This returns arbitrarily generated SQL. It's a really basic shortcut.
1649 It will return two different things, depending on return context:
1651 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1652 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1654 These would return the following:
1656 # First calling form
1657 $stmt = "CREATE TABLE test (?, ?)";
1658 @bind = (field1, field2);
1660 # Second calling form
1661 $stmt_and_val = "CREATE TABLE test (field1, field2)";
1663 Depending on what you're trying to do, it's up to you to choose the correct
1664 format. In this example, the second form is what you would want.
1668 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1672 ALTER SESSION SET nls_date_format = 'MM/YY'
1674 You get the idea. Strings get their case twiddled, but everything
1675 else remains verbatim.
1677 =head1 WHERE CLAUSES
1681 This module uses a variation on the idea from L<DBIx::Abstract>. It
1682 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1683 module is that things in arrays are OR'ed, and things in hashes
1686 The easiest way to explain is to show lots of examples. After
1687 each C<%where> hash shown, it is assumed you used:
1689 my($stmt, @bind) = $sql->where(\%where);
1691 However, note that the C<%where> hash can be used directly in any
1692 of the other functions as well, as described above.
1694 =head2 Key-value pairs
1696 So, let's get started. To begin, a simple hash:
1700 status => 'completed'
1703 Is converted to SQL C<key = val> statements:
1705 $stmt = "WHERE user = ? AND status = ?";
1706 @bind = ('nwiger', 'completed');
1708 One common thing I end up doing is having a list of values that
1709 a field can be in. To do this, simply specify a list inside of
1714 status => ['assigned', 'in-progress', 'pending'];
1717 This simple code will create the following:
1719 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1720 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1722 A field associated to an empty arrayref will be considered a
1723 logical false and will generate 0=1.
1725 =head2 Tests for NULL values
1727 If the value part is C<undef> then this is converted to SQL <IS NULL>
1736 $stmt = "WHERE user = ? AND status IS NULL";
1739 To test if a column IS NOT NULL:
1743 status => { '!=', undef },
1746 =head2 Specific comparison operators
1748 If you want to specify a different type of operator for your comparison,
1749 you can use a hashref for a given column:
1753 status => { '!=', 'completed' }
1756 Which would generate:
1758 $stmt = "WHERE user = ? AND status != ?";
1759 @bind = ('nwiger', 'completed');
1761 To test against multiple values, just enclose the values in an arrayref:
1763 status => { '=', ['assigned', 'in-progress', 'pending'] };
1765 Which would give you:
1767 "WHERE status = ? OR status = ? OR status = ?"
1770 The hashref can also contain multiple pairs, in which case it is expanded
1771 into an C<AND> of its elements:
1775 status => { '!=', 'completed', -not_like => 'pending%' }
1778 # Or more dynamically, like from a form
1779 $where{user} = 'nwiger';
1780 $where{status}{'!='} = 'completed';
1781 $where{status}{'-not_like'} = 'pending%';
1783 # Both generate this
1784 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1785 @bind = ('nwiger', 'completed', 'pending%');
1788 To get an OR instead, you can combine it with the arrayref idea:
1792 priority => [ { '=', 2 }, { '>', 5 } ]
1795 Which would generate:
1797 $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1798 @bind = ('2', '5', 'nwiger');
1800 If you want to include literal SQL (with or without bind values), just use a
1801 scalar reference or array reference as the value:
1804 date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1805 date_expires => { '<' => \"now()" }
1808 Which would generate:
1810 $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1811 @bind = ('11/26/2008');
1814 =head2 Logic and nesting operators
1816 In the example above,
1817 there is a subtle trap if you want to say something like
1818 this (notice the C<AND>):
1820 WHERE priority != ? AND priority != ?
1822 Because, in Perl you I<can't> do this:
1824 priority => { '!=', 2, '!=', 1 }
1826 As the second C<!=> key will obliterate the first. The solution
1827 is to use the special C<-modifier> form inside an arrayref:
1829 priority => [ -and => {'!=', 2},
1833 Normally, these would be joined by C<OR>, but the modifier tells it
1834 to use C<AND> instead. (Hint: You can use this in conjunction with the
1835 C<logic> option to C<new()> in order to change the way your queries
1836 work by default.) B<Important:> Note that the C<-modifier> goes
1837 B<INSIDE> the arrayref, as an extra first element. This will
1838 B<NOT> do what you think it might:
1840 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1842 Here is a quick list of equivalencies, since there is some overlap:
1845 status => {'!=', 'completed', 'not like', 'pending%' }
1846 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1849 status => {'=', ['assigned', 'in-progress']}
1850 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1851 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1855 =head2 Special operators : IN, BETWEEN, etc.
1857 You can also use the hashref format to compare a list of fields using the
1858 C<IN> comparison operator, by specifying the list as an arrayref:
1861 status => 'completed',
1862 reportid => { -in => [567, 2335, 2] }
1865 Which would generate:
1867 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1868 @bind = ('completed', '567', '2335', '2');
1870 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1873 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1874 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1875 'sqltrue' (by default : C<1=1>).
1877 In addition to the array you can supply a chunk of literal sql or
1878 literal sql with bind:
1881 customer => { -in => \[
1882 'SELECT cust_id FROM cust WHERE balance > ?',
1885 status => { -in => \'SELECT status_codes FROM states' },
1891 customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1892 AND status IN ( SELECT status_codes FROM states )
1898 Another pair of operators is C<-between> and C<-not_between>,
1899 used with an arrayref of two values:
1903 completion_date => {
1904 -not_between => ['2002-10-01', '2003-02-06']
1910 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1912 Just like with C<-in> all plausible combinations of literal SQL
1916 start0 => { -between => [ 1, 2 ] },
1917 start1 => { -between => \["? AND ?", 1, 2] },
1918 start2 => { -between => \"lower(x) AND upper(y)" },
1919 start3 => { -between => [
1921 \["upper(?)", 'stuff' ],
1928 ( start0 BETWEEN ? AND ? )
1929 AND ( start1 BETWEEN ? AND ? )
1930 AND ( start2 BETWEEN lower(x) AND upper(y) )
1931 AND ( start3 BETWEEN lower(x) AND upper(?) )
1933 @bind = (1, 2, 1, 2, 'stuff');
1936 These are the two builtin "special operators"; but the
1937 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1939 =head2 Unary operators: bool
1941 If you wish to test against boolean columns or functions within your
1942 database you can use the C<-bool> and C<-not_bool> operators. For
1943 example to test the column C<is_user> being true and the column
1944 C<is_enabled> being false you would use:-
1948 -not_bool => 'is_enabled',
1953 WHERE is_user AND NOT is_enabled
1955 If a more complex combination is required, testing more conditions,
1956 then you should use the and/or operators:-
1963 -not_bool => 'four',
1969 WHERE one AND two AND three AND NOT four
1972 =head2 Nested conditions, -and/-or prefixes
1974 So far, we've seen how multiple conditions are joined with a top-level
1975 C<AND>. We can change this by putting the different conditions we want in
1976 hashes and then putting those hashes in an array. For example:
1981 status => { -like => ['pending%', 'dispatched'] },
1985 status => 'unassigned',
1989 This data structure would create the following:
1991 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1992 OR ( user = ? AND status = ? ) )";
1993 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1996 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
1997 to change the logic inside :
2003 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2004 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2011 WHERE ( user = ? AND (
2012 ( workhrs > ? AND geo = ? )
2013 OR ( workhrs < ? OR geo = ? )
2016 =head3 Algebraic inconsistency, for historical reasons
2018 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2019 operator goes C<outside> of the nested structure; whereas when connecting
2020 several constraints on one column, the C<-and> operator goes
2021 C<inside> the arrayref. Here is an example combining both features :
2024 -and => [a => 1, b => 2],
2025 -or => [c => 3, d => 4],
2026 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2031 WHERE ( ( ( a = ? AND b = ? )
2032 OR ( c = ? OR d = ? )
2033 OR ( e LIKE ? AND e LIKE ? ) ) )
2035 This difference in syntax is unfortunate but must be preserved for
2036 historical reasons. So be careful : the two examples below would
2037 seem algebraically equivalent, but they are not
2039 {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2040 # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2042 [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2043 # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2046 =head2 Literal SQL and value type operators
2048 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2049 side" is a column name and the "right side" is a value (normally rendered as
2050 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2051 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2052 alter this behavior. There are several ways of doing so.
2056 This is a virtual operator that signals the string to its right side is an
2057 identifier (a column name) and not a value. For example to compare two
2058 columns you would write:
2061 priority => { '<', 2 },
2062 requestor => { -ident => 'submitter' },
2067 $stmt = "WHERE priority < ? AND requestor = submitter";
2070 If you are maintaining legacy code you may see a different construct as
2071 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2076 This is a virtual operator that signals that the construct to its right side
2077 is a value to be passed to DBI. This is for example necessary when you want
2078 to write a where clause against an array (for RDBMS that support such
2079 datatypes). For example:
2082 array => { -value => [1, 2, 3] }
2087 $stmt = 'WHERE array = ?';
2088 @bind = ([1, 2, 3]);
2090 Note that if you were to simply say:
2096 the result would porbably be not what you wanted:
2098 $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2103 Finally, sometimes only literal SQL will do. To include a random snippet
2104 of SQL verbatim, you specify it as a scalar reference. Consider this only
2105 as a last resort. Usually there is a better way. For example:
2108 priority => { '<', 2 },
2109 requestor => { -in => \'(SELECT name FROM hitmen)' },
2114 $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2117 Note that in this example, you only get one bind parameter back, since
2118 the verbatim SQL is passed as part of the statement.
2122 Never use untrusted input as a literal SQL argument - this is a massive
2123 security risk (there is no way to check literal snippets for SQL
2124 injections and other nastyness). If you need to deal with untrusted input
2125 use literal SQL with placeholders as described next.
2127 =head3 Literal SQL with placeholders and bind values (subqueries)
2129 If the literal SQL to be inserted has placeholders and bind values,
2130 use a reference to an arrayref (yes this is a double reference --
2131 not so common, but perfectly legal Perl). For example, to find a date
2132 in Postgres you can use something like this:
2135 date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2140 $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2143 Note that you must pass the bind values in the same format as they are returned
2144 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2145 provide the bind values in the C<< [ column_meta => value ] >> format, where
2146 C<column_meta> is an opaque scalar value; most commonly the column name, but
2147 you can use any scalar value (including references and blessed references),
2148 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2149 to C<columns> the above example will look like:
2152 date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2155 Literal SQL is especially useful for nesting parenthesized clauses in the
2156 main SQL query. Here is a first example :
2158 my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2162 bar => \["IN ($sub_stmt)" => @sub_bind],
2167 $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2168 WHERE c2 < ? AND c3 LIKE ?))";
2169 @bind = (1234, 100, "foo%");
2171 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2172 are expressed in the same way. Of course the C<$sub_stmt> and
2173 its associated bind values can be generated through a former call
2176 my ($sub_stmt, @sub_bind)
2177 = $sql->select("t1", "c1", {c2 => {"<" => 100},
2178 c3 => {-like => "foo%"}});
2181 bar => \["> ALL ($sub_stmt)" => @sub_bind],
2184 In the examples above, the subquery was used as an operator on a column;
2185 but the same principle also applies for a clause within the main C<%where>
2186 hash, like an EXISTS subquery :
2188 my ($sub_stmt, @sub_bind)
2189 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2190 my %where = ( -and => [
2192 \["EXISTS ($sub_stmt)" => @sub_bind],
2197 $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2198 WHERE c1 = ? AND c2 > t0.c0))";
2202 Observe that the condition on C<c2> in the subquery refers to
2203 column C<t0.c0> of the main query : this is I<not> a bind
2204 value, so we have to express it through a scalar ref.
2205 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2206 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2207 what we wanted here.
2209 Finally, here is an example where a subquery is used
2210 for expressing unary negation:
2212 my ($sub_stmt, @sub_bind)
2213 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2214 $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2216 lname => {like => '%son%'},
2217 \["NOT ($sub_stmt)" => @sub_bind],
2222 $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2223 @bind = ('%son%', 10, 20)
2225 =head3 Deprecated usage of Literal SQL
2227 Below are some examples of archaic use of literal SQL. It is shown only as
2228 reference for those who deal with legacy code. Each example has a much
2229 better, cleaner and safer alternative that users should opt for in new code.
2235 my %where = ( requestor => \'IS NOT NULL' )
2237 $stmt = "WHERE requestor IS NOT NULL"
2239 This used to be the way of generating NULL comparisons, before the handling
2240 of C<undef> got formalized. For new code please use the superior syntax as
2241 described in L</Tests for NULL values>.
2245 my %where = ( requestor => \'= submitter' )
2247 $stmt = "WHERE requestor = submitter"
2249 This used to be the only way to compare columns. Use the superior L</-ident>
2250 method for all new code. For example an identifier declared in such a way
2251 will be properly quoted if L</quote_char> is properly set, while the legacy
2252 form will remain as supplied.
2256 my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } )
2258 $stmt = "WHERE completed > ? AND is_ready"
2259 @bind = ('2012-12-21')
2261 Using an empty string literal used to be the only way to express a boolean.
2262 For all new code please use the much more readable
2263 L<-bool|/Unary operators: bool> operator.
2269 These pages could go on for a while, since the nesting of the data
2270 structures this module can handle are pretty much unlimited (the
2271 module implements the C<WHERE> expansion as a recursive function
2272 internally). Your best bet is to "play around" with the module a
2273 little to see how the data structures behave, and choose the best
2274 format for your data based on that.
2276 And of course, all the values above will probably be replaced with
2277 variables gotten from forms or the command line. After all, if you
2278 knew everything ahead of time, you wouldn't have to worry about
2279 dynamically-generating SQL and could just hardwire it into your
2282 =head1 ORDER BY CLAUSES
2284 Some functions take an order by clause. This can either be a scalar (just a
2285 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2286 or an array of either of the two previous forms. Examples:
2288 Given | Will Generate
2289 ----------------------------------------------------------
2291 \'colA DESC' | ORDER BY colA DESC
2293 'colA' | ORDER BY colA
2295 [qw/colA colB/] | ORDER BY colA, colB
2297 {-asc => 'colA'} | ORDER BY colA ASC
2299 {-desc => 'colB'} | ORDER BY colB DESC
2301 ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
2303 { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2306 { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
2307 { -desc => [qw/colB/], | colC ASC, colD ASC
2308 { -asc => [qw/colC colD/],|
2310 ===========================================================
2314 =head1 SPECIAL OPERATORS
2316 my $sqlmaker = SQL::Abstract->new(special_ops => [
2320 my ($self, $field, $op, $arg) = @_;
2326 handler => 'method_name',
2330 A "special operator" is a SQL syntactic clause that can be
2331 applied to a field, instead of a usual binary operator.
2334 WHERE field IN (?, ?, ?)
2335 WHERE field BETWEEN ? AND ?
2336 WHERE MATCH(field) AGAINST (?, ?)
2338 Special operators IN and BETWEEN are fairly standard and therefore
2339 are builtin within C<SQL::Abstract> (as the overridable methods
2340 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2341 like the MATCH .. AGAINST example above which is specific to MySQL,
2342 you can write your own operator handlers - supply a C<special_ops>
2343 argument to the C<new> method. That argument takes an arrayref of
2344 operator definitions; each operator definition is a hashref with two
2351 the regular expression to match the operator
2355 Either a coderef or a plain scalar method name. In both cases
2356 the expected return is C<< ($sql, @bind) >>.
2358 When supplied with a method name, it is simply called on the
2359 L<SQL::Abstract/> object as:
2361 $self->$method_name ($field, $op, $arg)
2365 $op is the part that matched the handler regex
2366 $field is the LHS of the operator
2369 When supplied with a coderef, it is called as:
2371 $coderef->($self, $field, $op, $arg)
2376 For example, here is an implementation
2377 of the MATCH .. AGAINST syntax for MySQL
2379 my $sqlmaker = SQL::Abstract->new(special_ops => [
2381 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2382 {regex => qr/^match$/i,
2384 my ($self, $field, $op, $arg) = @_;
2385 $arg = [$arg] if not ref $arg;
2386 my $label = $self->_quote($field);
2387 my ($placeholder) = $self->_convert('?');
2388 my $placeholders = join ", ", (($placeholder) x @$arg);
2389 my $sql = $self->_sqlcase('match') . " ($label) "
2390 . $self->_sqlcase('against') . " ($placeholders) ";
2391 my @bind = $self->_bindtype($field, @$arg);
2392 return ($sql, @bind);
2399 =head1 UNARY OPERATORS
2401 my $sqlmaker = SQL::Abstract->new(unary_ops => [
2405 my ($self, $op, $arg) = @_;
2411 handler => 'method_name',
2415 A "unary operator" is a SQL syntactic clause that can be
2416 applied to a field - the operator goes before the field
2418 You can write your own operator handlers - supply a C<unary_ops>
2419 argument to the C<new> method. That argument takes an arrayref of
2420 operator definitions; each operator definition is a hashref with two
2427 the regular expression to match the operator
2431 Either a coderef or a plain scalar method name. In both cases
2432 the expected return is C<< $sql >>.
2434 When supplied with a method name, it is simply called on the
2435 L<SQL::Abstract/> object as:
2437 $self->$method_name ($op, $arg)
2441 $op is the part that matched the handler regex
2442 $arg is the RHS or argument of the operator
2444 When supplied with a coderef, it is called as:
2446 $coderef->($self, $op, $arg)
2454 Thanks to some benchmarking by Mark Stosberg, it turns out that
2455 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2456 I must admit this wasn't an intentional design issue, but it's a
2457 byproduct of the fact that you get to control your C<DBI> handles
2460 To maximize performance, use a code snippet like the following:
2462 # prepare a statement handle using the first row
2463 # and then reuse it for the rest of the rows
2465 for my $href (@array_of_hashrefs) {
2466 $stmt ||= $sql->insert('table', $href);
2467 $sth ||= $dbh->prepare($stmt);
2468 $sth->execute($sql->values($href));
2471 The reason this works is because the keys in your C<$href> are sorted
2472 internally by B<SQL::Abstract>. Thus, as long as your data retains
2473 the same structure, you only have to generate the SQL the first time
2474 around. On subsequent queries, simply use the C<values> function provided
2475 by this module to return your values in the correct order.
2477 However this depends on the values having the same type - if, for
2478 example, the values of a where clause may either have values
2479 (resulting in sql of the form C<column = ?> with a single bind
2480 value), or alternatively the values might be C<undef> (resulting in
2481 sql of the form C<column IS NULL> with no bind value) then the
2482 caching technique suggested will not work.
2486 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2487 really like this part (I do, at least). Building up a complex query
2488 can be as simple as the following:
2492 use CGI::FormBuilder;
2495 my $form = CGI::FormBuilder->new(...);
2496 my $sql = SQL::Abstract->new;
2498 if ($form->submitted) {
2499 my $field = $form->field;
2500 my $id = delete $field->{id};
2501 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2504 Of course, you would still have to connect using C<DBI> to run the
2505 query, but the point is that if you make your form look like your
2506 table, the actual query script can be extremely simplistic.
2508 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2509 a fast interface to returning and formatting data. I frequently
2510 use these three modules together to write complex database query
2511 apps in under 50 lines.
2517 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2519 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2525 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2526 Great care has been taken to preserve the I<published> behavior
2527 documented in previous versions in the 1.* family; however,
2528 some features that were previously undocumented, or behaved
2529 differently from the documentation, had to be changed in order
2530 to clarify the semantics. Hence, client code that was relying
2531 on some dark areas of C<SQL::Abstract> v1.*
2532 B<might behave differently> in v1.50.
2534 The main changes are :
2540 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2544 support for the { operator => \"..." } construct (to embed literal SQL)
2548 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2552 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2556 defensive programming : check arguments
2560 fixed bug with global logic, which was previously implemented
2561 through global variables yielding side-effects. Prior versions would
2562 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2563 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2564 Now this is interpreted
2565 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2570 fixed semantics of _bindtype on array args
2574 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2575 we just avoid shifting arrays within that tree.
2579 dropped the C<_modlogic> function
2583 =head1 ACKNOWLEDGEMENTS
2585 There are a number of individuals that have really helped out with
2586 this module. Unfortunately, most of them submitted bugs via CPAN
2587 so I have no idea who they are! But the people I do know are:
2589 Ash Berlin (order_by hash term support)
2590 Matt Trout (DBIx::Class support)
2591 Mark Stosberg (benchmarking)
2592 Chas Owens (initial "IN" operator support)
2593 Philip Collins (per-field SQL functions)
2594 Eric Kolve (hashref "AND" support)
2595 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2596 Dan Kubb (support for "quote_char" and "name_sep")
2597 Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2598 Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2599 Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2600 Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2601 Oliver Charles (support for "RETURNING" after "INSERT")
2607 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2611 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2613 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2615 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2616 While not an official support venue, C<DBIx::Class> makes heavy use of
2617 C<SQL::Abstract>, and as such list members there are very familiar with
2618 how to create queries.
2622 This module is free software; you may copy this under the same
2623 terms as perl itself (either the GNU General Public License or
2624 the Artistic License)