sort hash keys when found as RHS in a hashpair
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm
1 package SQL::Abstract; # see doc at end of file
2
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)
7
8 use strict;
9 use Carp ();
10 use warnings FATAL => 'all';
11 use List::Util ();
12 use Scalar::Util ();
13 use Data::Query::Constants qw(
14   DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_LITERAL DQ_JOIN DQ_SELECT DQ_ORDER
15 );
16 use Data::Query::ExprHelpers qw(perl_scalar_value);
17
18 #======================================================================
19 # GLOBALS
20 #======================================================================
21
22 our $VERSION  = '1.72';
23
24 # This would confuse some packagers
25 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
26
27 our $AUTOLOAD;
28
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'},
36 );
37
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' },
47 );
48
49 #======================================================================
50 # DEBUGGING AND ERROR REPORTING
51 #======================================================================
52
53 sub _debug {
54   return unless $_[0]->{debug}; shift; # a little faster
55   my $func = (caller(1))[3];
56   warn "[$func] ", @_, "\n";
57 }
58
59 sub belch (@) {
60   my($func) = (caller(1))[3];
61   Carp::carp "[$func] Warning: ", @_;
62 }
63
64 sub puke (@) {
65   my($func) = (caller(1))[3];
66   Carp::croak "[$func] Fatal: ", @_;
67 }
68
69
70 #======================================================================
71 # NEW
72 #======================================================================
73
74 sub new {
75   my $self = shift;
76   my $class = ref($self) || $self;
77   my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
78
79   # choose our case by keeping an option around
80   delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
81
82   # default logic for interpreting arrayrefs
83   $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
84
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';
89
90   # default comparison is "=", but can be overridden
91   $opt{cmp} ||= '=';
92
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;
97
98   # SQL booleans
99   $opt{sqltrue}  ||= '1=1';
100   $opt{sqlfalse} ||= '0=1';
101
102   # special operators
103   $opt{special_ops} ||= [];
104   # regexes are applied in order, thus push after user-defines
105   push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
106
107   # unary operators
108   $opt{unary_ops} ||= [];
109   push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
110
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)
115
116   # FIXME
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/
120     \;
121       |
122     ^ \s* go \s
123   /xmi;
124
125   $opt{name_sep} ||= '.';
126
127   $opt{renderer} ||= do {
128     require Data::Query::Renderer::SQL::Naive;
129     my ($always, $chars);
130     for ($opt{quote_char}) {
131       $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
132       $always = defined;
133     }
134     Data::Query::Renderer::SQL::Naive->new({
135       quote_chars => $chars, always_quote => $always,
136     });
137   };
138
139   return bless \%opt, $class;
140 }
141
142 sub _render_dq {
143   my ($self, $dq) = @_;
144   my ($sql, @bind) = @{$self->{renderer}->render($dq)};
145   wantarray ?
146     ($self->{bindtype} eq 'normal'
147       ? ($sql, map $_->{value}, @bind)
148       : ($sql, map [ $_->{value_meta}, $_->{value} ], @bind)
149     )
150     : $sql;
151 }
152
153 sub _literal_to_dq {
154   my ($self, $literal) = @_;
155   my @bind;
156   ($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
157   +{
158     type => DQ_LITERAL,
159     subtype => 'SQL',
160     literal => $literal,
161     (@bind ? (values => [ $self->_bind_to_dq(@bind) ]) : ()),
162   };
163 }
164
165 sub _literal_with_prepend_to_dq {
166   my ($self, $prepend, $literal) = @_;
167   if (ref($literal)) {
168     $self->_literal_to_dq(
169       [ join(' ', $prepend, $literal->[0]), @{$literal}[1..$#$literal] ]
170     );
171   } else {
172     $self->_literal_to_dq(
173       join(' ', $prepend, $literal)
174     );
175   }
176 }
177
178 sub _bind_to_dq {
179   my ($self, @bind) = @_;
180   return unless @bind;
181   $self->{bindtype} eq 'normal'
182     ? map perl_scalar_value($_), @bind
183     : do {
184         $self->_assert_bindval_matches_bindtype(@bind);
185         map perl_scalar_value(reverse @$_), @bind
186       }
187 }
188
189 sub _value_to_dq {
190   my ($self, $value) = @_;
191   perl_scalar_value($value, our $Cur_Col_Meta);
192 }
193
194 sub _ident_to_dq {
195   my ($self, $ident) = @_;
196   +{
197     type => DQ_IDENTIFIER,
198     elements => [ split /\Q$self->{name_sep}/, $ident ],
199   };
200 }
201
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()"
208   }
209 }
210
211
212 #======================================================================
213 # INSERT methods
214 #======================================================================
215
216 sub insert {
217   my $self    = shift;
218   my $table   = $self->_table(shift);
219   my $data    = shift || return;
220   my $options = shift;
221
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;
225
226   if ($options->{returning}) {
227     my ($s, @b) = $self->_insert_returning ($options);
228     $sql .= $s;
229     push @bind, @b;
230   }
231
232   return wantarray ? ($sql, @bind) : $sql;
233 }
234
235 sub _insert_returning {
236   my ($self, $options) = @_;
237
238   my $f = $options->{returning};
239
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},
244   });
245   return $self->_sqlcase(' returning ') . $fieldlist;
246 }
247
248 sub _insert_HASHREF { # explicit list of fields and then values
249   my ($self, $data) = @_;
250
251   my @fields = sort keys %$data;
252
253   my ($sql, @bind) = $self->_insert_values($data);
254
255   # assemble SQL
256   $_ = $self->_quote($_) foreach @fields;
257   $sql = "( ".join(", ", @fields).") ".$sql;
258
259   return ($sql, @bind);
260 }
261
262 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
263   my ($self, $data) = @_;
264
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";
268
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 };
274
275   return $self->_insert_values($data_in_hash);
276 }
277
278 sub _insert_ARRAYREFREF { # literal SQL with bind
279   my ($self, $data) = @_;
280
281   my ($sql, @bind) = @${$data};
282   $self->_assert_bindval_matches_bindtype(@bind);
283
284   return ($sql, @bind);
285 }
286
287
288 sub _insert_SCALARREF { # literal SQL without bind
289   my ($self, $data) = @_;
290
291   return ($$data);
292 }
293
294 sub _insert_values {
295   my ($self, $data) = @_;
296
297   my (@values, @all_bind);
298   foreach my $column (sort keys %$data) {
299     my $v = $data->{$column};
300
301     $self->_SWITCH_refkind($v, {
302
303       ARRAYREF => sub {
304         if ($self->{array_datatypes}) { # if array datatype are activated
305           push @values, '?';
306           push @all_bind, $self->_bindtype($column, $v);
307         }
308         else {                          # else literal SQL with bind
309           my ($sql, @bind) = @$v;
310           $self->_assert_bindval_matches_bindtype(@bind);
311           push @values, $sql;
312           push @all_bind, @bind;
313         }
314       },
315
316       ARRAYREFREF => sub { # literal SQL with bind
317         my ($sql, @bind) = @${$v};
318         $self->_assert_bindval_matches_bindtype(@bind);
319         push @values, $sql;
320         push @all_bind, @bind;
321       },
322
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";
327         push @values, '?';
328         push @all_bind, $self->_bindtype($column, $v);
329       },
330
331       SCALARREF => sub {  # literal SQL without bind
332         push @values, $$v;
333       },
334
335       SCALAR_or_UNDEF => sub {
336         push @values, '?';
337         push @all_bind, $self->_bindtype($column, $v);
338       },
339
340      });
341
342   }
343
344   my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
345   return ($sql, @all_bind);
346 }
347
348
349
350 #======================================================================
351 # UPDATE methods
352 #======================================================================
353
354
355 sub update {
356   my $self  = shift;
357   my $table = $self->_table(shift);
358   my $data  = shift || return;
359   my $where = shift;
360
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';
365
366   for my $k (sort keys %$data) {
367     my $v = $data->{$k};
368     my $r = ref $v;
369     my $label = $self->_quote($k);
370
371     $self->_SWITCH_refkind($v, {
372       ARRAYREF => sub {
373         if ($self->{array_datatypes}) { # array datatype
374           push @set, "$label = ?";
375           push @all_bind, $self->_bindtype($k, $v);
376         }
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;
382         }
383       },
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;
389       },
390       SCALARREF => sub {  # literal SQL without bind
391         push @set, "$label = $$v";
392       },
393       HASHREF => sub {
394         my ($op, $arg, @rest) = %$v;
395
396         puke 'Operator calls in update must be in the form { -op => $arg }'
397           if (@rest or not $op =~ /^\-(.+)/);
398
399         local $self->{_nested_func_lhs} = $k;
400         my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
401
402         push @set, "$label = $sql";
403         push @all_bind, @bind;
404       },
405       SCALAR_or_UNDEF => sub {
406         push @set, "$label = ?";
407         push @all_bind, $self->_bindtype($k, $v);
408       },
409     });
410   }
411
412   # generate sql
413   my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
414           . join ', ', @set;
415
416   if ($where) {
417     my($where_sql, @where_bind) = $self->where($where);
418     $sql .= $where_sql;
419     push @all_bind, @where_bind;
420   }
421
422   return wantarray ? ($sql, @all_bind) : $sql;
423 }
424
425
426
427
428 #======================================================================
429 # SELECT
430 #======================================================================
431
432
433 sub select {
434   my $self   = shift;
435   my $table  = shift;
436   my $fields = shift || '*';
437   my $where  = shift;
438   my $order  = shift;
439
440   my($where_sql, @bind) = $self->where($where, $order);
441
442   my $sql = $self->_render_dq({
443     type => DQ_SELECT,
444     select => [
445       map $self->_ident_to_dq($_),
446         ref($fields) eq 'ARRAY' ? @$fields : $fields
447     ],
448     from => $self->_table_to_dq($table),
449   });
450
451   $sql .= $where_sql;
452
453   return wantarray ? ($sql, @bind) : $sql;
454 }
455
456 #======================================================================
457 # DELETE
458 #======================================================================
459
460
461 sub delete {
462   my $self  = shift;
463   my $table = $self->_table(shift);
464   my $where = shift;
465
466
467   my($where_sql, @bind) = $self->where($where);
468   my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
469
470   return wantarray ? ($sql, @bind) : $sql;
471 }
472
473
474 #======================================================================
475 # WHERE: entry point
476 #======================================================================
477
478
479
480 # Finally, a separate routine just to handle WHERE clauses
481 sub where {
482   my ($self, $where, $order) = @_;
483
484   my $sql = '';
485   my @bind;
486
487   # where ?
488   ($sql, @bind) = $self->_recurse_where($where) if defined($where);
489   $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
490
491   # order by?
492   if ($order) {
493     $sql .= $self->_order_by($order);
494   }
495
496   return wantarray ? ($sql, @bind) : $sql;
497 }
498
499
500 sub _recurse_where {
501   my ($self, $where, $logic) = @_;
502
503   return $self->_render_dq($self->_where_to_dq($where, $logic));
504 }
505
506 sub _where_to_dq {
507   my ($self, $where, $logic) = @_;
508
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);
513   } elsif (
514     ref($where) eq 'SCALAR'
515     or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
516   ) {
517     return $self->_literal_to_dq($$where);
518   } elsif (!ref($where) or Scalar::Util::blessed($where)) {
519     return $self->_value_to_dq($where);
520   }
521   die "Can't handle $where";
522 }
523
524 sub _where_to_dq_ARRAYREF {
525   my ($self, $where, $logic) = @_;
526
527   $logic = uc($logic || 'OR');
528   $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
529
530   return unless @$where;
531
532   my ($first, @rest) = @$where;
533
534   return $self->_where_to_dq($first) unless @rest;
535
536   my $first_dq = do {
537     if (!ref($first)) {
538       $self->_where_hashpair_to_dq($first => shift(@rest));
539     } else {
540       $self->_where_to_dq($first);
541     }
542   };
543
544   return $self->_where_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
545
546   +{
547     type => DQ_OPERATOR,
548     operator => { 'SQL.Naive' => $logic },
549     args => [ $first_dq, $self->_where_to_dq_ARRAYREF(\@rest, $logic) ]
550   };
551 }
552
553 sub _where_to_dq_HASHREF {
554   my ($self, $where, $logic) = @_;
555
556   $logic = uc($logic || 'AND');
557
558   my @dq = map {
559     $self->_where_hashpair_to_dq($_ => $where->{$_})
560   } sort keys %$where;
561
562   return $dq[0] unless @dq > 1;
563
564   my $final = pop(@dq);
565
566   foreach my $dq (reverse @dq) {
567     $final = +{
568      type => DQ_OPERATOR,
569      operator => { 'SQL.Naive' => $logic },
570      args => [ $dq, $final ]
571     }
572   }
573
574   return $final;
575 }
576
577 sub _where_to_dq_SCALAR {
578   shift->_value_to_dq(@_);
579 }
580
581 sub _where_op_IDENT {
582   my $self = shift;
583   my ($op, $rhs) = splice @_, -2;
584   if (ref $rhs) {
585     puke "-$op takes a single scalar argument (a quotable identifier)";
586   }
587
588   # in case we are called as a top level special op (no '=')
589   my $lhs = shift;
590
591   $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
592
593   return $lhs
594     ? "$lhs = $rhs"
595     : $rhs
596   ;
597 }
598
599 sub _where_op_VALUE {
600   my $self = shift;
601   my ($op, $rhs) = splice @_, -2;
602
603   # in case we are called as a top level special op (no '=')
604   my $lhs = shift;
605
606   my @bind =
607     $self->_bindtype (
608       ($lhs || $self->{_nested_func_lhs}),
609       $rhs,
610     )
611   ;
612
613   return $lhs
614     ? (
615       $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
616       @bind
617     )
618     : (
619       $self->_convert('?'),
620       @bind,
621     )
622   ;
623 }
624
625 sub _where_hashpair_to_dq {
626   my ($self, $k, $v) = @_;
627
628   if ($k =~ /-(.*)/) {
629     my $op = uc($1);
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') {
635       return +{
636         type => DQ_OPERATOR,
637         operator => { 'SQL.Naive' => 'NOT' },
638         args => [ $self->_where_to_dq($v) ]
639       }
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') {
643       return +{
644         type => DQ_OPERATOR,
645         operator => { 'SQL.Naive' => 'NOT' },
646         args => [ ref($v) ? $self->_where_to_dq($v) : $self->_ident_to_dq($v) ]
647       };
648     } else {
649       my @args = do {
650         if (ref($v) eq 'HASH' and keys(%$v) == 1 and (keys %$v)[0] =~ /-(.*)/) {
651           my ($inner) = values %$v;
652           +{
653             type => DQ_OPERATOR,
654             operator => { 'SQL.Naive' => uc($1) },
655             args => [ 
656               (map $self->_where_to_dq($_),
657                 (ref($inner) eq 'ARRAY' ? @$inner : $inner))
658             ]
659           };
660         } else {
661           (map $self->_where_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v))
662         }
663       };
664       return +{
665         type => DQ_OPERATOR,
666         operator => { 'SQL.Naive' => 'apply' },
667         args => [
668           $self->_ident_to_dq($op), @args
669         ],
670       };
671     }
672   } else {
673     local our $Cur_Col_Meta = $k;
674     if (ref($v) eq 'ARRAY') {
675       if (!@$v) {
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]
680         ], uc($1));
681       }
682       return $self->_where_to_dq_ARRAYREF([
683         map +{ $k => $_ }, @$v
684       ]);
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);
691     }
692     my ($op, $rhs) = do {
693       if (ref($v) eq 'HASH') {
694         if (keys %$v > 1) {
695           return $self->_where_to_dq_ARRAYREF([
696             map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
697           ], 'AND');
698         }
699         (uc((keys %$v)[0]), (values %$v)[0]);
700       } else {
701         ($self->{cmp}, $v);
702       }
703     };
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') {
707         if ($op =~ /IN$/) {
708           # have to add parens if none present because -in => \"SELECT ..."
709           # got documented. mst hates everything.
710           if (ref($rhs) eq 'SCALAR') {
711             my $x = $$rhs;
712             $x = "($x)" unless $x =~ /^\s*\(/;
713             $rhs = \$x;
714           } else {
715             my ($x, @rest) = @{$$rhs};
716             $x = "($x)" unless $x =~ /^\s*\(/;
717             $rhs = \[ $x, @rest ];
718           }
719         }
720         return $self->_literal_with_prepend_to_dq("$k $op", $$rhs);
721       }
722       return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
723       return +{
724         type => DQ_OPERATOR,
725         operator => { 'SQL.Naive' => $op },
726         args => [ $self->_ident_to_dq($k), map $self->_where_to_dq($_), @$rhs ]
727       }
728     } elsif ($op =~ s/^NOT (?!LIKE)//) {
729       return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
730     } elsif (!defined($rhs)) {
731       my $null_op = do {
732         if ($op eq '=' or $op eq 'LIKE') {
733           'IS NULL'
734         } elsif ($op eq '!=') {
735           'IS NOT NULL'
736         } else {
737           die "Can't do undef -> NULL transform for operator ${op}";
738         }
739       };
740       return +{
741         type => DQ_OPERATOR,
742         operator => { 'SQL.Naive' => $null_op },
743         args => [ $self->_ident_to_dq($k) ]
744        };
745     }
746     if (ref($rhs) eq 'ARRAY') {
747       if (!@$rhs) {
748         return $self->_literal_to_dq(
749           $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
750         );
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]
754         ], uc($1));
755       }
756       return $self->_where_to_dq_ARRAYREF([
757         map +{ $k => { $op => $_ } }, @$rhs
758       ]);
759     }
760     return +{
761       type => DQ_OPERATOR,
762       operator => { 'SQL.Naive' => $op },
763       args => [ $self->_ident_to_dq($k), $self->_where_to_dq($rhs) ]
764     }
765   }
766 }
767
768 #======================================================================
769 # ORDER BY
770 #======================================================================
771
772 sub _order_by {
773   my ($self, $arg) = @_;
774   if (my $dq = $self->_order_by_to_dq($arg)) {
775     # SQLA generates ' ORDER BY foo'. The hilarity.
776     wantarray
777       ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
778       : ' '.$self->_render_dq($dq);
779   } else {
780     '';
781   }
782 }
783
784 sub _order_by_to_dq {
785   my ($self, $arg, $dir) = @_;
786
787   return unless $arg;
788
789   my $dq = {
790     type => DQ_ORDER,
791     ($dir ? (direction => $dir) : ()),
792   };
793
794   if (!ref($arg)) {
795     $dq->{by} = $self->_ident_to_dq($arg);
796   } elsif (ref($arg) eq 'ARRAY') {
797     return unless @$arg;
798     local our $Order_Inner unless our $Order_Recursing;
799     local $Order_Recursing = 1;
800     my ($outer, $inner);
801     foreach my $member (@$arg) {
802       local $Order_Inner;
803       my $next = $self->_order_by_to_dq($member, $dir);
804       $outer ||= $next;
805       $inner->{from} = $next if $inner;
806       $inner = $Order_Inner || $next;
807     }
808     $Order_Inner = $inner;
809     return $outer;
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;
816
817     return unless $key;
818
819     if (@rest or not $key =~ /^-(desc|asc)/i) {
820       puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
821     }
822     my $dir = uc $1;
823     return $self->_order_by_to_dq($val, $dir);
824   } else {
825     die "Can't handle $arg in _order_by_to_dq";
826   }
827   return $dq;
828 }
829
830 #======================================================================
831 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
832 #======================================================================
833
834 sub _table  {
835   my ($self, $from) = @_;
836   $self->_render_dq($self->_table_to_dq($from));
837 }
838
839 sub _table_to_dq {
840   my ($self, $from) = @_;
841   $self->_SWITCH_refkind($from, {
842     ARRAYREF     => sub {
843       die "Empty FROM list" unless my @f = @$from;
844       my $dq = $self->_ident_to_dq(shift @f);
845       while (my $x = shift @f) {
846         $dq = {
847           type => DQ_JOIN,
848           join => [ $dq, $self->_ident_to_dq($x) ]
849         };
850       }
851       $dq;
852     },
853     SCALAR       => sub { $self->_ident_to_dq($from) },
854     SCALARREF    => sub {
855       +{
856         type => DQ_LITERAL,
857         subtype => 'SQL',
858         literal => $$from
859       }
860     },
861   });
862 }
863
864
865 #======================================================================
866 # UTILITY FUNCTIONS
867 #======================================================================
868
869 # highly optimized, as it's called way too often
870 sub _quote {
871   # my ($self, $label) = @_;
872
873   return '' unless defined $_[1];
874   return ${$_[1]} if ref($_[1]) eq 'SCALAR';
875
876   unless ($_[0]->{quote_char}) {
877     $_[0]->_assert_pass_injection_guard($_[1]);
878     return $_[1];
879   }
880
881   my $qref = ref $_[0]->{quote_char};
882   my ($l, $r);
883   if (!$qref) {
884     ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
885   }
886   elsif ($qref eq 'ARRAY') {
887     ($l, $r) = @{$_[0]->{quote_char}};
888   }
889   else {
890     puke "Unsupported quote_char format: $_[0]->{quote_char}";
891   }
892
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] )
897   );
898 }
899
900
901 # Conversion, if applicable
902 sub _convert ($) {
903   #my ($self, $arg) = @_;
904
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
909 # scalar function.
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] . ')';
916   }
917   return $_[1];
918 }
919
920 # And bindtype
921 sub _bindtype (@) {
922   #my ($self, $col, @vals) = @_;
923
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;
927
928   # called often - tighten code
929   return $_[0]->{bindtype} eq 'columns'
930     ? map {[$_[1], $_]} @_[2 .. $#_]
931     : @_[2 .. $#_]
932   ;
933 }
934
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) = @_;
939   my $self = shift;
940   if ($self->{bindtype} eq 'columns') {
941     for (@_) {
942       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
943         puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
944       }
945     }
946   }
947 }
948
949 sub _join_sql_clauses {
950   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
951
952   if (@$clauses_aref > 1) {
953     my $join  = " " . $self->_sqlcase($logic) . " ";
954     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
955     return ($sql, @$bind_aref);
956   }
957   elsif (@$clauses_aref) {
958     return ($clauses_aref->[0], @$bind_aref); # no parentheses
959   }
960   else {
961     return (); # if no SQL, ignore @$bind_aref
962   }
963 }
964
965
966 # Fix SQL case, if so requested
967 sub _sqlcase {
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]);
971 }
972
973
974 #======================================================================
975 # DISPATCHING FROM REFKIND
976 #======================================================================
977
978 sub _refkind {
979   my ($self, $data) = @_;
980
981   return 'UNDEF' unless defined $data;
982
983   # blessed objects are treated like scalars
984   my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
985
986   return 'SCALAR' unless $ref;
987
988   my $n_steps = 1;
989   while ($ref eq 'REF') {
990     $data = $$data;
991     $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
992     $n_steps++ if $ref;
993   }
994
995   return ($ref||'SCALAR') . ('REF' x $n_steps);
996 }
997
998 sub _try_refkind {
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';
1003   return \@try;
1004 }
1005
1006 sub _METHOD_FOR_refkind {
1007   my ($self, $meth_prefix, $data) = @_;
1008
1009   my $method;
1010   for (@{$self->_try_refkind($data)}) {
1011     $method = $self->can($meth_prefix."_".$_)
1012       and last;
1013   }
1014
1015   return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1016 }
1017
1018
1019 sub _SWITCH_refkind {
1020   my ($self, $data, $dispatch_table) = @_;
1021
1022   my $coderef;
1023   for (@{$self->_try_refkind($data)}) {
1024     $coderef = $dispatch_table->{$_}
1025       and last;
1026   }
1027
1028   puke "no dispatch entry for ".$self->_refkind($data)
1029     unless $coderef;
1030
1031   $coderef->();
1032 }
1033
1034
1035
1036
1037 #======================================================================
1038 # VALUES, GENERATE, AUTOLOAD
1039 #======================================================================
1040
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.
1044
1045 sub values {
1046     my $self = shift;
1047     my $data = shift || return;
1048     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1049         unless ref $data eq 'HASH';
1050
1051     my @all_bind;
1052     foreach my $k ( sort keys %$data ) {
1053         my $v = $data->{$k};
1054         $self->_SWITCH_refkind($v, {
1055           ARRAYREF => sub {
1056             if ($self->{array_datatypes}) { # array datatype
1057               push @all_bind, $self->_bindtype($k, $v);
1058             }
1059             else {                          # literal SQL with bind
1060               my ($sql, @bind) = @$v;
1061               $self->_assert_bindval_matches_bindtype(@bind);
1062               push @all_bind, @bind;
1063             }
1064           },
1065           ARRAYREFREF => sub { # literal SQL with bind
1066             my ($sql, @bind) = @${$v};
1067             $self->_assert_bindval_matches_bindtype(@bind);
1068             push @all_bind, @bind;
1069           },
1070           SCALARREF => sub {  # literal SQL without bind
1071           },
1072           SCALAR_or_UNDEF => sub {
1073             push @all_bind, $self->_bindtype($k, $v);
1074           },
1075         });
1076     }
1077
1078     return @all_bind;
1079 }
1080
1081 sub generate {
1082     my $self  = shift;
1083
1084     my(@sql, @sqlq, @sqlv);
1085
1086     for (@_) {
1087         my $ref = ref $_;
1088         if ($ref eq 'HASH') {
1089             for my $k (sort keys %$_) {
1090                 my $v = $_->{$k};
1091                 my $r = ref $v;
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";
1098                     push @sqlv, @bind;
1099                 } elsif ($r eq 'SCALAR') {
1100                     # literal SQL without bind
1101                     push @sqlq, "$label = $$v";
1102                 } else {
1103                     push @sqlq, "$label = ?";
1104                     push @sqlv, $self->_bindtype($k, $v);
1105                 }
1106             }
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
1110             for my $v (@$_) {
1111                 my $r = ref $v;
1112                 if ($r eq 'ARRAY') {   # literal SQL with bind
1113                     my ($sql, @bind) = @$v;
1114                     $self->_assert_bindval_matches_bindtype(@bind);
1115                     push @sqlq, $sql;
1116                     push @sqlv, @bind;
1117                 } elsif ($r eq 'SCALAR') {  # literal SQL without bind
1118                     # embedded literal SQL
1119                     push @sqlq, $$v;
1120                 } else {
1121                     push @sqlq, '?';
1122                     push @sqlv, $v;
1123                 }
1124             }
1125             push @sql, '(' . join(', ', @sqlq) . ')';
1126         } elsif ($ref eq 'SCALAR') {
1127             # literal SQL
1128             push @sql, $$_;
1129         } else {
1130             # strings get case twiddled
1131             push @sql, $self->_sqlcase($_);
1132         }
1133     }
1134
1135     my $sql = join ' ', @sql;
1136
1137     # this is pretty tricky
1138     # if ask for an array, return ($stmt, @bind)
1139     # otherwise, s/?/shift @sqlv/ to put it inline
1140     if (wantarray) {
1141         return ($sql, @sqlv);
1142     } else {
1143         1 while $sql =~ s/\?/my $d = shift(@sqlv);
1144                              ref $d ? $d->[1] : $d/e;
1145         return $sql;
1146     }
1147 }
1148
1149
1150 sub DESTROY { 1 }
1151
1152 sub AUTOLOAD {
1153     # This allows us to check for a local, then _form, attr
1154     my $self = shift;
1155     my($name) = $AUTOLOAD =~ /.*::(.+)/;
1156     return $self->generate($name, @_);
1157 }
1158
1159 1;
1160
1161
1162
1163 __END__
1164
1165 =head1 NAME
1166
1167 SQL::Abstract - Generate SQL from Perl data structures
1168
1169 =head1 SYNOPSIS
1170
1171     use SQL::Abstract;
1172
1173     my $sql = SQL::Abstract->new;
1174
1175     my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1176
1177     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1178
1179     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1180
1181     my($stmt, @bind) = $sql->delete($table, \%where);
1182
1183     # Then, use these in your DBI statements
1184     my $sth = $dbh->prepare($stmt);
1185     $sth->execute(@bind);
1186
1187     # Just generate the WHERE clause
1188     my($stmt, @bind) = $sql->where(\%where, \@order);
1189
1190     # Return values in the same order, for hashed queries
1191     # See PERFORMANCE section for more details
1192     my @bind = $sql->values(\%fieldvals);
1193
1194 =head1 DESCRIPTION
1195
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.
1201
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.
1210
1211 To begin with, an SQL INSERT is as easy as just specifying a hash
1212 of C<key=value> pairs:
1213
1214     my %data = (
1215         name => 'Jimbo Bobson',
1216         phone => '123-456-7890',
1217         address => '42 Sister Lane',
1218         city => 'St. Louis',
1219         state => 'Louisiana',
1220     );
1221
1222 The SQL can then be generated with this:
1223
1224     my($stmt, @bind) = $sql->insert('people', \%data);
1225
1226 Which would give you something like this:
1227
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');
1233
1234 These are then used directly in your DBI code:
1235
1236     my $sth = $dbh->prepare($stmt);
1237     $sth->execute(@bind);
1238
1239 =head2 Inserting and Updating Arrays
1240
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:
1245
1246     my $sql = SQL::Abstract->new(array_datatypes => 1);
1247     my %data = (
1248         planets => [qw/Mercury Venus Earth Mars/]
1249     );
1250
1251     my($stmt, @bind) = $sql->insert('solar_system', \%data);
1252
1253 This results in:
1254
1255     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1256
1257     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1258
1259
1260 =head2 Inserting and Updating SQL
1261
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:
1266
1267     my %data = (
1268         name => 'Bill',
1269         date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1270     );
1271
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
1274 you:
1275
1276     my($stmt, @bind) = $sql->insert('people', \%data);
1277
1278     $stmt = "INSERT INTO people (name, date_entered)
1279                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1280     @bind = ('Bill', '03/02/2003');
1281
1282 An UPDATE is just as easy, all you change is the name of the function:
1283
1284     my($stmt, @bind) = $sql->update('people', \%data);
1285
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...
1290
1291 =head2 Complex where statements
1292
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:
1298
1299     my %where = (
1300        requestor => 'inna',
1301        worker => ['nwiger', 'rcwe', 'sfz'],
1302        status => { '!=', 'completed' }
1303     );
1304
1305     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1306
1307 The above would give you something like this:
1308
1309     $stmt = "SELECT * FROM tickets WHERE
1310                 ( requestor = ? ) AND ( status != ? )
1311                 AND ( worker = ? OR worker = ? OR worker = ? )";
1312     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1313
1314 Which you could then use in DBI code like so:
1315
1316     my $sth = $dbh->prepare($stmt);
1317     $sth->execute(@bind);
1318
1319 Easy, eh?
1320
1321 =head1 FUNCTIONS
1322
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.
1327
1328
1329
1330
1331 =head2 new(option => 'value')
1332
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:
1336
1337 =over
1338
1339 =item case
1340
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:
1343
1344     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1345
1346 Any setting other than 'lower' is ignored.
1347
1348 =item cmp
1349
1350 This determines what the default comparison operator is. By default
1351 it is C<=>, meaning that a hash like this:
1352
1353     %where = (name => 'nwiger', email => 'nate@wiger.org');
1354
1355 Will generate SQL like this:
1356
1357     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1358
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:
1361
1362     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1363
1364 You can also override the comparsion on an individual basis - see
1365 the huge section on L</"WHERE CLAUSES"> at the bottom.
1366
1367 =item sqltrue, sqlfalse
1368
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).
1373
1374 =item logic
1375
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
1379 array of the form:
1380
1381     @where = (
1382         event_date => {'>=', '2/13/99'},
1383         event_date => {'<=', '4/24/03'},
1384     );
1385
1386 will generate SQL like this:
1387
1388     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1389
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:
1392
1393     my $sql = SQL::Abstract->new(logic => 'and');
1394
1395 Which will change the above C<WHERE> to:
1396
1397     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1398
1399 The logic can also be changed locally by inserting
1400 a modifier in front of an arrayref :
1401
1402     @where = (-and => [event_date => {'>=', '2/13/99'},
1403                        event_date => {'<=', '4/24/03'} ]);
1404
1405 See the L</"WHERE CLAUSES"> section for explanations.
1406
1407 =item convert
1408
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:
1413
1414     $sql = SQL::Abstract->new(convert => 'upper');
1415     %where = (keywords => 'MaKe iT CAse inSeNSItive');
1416
1417 Will turn out the following SQL:
1418
1419     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1420
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).
1424
1425 =item bindtype
1426
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()>:
1430
1431     $sth->bind_param(1, 'reg data');
1432     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1433
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.
1436
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:
1440
1441     my $sql = SQL::Abstract->new(bindtype => 'columns');
1442     my($stmt, @bind) = $sql->insert(...);
1443
1444     @bind = (
1445         [ 'column1', 'value1' ],
1446         [ 'column2', 'value2' ],
1447         [ 'column3', 'value3' ],
1448     );
1449
1450 You can then iterate through this manually, using DBI's C<bind_param()>.
1451
1452     $sth->prepare($stmt);
1453     my $i = 1;
1454     for (@bind) {
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});
1460         } else {
1461             $sth->bind_param($i, $data);
1462         }
1463         $i++;
1464     }
1465     $sth->execute;      # execute without @bind now
1466
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.
1472
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.
1476
1477 =item quote_char
1478
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:
1482
1483   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1484
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:
1489
1490   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1491
1492 Quoting is useful if you have tables or columns names that are reserved
1493 words in your database's SQL dialect.
1494
1495 =item name_sep
1496
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:
1500
1501   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1502
1503 =item injection_guard
1504
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.:
1508
1509   my %condition_as_column_value_pairs = get_values_from_user();
1510   $sqla->select( ... , \%condition_as_column_value_pairs );
1511
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.
1514
1515 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1516
1517 =item array_datatypes
1518
1519 When this option is true, arrayrefs in INSERT or UPDATE are
1520 interpreted as array datatypes and are passed directly
1521 to the DBI layer.
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
1526 for literal SQL).
1527
1528
1529 =item special_ops
1530
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.
1534
1535 =item unary_ops
1536
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.
1540
1541
1542
1543 =back
1544
1545 =head2 insert($table, \@values || \%fieldvals, \%options)
1546
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.
1553
1554 The optional C<\%options> hash reference may contain additional
1555 options to generate the insert SQL. Currently supported options
1556 are:
1557
1558 =over 4
1559
1560 =item returning
1561
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.
1568
1569 =back
1570
1571 =head2 update($table, \%fieldvals, \%where)
1572
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
1575 of bind values.
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.
1579
1580 =head2 select($source, $fields, $where, $order)
1581
1582 This returns a SQL SELECT statement and associated list of bind values, as
1583 specified by the arguments  :
1584
1585 =over
1586
1587 =item $source
1588
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).
1595
1596 =item $fields
1597
1598 Specification of the list of fields to retrieve from
1599 the source.
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.
1605
1606 =item $where
1607
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.
1612
1613 =item $order
1614
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">
1618 for details.
1619
1620 =back
1621
1622
1623 =head2 delete($table, \%where)
1624
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.
1627
1628 =head2 where(\%where, \@order)
1629
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.
1635
1636
1637 =head2 values(\%data)
1638
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.
1643
1644 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1645
1646 Warning: This is an experimental method and subject to change.
1647
1648 This returns arbitrarily generated SQL. It's a really basic shortcut.
1649 It will return two different things, depending on return context:
1650
1651     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1652     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1653
1654 These would return the following:
1655
1656     # First calling form
1657     $stmt = "CREATE TABLE test (?, ?)";
1658     @bind = (field1, field2);
1659
1660     # Second calling form
1661     $stmt_and_val = "CREATE TABLE test (field1, field2)";
1662
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.
1665
1666 By the same token:
1667
1668     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1669
1670 Might give you:
1671
1672     ALTER SESSION SET nls_date_format = 'MM/YY'
1673
1674 You get the idea. Strings get their case twiddled, but everything
1675 else remains verbatim.
1676
1677 =head1 WHERE CLAUSES
1678
1679 =head2 Introduction
1680
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
1684 are AND'ed.>
1685
1686 The easiest way to explain is to show lots of examples. After
1687 each C<%where> hash shown, it is assumed you used:
1688
1689     my($stmt, @bind) = $sql->where(\%where);
1690
1691 However, note that the C<%where> hash can be used directly in any
1692 of the other functions as well, as described above.
1693
1694 =head2 Key-value pairs
1695
1696 So, let's get started. To begin, a simple hash:
1697
1698     my %where  = (
1699         user   => 'nwiger',
1700         status => 'completed'
1701     );
1702
1703 Is converted to SQL C<key = val> statements:
1704
1705     $stmt = "WHERE user = ? AND status = ?";
1706     @bind = ('nwiger', 'completed');
1707
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
1710 an arrayref:
1711
1712     my %where  = (
1713         user   => 'nwiger',
1714         status => ['assigned', 'in-progress', 'pending'];
1715     );
1716
1717 This simple code will create the following:
1718
1719     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1720     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1721
1722 A field associated to an empty arrayref will be considered a
1723 logical false and will generate 0=1.
1724
1725 =head2 Tests for NULL values
1726
1727 If the value part is C<undef> then this is converted to SQL <IS NULL>
1728
1729     my %where  = (
1730         user   => 'nwiger',
1731         status => undef,
1732     );
1733
1734 becomes:
1735
1736     $stmt = "WHERE user = ? AND status IS NULL";
1737     @bind = ('nwiger');
1738
1739 To test if a column IS NOT NULL:
1740
1741     my %where  = (
1742         user   => 'nwiger',
1743         status => { '!=', undef },
1744     );
1745
1746 =head2 Specific comparison operators
1747
1748 If you want to specify a different type of operator for your comparison,
1749 you can use a hashref for a given column:
1750
1751     my %where  = (
1752         user   => 'nwiger',
1753         status => { '!=', 'completed' }
1754     );
1755
1756 Which would generate:
1757
1758     $stmt = "WHERE user = ? AND status != ?";
1759     @bind = ('nwiger', 'completed');
1760
1761 To test against multiple values, just enclose the values in an arrayref:
1762
1763     status => { '=', ['assigned', 'in-progress', 'pending'] };
1764
1765 Which would give you:
1766
1767     "WHERE status = ? OR status = ? OR status = ?"
1768
1769
1770 The hashref can also contain multiple pairs, in which case it is expanded
1771 into an C<AND> of its elements:
1772
1773     my %where  = (
1774         user   => 'nwiger',
1775         status => { '!=', 'completed', -not_like => 'pending%' }
1776     );
1777
1778     # Or more dynamically, like from a form
1779     $where{user} = 'nwiger';
1780     $where{status}{'!='} = 'completed';
1781     $where{status}{'-not_like'} = 'pending%';
1782
1783     # Both generate this
1784     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1785     @bind = ('nwiger', 'completed', 'pending%');
1786
1787
1788 To get an OR instead, you can combine it with the arrayref idea:
1789
1790     my %where => (
1791          user => 'nwiger',
1792          priority => [ { '=', 2 }, { '>', 5 } ]
1793     );
1794
1795 Which would generate:
1796
1797     $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1798     @bind = ('2', '5', 'nwiger');
1799
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:
1802
1803     my %where  = (
1804         date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1805         date_expires => { '<' => \"now()" }
1806     );
1807
1808 Which would generate:
1809
1810     $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1811     @bind = ('11/26/2008');
1812
1813
1814 =head2 Logic and nesting operators
1815
1816 In the example above,
1817 there is a subtle trap if you want to say something like
1818 this (notice the C<AND>):
1819
1820     WHERE priority != ? AND priority != ?
1821
1822 Because, in Perl you I<can't> do this:
1823
1824     priority => { '!=', 2, '!=', 1 }
1825
1826 As the second C<!=> key will obliterate the first. The solution
1827 is to use the special C<-modifier> form inside an arrayref:
1828
1829     priority => [ -and => {'!=', 2},
1830                           {'!=', 1} ]
1831
1832
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:
1839
1840     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
1841
1842 Here is a quick list of equivalencies, since there is some overlap:
1843
1844     # Same
1845     status => {'!=', 'completed', 'not like', 'pending%' }
1846     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1847
1848     # Same
1849     status => {'=', ['assigned', 'in-progress']}
1850     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1851     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1852
1853
1854
1855 =head2 Special operators : IN, BETWEEN, etc.
1856
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:
1859
1860     my %where  = (
1861         status   => 'completed',
1862         reportid => { -in => [567, 2335, 2] }
1863     );
1864
1865 Which would generate:
1866
1867     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1868     @bind = ('completed', '567', '2335', '2');
1869
1870 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1871 the same way.
1872
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>).
1876
1877 In addition to the array you can supply a chunk of literal sql or
1878 literal sql with bind:
1879
1880     my %where = {
1881       customer => { -in => \[
1882         'SELECT cust_id FROM cust WHERE balance > ?',
1883         2000,
1884       ],
1885       status => { -in => \'SELECT status_codes FROM states' },
1886     };
1887
1888 would generate:
1889
1890     $stmt = "WHERE (
1891           customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1892       AND status IN ( SELECT status_codes FROM states )
1893     )";
1894     @bind = ('2000');
1895
1896
1897
1898 Another pair of operators is C<-between> and C<-not_between>,
1899 used with an arrayref of two values:
1900
1901     my %where  = (
1902         user   => 'nwiger',
1903         completion_date => {
1904            -not_between => ['2002-10-01', '2003-02-06']
1905         }
1906     );
1907
1908 Would give you:
1909
1910     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1911
1912 Just like with C<-in> all plausible combinations of literal SQL
1913 are possible:
1914
1915     my %where = {
1916       start0 => { -between => [ 1, 2 ] },
1917       start1 => { -between => \["? AND ?", 1, 2] },
1918       start2 => { -between => \"lower(x) AND upper(y)" },
1919       start3 => { -between => [
1920         \"lower(x)",
1921         \["upper(?)", 'stuff' ],
1922       ] },
1923     };
1924
1925 Would give you:
1926
1927     $stmt = "WHERE (
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(?)  )
1932     )";
1933     @bind = (1, 2, 1, 2, 'stuff');
1934
1935
1936 These are the two builtin "special operators"; but the
1937 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1938
1939 =head2 Unary operators: bool
1940
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:-
1945
1946     my %where  = (
1947         -bool       => 'is_user',
1948         -not_bool   => 'is_enabled',
1949     );
1950
1951 Would give you:
1952
1953     WHERE is_user AND NOT is_enabled
1954
1955 If a more complex combination is required, testing more conditions,
1956 then you should use the and/or operators:-
1957
1958     my %where  = (
1959         -and           => [
1960             -bool      => 'one',
1961             -bool      => 'two',
1962             -bool      => 'three',
1963             -not_bool  => 'four',
1964         ],
1965     );
1966
1967 Would give you:
1968
1969     WHERE one AND two AND three AND NOT four
1970
1971
1972 =head2 Nested conditions, -and/-or prefixes
1973
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:
1977
1978     my @where = (
1979         {
1980             user   => 'nwiger',
1981             status => { -like => ['pending%', 'dispatched'] },
1982         },
1983         {
1984             user   => 'robot',
1985             status => 'unassigned',
1986         }
1987     );
1988
1989 This data structure would create the following:
1990
1991     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1992                 OR ( user = ? AND status = ? ) )";
1993     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1994
1995
1996 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
1997 to change the logic inside :
1998
1999     my @where = (
2000          -and => [
2001             user => 'nwiger',
2002             [
2003                 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2004                 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2005             ],
2006         ],
2007     );
2008
2009 That would yield:
2010
2011     WHERE ( user = ? AND (
2012                ( workhrs > ? AND geo = ? )
2013             OR ( workhrs < ? OR geo = ? )
2014           ) )
2015
2016 =head3 Algebraic inconsistency, for historical reasons
2017
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 :
2022
2023    my @where = (
2024      -and => [a => 1, b => 2],
2025      -or  => [c => 3, d => 4],
2026       e   => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2027    )
2028
2029 yielding
2030
2031   WHERE ( (    ( a = ? AND b = ? )
2032             OR ( c = ? OR d = ? )
2033             OR ( e LIKE ? AND e LIKE ? ) ) )
2034
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
2038
2039   {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2040   # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2041
2042   [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2043   # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2044
2045
2046 =head2 Literal SQL and value type operators
2047
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.
2053
2054 =head3 -ident
2055
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:
2059
2060     my %where = (
2061         priority => { '<', 2 },
2062         requestor => { -ident => 'submitter' },
2063     );
2064
2065 which creates:
2066
2067     $stmt = "WHERE priority < ? AND requestor = submitter";
2068     @bind = ('2');
2069
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
2072 code.
2073
2074 =head3 -value
2075
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:
2080
2081     my %where = (
2082         array => { -value => [1, 2, 3] }
2083     );
2084
2085 will result in:
2086
2087     $stmt = 'WHERE array = ?';
2088     @bind = ([1, 2, 3]);
2089
2090 Note that if you were to simply say:
2091
2092     my %where = (
2093         array => [1, 2, 3]
2094     );
2095
2096 the result would porbably be not what you wanted:
2097
2098     $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2099     @bind = (1, 2, 3);
2100
2101 =head3 Literal SQL
2102
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:
2106
2107     my %where = (
2108         priority => { '<', 2 },
2109         requestor => { -in => \'(SELECT name FROM hitmen)' },
2110     );
2111
2112 Would create:
2113
2114     $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2115     @bind = (2);
2116
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.
2119
2120 =head4 CAVEAT
2121
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.
2126
2127 =head3 Literal SQL with placeholders and bind values (subqueries)
2128
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:
2133
2134     my %where = (
2135        date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2136     )
2137
2138 This would create:
2139
2140     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2141     @bind = ('10');
2142
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:
2150
2151     my %where = (
2152        date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2153     )
2154
2155 Literal SQL is especially useful for nesting parenthesized clauses in the
2156 main SQL query. Here is a first example :
2157
2158   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2159                                100, "foo%");
2160   my %where = (
2161     foo => 1234,
2162     bar => \["IN ($sub_stmt)" => @sub_bind],
2163   );
2164
2165 This yields :
2166
2167   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2168                                              WHERE c2 < ? AND c3 LIKE ?))";
2169   @bind = (1234, 100, "foo%");
2170
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
2174 to C<select()> :
2175
2176   my ($sub_stmt, @sub_bind)
2177      = $sql->select("t1", "c1", {c2 => {"<" => 100},
2178                                  c3 => {-like => "foo%"}});
2179   my %where = (
2180     foo => 1234,
2181     bar => \["> ALL ($sub_stmt)" => @sub_bind],
2182   );
2183
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 :
2187
2188   my ($sub_stmt, @sub_bind)
2189      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2190   my %where = ( -and => [
2191     foo   => 1234,
2192     \["EXISTS ($sub_stmt)" => @sub_bind],
2193   ]);
2194
2195 which yields
2196
2197   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2198                                         WHERE c1 = ? AND c2 > t0.c0))";
2199   @bind = (1234, 1);
2200
2201
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.
2208
2209 Finally, here is an example where a subquery is used
2210 for expressing unary negation:
2211
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
2215   my %where = (
2216         lname  => {like => '%son%'},
2217         \["NOT ($sub_stmt)" => @sub_bind],
2218     );
2219
2220 This yields
2221
2222   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2223   @bind = ('%son%', 10, 20)
2224
2225 =head3 Deprecated usage of Literal SQL
2226
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.
2230
2231 =over
2232
2233 =item *
2234
2235     my %where = ( requestor => \'IS NOT NULL' )
2236
2237     $stmt = "WHERE requestor IS NOT NULL"
2238
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>.
2242
2243 =item *
2244
2245     my %where = ( requestor => \'= submitter' )
2246
2247     $stmt = "WHERE requestor = submitter"
2248
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.
2253
2254 =item *
2255
2256     my %where = ( is_ready  => \"", completed => { '>', '2012-12-21' } )
2257
2258     $stmt = "WHERE completed > ? AND is_ready"
2259     @bind = ('2012-12-21')
2260
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.
2264
2265 =back
2266
2267 =head2 Conclusion
2268
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.
2275
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
2280 script.
2281
2282 =head1 ORDER BY CLAUSES
2283
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:
2287
2288                Given            |         Will Generate
2289     ----------------------------------------------------------
2290                                 |
2291     \'colA DESC'                | ORDER BY colA DESC
2292                                 |
2293     'colA'                      | ORDER BY colA
2294                                 |
2295     [qw/colA colB/]             | ORDER BY colA, colB
2296                                 |
2297     {-asc  => 'colA'}           | ORDER BY colA ASC
2298                                 |
2299     {-desc => 'colB'}           | ORDER BY colB DESC
2300                                 |
2301     ['colA', {-asc => 'colB'}]  | ORDER BY colA, colB ASC
2302                                 |
2303     { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2304                                 |
2305     [                           |
2306       { -asc => 'colA' },       | ORDER BY colA ASC, colB DESC,
2307       { -desc => [qw/colB/],    |          colC ASC, colD ASC
2308       { -asc => [qw/colC colD/],|
2309     ]                           |
2310     ===========================================================
2311
2312
2313
2314 =head1 SPECIAL OPERATORS
2315
2316   my $sqlmaker = SQL::Abstract->new(special_ops => [
2317      {
2318       regex => qr/.../,
2319       handler => sub {
2320         my ($self, $field, $op, $arg) = @_;
2321         ...
2322       },
2323      },
2324      {
2325       regex => qr/.../,
2326       handler => 'method_name',
2327      },
2328    ]);
2329
2330 A "special operator" is a SQL syntactic clause that can be
2331 applied to a field, instead of a usual binary operator.
2332 For example :
2333
2334    WHERE field IN (?, ?, ?)
2335    WHERE field BETWEEN ? AND ?
2336    WHERE MATCH(field) AGAINST (?, ?)
2337
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
2345 entries:
2346
2347 =over
2348
2349 =item regex
2350
2351 the regular expression to match the operator
2352
2353 =item handler
2354
2355 Either a coderef or a plain scalar method name. In both cases
2356 the expected return is C<< ($sql, @bind) >>.
2357
2358 When supplied with a method name, it is simply called on the
2359 L<SQL::Abstract/> object as:
2360
2361  $self->$method_name ($field, $op, $arg)
2362
2363  Where:
2364
2365   $op is the part that matched the handler regex
2366   $field is the LHS of the operator
2367   $arg is the RHS
2368
2369 When supplied with a coderef, it is called as:
2370
2371  $coderef->($self, $field, $op, $arg)
2372
2373
2374 =back
2375
2376 For example, here is an implementation
2377 of the MATCH .. AGAINST syntax for MySQL
2378
2379   my $sqlmaker = SQL::Abstract->new(special_ops => [
2380
2381     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2382     {regex => qr/^match$/i,
2383      handler => sub {
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);
2393        }
2394      },
2395
2396   ]);
2397
2398
2399 =head1 UNARY OPERATORS
2400
2401   my $sqlmaker = SQL::Abstract->new(unary_ops => [
2402      {
2403       regex => qr/.../,
2404       handler => sub {
2405         my ($self, $op, $arg) = @_;
2406         ...
2407       },
2408      },
2409      {
2410       regex => qr/.../,
2411       handler => 'method_name',
2412      },
2413    ]);
2414
2415 A "unary operator" is a SQL syntactic clause that can be
2416 applied to a field - the operator goes before the field
2417
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
2421 entries:
2422
2423 =over
2424
2425 =item regex
2426
2427 the regular expression to match the operator
2428
2429 =item handler
2430
2431 Either a coderef or a plain scalar method name. In both cases
2432 the expected return is C<< $sql >>.
2433
2434 When supplied with a method name, it is simply called on the
2435 L<SQL::Abstract/> object as:
2436
2437  $self->$method_name ($op, $arg)
2438
2439  Where:
2440
2441   $op is the part that matched the handler regex
2442   $arg is the RHS or argument of the operator
2443
2444 When supplied with a coderef, it is called as:
2445
2446  $coderef->($self, $op, $arg)
2447
2448
2449 =back
2450
2451
2452 =head1 PERFORMANCE
2453
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
2458 yourself.
2459
2460 To maximize performance, use a code snippet like the following:
2461
2462     # prepare a statement handle using the first row
2463     # and then reuse it for the rest of the rows
2464     my($sth, $stmt);
2465     for my $href (@array_of_hashrefs) {
2466         $stmt ||= $sql->insert('table', $href);
2467         $sth  ||= $dbh->prepare($stmt);
2468         $sth->execute($sql->values($href));
2469     }
2470
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.
2476
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.
2483
2484 =head1 FORMBUILDER
2485
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:
2489
2490     #!/usr/bin/perl
2491
2492     use CGI::FormBuilder;
2493     use SQL::Abstract;
2494
2495     my $form = CGI::FormBuilder->new(...);
2496     my $sql  = SQL::Abstract->new;
2497
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});
2502     }
2503
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.
2507
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.
2512
2513 =head1 REPO
2514
2515 =over
2516
2517 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2518
2519 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2520
2521 =back
2522
2523 =head1 CHANGES
2524
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.
2533
2534 The main changes are :
2535
2536 =over
2537
2538 =item *
2539
2540 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2541
2542 =item *
2543
2544 support for the { operator => \"..." } construct (to embed literal SQL)
2545
2546 =item *
2547
2548 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2549
2550 =item *
2551
2552 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2553
2554 =item *
2555
2556 defensive programming : check arguments
2557
2558 =item *
2559
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)" >>.
2566
2567
2568 =item *
2569
2570 fixed semantics of  _bindtype on array args
2571
2572 =item *
2573
2574 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2575 we just avoid shifting arrays within that tree.
2576
2577 =item *
2578
2579 dropped the C<_modlogic> function
2580
2581 =back
2582
2583 =head1 ACKNOWLEDGEMENTS
2584
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:
2588
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")
2602
2603 Thanks!
2604
2605 =head1 SEE ALSO
2606
2607 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2608
2609 =head1 AUTHOR
2610
2611 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2612
2613 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2614
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.
2619
2620 =head1 LICENSE
2621
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)
2625
2626 =cut
2627