convert update, refactor some stuff
[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   DQ_WHERE DQ_DELETE DQ_UPDATE
16 );
17 use Data::Query::ExprHelpers qw(perl_scalar_value);
18
19 #======================================================================
20 # GLOBALS
21 #======================================================================
22
23 our $VERSION  = '1.72';
24
25 # This would confuse some packagers
26 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
27
28 our $AUTOLOAD;
29
30 # special operators (-in, -between). May be extended/overridden by user.
31 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
32 my @BUILTIN_SPECIAL_OPS = ();
33
34 # unaryish operators - key maps to handler
35 my @BUILTIN_UNARY_OPS = (
36   # the digits are backcompat stuff
37   { regex => qr/^ and  (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
38   { regex => qr/^ or   (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
39   { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
40   { regex => qr/^ (?: not \s )? bool     $/xi, handler => '_where_op_BOOL' },
41   { regex => qr/^ ident                  $/xi, handler => '_where_op_IDENT' },
42   { regex => qr/^ value                  $/ix, handler => '_where_op_VALUE' },
43 );
44
45 #======================================================================
46 # DEBUGGING AND ERROR REPORTING
47 #======================================================================
48
49 sub _debug {
50   return unless $_[0]->{debug}; shift; # a little faster
51   my $func = (caller(1))[3];
52   warn "[$func] ", @_, "\n";
53 }
54
55 sub belch (@) {
56   my($func) = (caller(1))[3];
57   Carp::carp "[$func] Warning: ", @_;
58 }
59
60 sub puke (@) {
61   my($func) = (caller(1))[3];
62   Carp::croak "[$func] Fatal: ", @_;
63 }
64
65
66 #======================================================================
67 # NEW
68 #======================================================================
69
70 sub new {
71   my $self = shift;
72   my $class = ref($self) || $self;
73   my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
74
75   # choose our case by keeping an option around
76   delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
77
78   # default logic for interpreting arrayrefs
79   $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
80
81   # how to return bind vars
82   # LDNOTE: changed nwiger code : why this 'delete' ??
83   # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
84   $opt{bindtype} ||= 'normal';
85
86   # default comparison is "=", but can be overridden
87   $opt{cmp} ||= '=';
88
89   # try to recognize which are the 'equality' and 'unequality' ops
90   # (temporary quickfix, should go through a more seasoned API)
91   $opt{equality_op}   = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
92   $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
93
94   # SQL booleans
95   $opt{sqltrue}  ||= '1=1';
96   $opt{sqlfalse} ||= '0=1';
97
98   # special operators
99   $opt{special_ops} ||= [];
100   # regexes are applied in order, thus push after user-defines
101   push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
102
103   # unary operators
104   $opt{unary_ops} ||= [];
105   push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
106
107   # rudimentary saniy-check for user supplied bits treated as functions/operators
108   # If a purported  function matches this regular expression, an exception is thrown.
109   # Literal SQL is *NOT* subject to this check, only functions (and column names
110   # when quoting is not in effect)
111
112   # FIXME
113   # need to guard against ()'s in column names too, but this will break tons of
114   # hacks... ideas anyone?
115   $opt{injection_guard} ||= qr/
116     \;
117       |
118     ^ \s* go \s
119   /xmi;
120
121   $opt{name_sep} ||= '.';
122
123   $opt{renderer} ||= do {
124     require Data::Query::Renderer::SQL::Naive;
125     my ($always, $chars);
126     for ($opt{quote_char}) {
127       $chars = defined() ? (ref() ? $_ : [$_]) : ['',''];
128       $always = defined;
129     }
130     Data::Query::Renderer::SQL::Naive->new({
131       quote_chars => $chars, always_quote => $always,
132       ($opt{case} ? (lc_keywords => 1) : ()), # always 'lower' if it exists
133     });
134   };
135
136   return bless \%opt, $class;
137 }
138
139 sub _render_dq {
140   my ($self, $dq) = @_;
141   if (!$dq) {
142     return '';
143   }
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 _bind_to_dq {
166   my ($self, @bind) = @_;
167   return unless @bind;
168   $self->{bindtype} eq 'normal'
169     ? map perl_scalar_value($_), @bind
170     : do {
171         $self->_assert_bindval_matches_bindtype(@bind);
172         map perl_scalar_value(reverse @$_), @bind
173       }
174 }
175
176 sub _value_to_dq {
177   my ($self, $value) = @_;
178   $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
179 }
180
181 sub _ident_to_dq {
182   my ($self, $ident) = @_;
183   $self->_assert_pass_injection_guard($ident)
184     unless $self->{renderer}{always_quote};
185   $self->_maybe_convert_dq({
186     type => DQ_IDENTIFIER,
187     elements => [ split /\Q$self->{name_sep}/, $ident ],
188   });
189 }
190
191 sub _maybe_convert_dq {
192   my ($self, $dq) = @_;
193   if (my $c = $self->{where_convert}) {
194     +{
195        type => DQ_OPERATOR,
196        operator => { 'SQL.Naive' => 'apply' },
197        args => [
198          { type => DQ_IDENTIFIER, elements => [ $self->_sqlcase($c) ] },
199          $dq
200        ]
201      };
202   } else {
203     $dq;
204   }
205 }
206
207 sub _op_to_dq {
208   my ($self, $op, @args) = @_;
209   $self->_assert_pass_injection_guard($op);
210   +{
211     type => DQ_OPERATOR,
212     operator => { 'SQL.Naive' => $op },
213     args => \@args
214   };
215 }
216
217 sub _assert_pass_injection_guard {
218   if ($_[1] =~ $_[0]->{injection_guard}) {
219     my $class = ref $_[0];
220     puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
221      . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
222      . "{injection_guard} attribute to ${class}->new()"
223   }
224 }
225
226
227 #======================================================================
228 # INSERT methods
229 #======================================================================
230
231 sub insert {
232   my $self    = shift;
233   my $table   = $self->_table(shift);
234   my $data    = shift || return;
235   my $options = shift;
236
237   my $method       = $self->_METHOD_FOR_refkind("_insert", $data);
238   my ($sql, @bind) = $self->$method($data);
239   $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
240
241   if ($options->{returning}) {
242     my ($s, @b) = $self->_insert_returning ($options);
243     $sql .= $s;
244     push @bind, @b;
245   }
246
247   return wantarray ? ($sql, @bind) : $sql;
248 }
249
250 sub _insert_returning {
251   my ($self, $options) = @_;
252
253   my $f = $options->{returning};
254
255   my $fieldlist = $self->_SWITCH_refkind($f, {
256     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$f;},
257     SCALAR       => sub {$self->_quote($f)},
258     SCALARREF    => sub {$$f},
259   });
260   return $self->_sqlcase(' returning ') . $fieldlist;
261 }
262
263 sub _insert_HASHREF { # explicit list of fields and then values
264   my ($self, $data) = @_;
265
266   my @fields = sort keys %$data;
267
268   my ($sql, @bind) = $self->_insert_values($data);
269
270   # assemble SQL
271   $_ = $self->_quote($_) foreach @fields;
272   $sql = "( ".join(", ", @fields).") ".$sql;
273
274   return ($sql, @bind);
275 }
276
277 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
278   my ($self, $data) = @_;
279
280   # no names (arrayref) so can't generate bindtype
281   $self->{bindtype} ne 'columns'
282     or belch "can't do 'columns' bindtype when called with arrayref";
283
284   # fold the list of values into a hash of column name - value pairs
285   # (where the column names are artificially generated, and their
286   # lexicographical ordering keep the ordering of the original list)
287   my $i = "a";  # incremented values will be in lexicographical order
288   my $data_in_hash = { map { ($i++ => $_) } @$data };
289
290   return $self->_insert_values($data_in_hash);
291 }
292
293 sub _insert_ARRAYREFREF { # literal SQL with bind
294   my ($self, $data) = @_;
295
296   my ($sql, @bind) = @${$data};
297   $self->_assert_bindval_matches_bindtype(@bind);
298
299   return ($sql, @bind);
300 }
301
302
303 sub _insert_SCALARREF { # literal SQL without bind
304   my ($self, $data) = @_;
305
306   return ($$data);
307 }
308
309 sub _insert_values {
310   my ($self, $data) = @_;
311
312   my (@values, @all_bind);
313   foreach my $column (sort keys %$data) {
314     my $v = $data->{$column};
315
316     $self->_SWITCH_refkind($v, {
317
318       ARRAYREF => sub {
319         if ($self->{array_datatypes}) { # if array datatype are activated
320           push @values, '?';
321           push @all_bind, $self->_bindtype($column, $v);
322         }
323         else {                          # else literal SQL with bind
324           my ($sql, @bind) = @$v;
325           $self->_assert_bindval_matches_bindtype(@bind);
326           push @values, $sql;
327           push @all_bind, @bind;
328         }
329       },
330
331       ARRAYREFREF => sub { # literal SQL with bind
332         my ($sql, @bind) = @${$v};
333         $self->_assert_bindval_matches_bindtype(@bind);
334         push @values, $sql;
335         push @all_bind, @bind;
336       },
337
338       # THINK : anything useful to do with a HASHREF ?
339       HASHREF => sub {  # (nothing, but old SQLA passed it through)
340         #TODO in SQLA >= 2.0 it will die instead
341         belch "HASH ref as bind value in insert is not supported";
342         push @values, '?';
343         push @all_bind, $self->_bindtype($column, $v);
344       },
345
346       SCALARREF => sub {  # literal SQL without bind
347         push @values, $$v;
348       },
349
350       SCALAR_or_UNDEF => sub {
351         push @values, '?';
352         push @all_bind, $self->_bindtype($column, $v);
353       },
354
355      });
356
357   }
358
359   my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
360   return ($sql, @all_bind);
361 }
362
363
364
365 #======================================================================
366 # UPDATE methods
367 #======================================================================
368
369
370 sub update {
371   my $self = shift;
372   $self->_render_dq($self->_update_to_dq(@_));
373 }
374
375 sub _update_to_dq {
376   my ($self, $table, $data, $where) = @_;
377
378   puke "Unsupported data type specified to \$sql->update"
379     unless ref $data eq 'HASH';
380
381   my @set;
382
383   KEY: for my $k (sort keys %$data) {
384     my $v = $data->{$k};
385     local our $Cur_Col_Meta = $k;
386
387     if (ref($v) eq 'ARRAY') {
388       if ($self->{array_datatypes}) {
389         push @set, [ $self->_ident_to_dq($k), $self->_value_to_dq($v) ];
390         next KEY;
391       }
392       $v = \$v;
393     }
394     if (ref($v) eq 'HASH') {
395       my ($op, $arg, @rest) = %$v;
396
397       puke 'Operator calls in update must be in the form { -op => $arg }'
398         if (@rest or not $op =~ /^\-(.+)/);
399     }
400     push @set, [ $self->_ident_to_dq($k), $self->_expr_to_dq($v) ];
401   }
402
403   return +{
404     type => DQ_UPDATE,
405     target => $self->_ident_to_dq($table),
406     set => \@set,
407     where => $self->_where_to_dq($where),
408   };
409 }
410
411
412
413
414 #======================================================================
415 # SELECT
416 #======================================================================
417
418 sub _source_to_dq {
419   my ($self, $table, $where) = @_;
420
421   my $source_dq = $self->_table_to_dq($table);
422
423   if (my $where_dq = $self->_where_to_dq($where)) {
424     $source_dq = {
425       type => DQ_WHERE,
426       from => $source_dq,
427       where => $where_dq,
428     };
429   }
430
431   $source_dq;
432 }
433
434 sub select {
435   my $self   = shift;
436   return $self->_render_dq($self->_select_to_dq(@_));
437 }
438
439 sub _select_to_dq {
440   my ($self, $table, $fields, $where, $order) = @_;
441   $fields ||= '*';
442
443   my $source_dq = $self->_source_to_dq($table, $where);
444
445   my $final_dq = {
446     type => DQ_SELECT,
447     select => [
448       map $self->_ident_to_dq($_),
449         ref($fields) eq 'ARRAY' ? @$fields : $fields
450     ],
451     from => $source_dq,
452   };
453
454   if ($order) {
455     $final_dq = $self->_order_by_to_dq($order, undef, $final_dq);
456   }
457
458   return $final_dq;
459 }
460
461 #======================================================================
462 # DELETE
463 #======================================================================
464
465
466 sub delete {
467   my $self  = shift;
468   $self->_render_dq($self->_delete_to_dq(@_));
469 }
470
471 sub _delete_to_dq {
472   my ($self, $table, $where) = @_;
473   +{
474     type => DQ_DELETE,
475     target => $self->_table_to_dq($table),
476     where => $self->_where_to_dq($where),
477   }
478 }
479
480
481 #======================================================================
482 # WHERE: entry point
483 #======================================================================
484
485
486
487 # Finally, a separate routine just to handle WHERE clauses
488 sub where {
489   my ($self, $where, $order) = @_;
490
491   my $sql = '';
492   my @bind;
493
494   # where ?
495   ($sql, @bind) = $self->_recurse_where($where) if defined($where);
496   $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
497
498   # order by?
499   if ($order) {
500     $sql .= $self->_order_by($order);
501   }
502
503   return wantarray ? ($sql, @bind) : $sql;
504 }
505
506 sub _recurse_where {
507   my ($self, $where, $logic) = @_;
508
509   return $self->_render_dq($self->_where_to_dq($where, $logic));
510 }
511
512 sub _where_to_dq {
513   my ($self, $where, $logic) = @_;
514
515   return undef unless defined($where);
516
517   # turn the convert misfeature on - only used in WHERE clauses
518   local $self->{where_convert} = $self->{convert};
519
520   return $self->_expr_to_dq($where, $logic);
521 }
522
523 sub _expr_to_dq {
524   my ($self, $where, $logic) = @_;
525
526   if (ref($where) eq 'ARRAY') {
527     return $self->_expr_to_dq_ARRAYREF($where, $logic);
528   } elsif (ref($where) eq 'HASH') {
529     return $self->_expr_to_dq_HASHREF($where, $logic);
530   } elsif (
531     ref($where) eq 'SCALAR'
532     or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
533   ) {
534     return $self->_literal_to_dq($$where);
535   } elsif (!ref($where) or Scalar::Util::blessed($where)) {
536     return $self->_value_to_dq($where);
537   }
538   die "Can't handle $where";
539 }
540
541 sub _expr_to_dq_ARRAYREF {
542   my ($self, $where, $logic) = @_;
543
544   $logic = uc($logic || $self->{logic} || 'OR');
545   $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
546
547   return unless @$where;
548
549   my ($first, @rest) = @$where;
550
551   return $self->_expr_to_dq($first) unless @rest;
552
553   my $first_dq = do {
554     if (!ref($first)) {
555       $self->_where_hashpair_to_dq($first => shift(@rest));
556     } else {
557       $self->_expr_to_dq($first);
558     }
559   };
560
561   return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
562
563   $self->_op_to_dq(
564     $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
565   );
566 }
567
568 sub _expr_to_dq_HASHREF {
569   my ($self, $where, $logic) = @_;
570
571   $logic = uc($logic) if $logic;
572
573   my @dq = map {
574     $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
575   } sort keys %$where;
576
577   return $dq[0] unless @dq > 1;
578
579   my $final = pop(@dq);
580
581   foreach my $dq (reverse @dq) {
582     $final = $self->_op_to_dq($logic||'AND', $dq, $final);
583   }
584
585   return $final;
586 }
587
588 sub _where_to_dq_SCALAR {
589   shift->_value_to_dq(@_);
590 }
591
592 sub _where_op_IDENT {
593   my $self = shift;
594   my ($op, $rhs) = splice @_, -2;
595   if (ref $rhs) {
596     puke "-$op takes a single scalar argument (a quotable identifier)";
597   }
598
599   # in case we are called as a top level special op (no '=')
600   my $lhs = shift;
601
602   $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
603
604   return $lhs
605     ? "$lhs = $rhs"
606     : $rhs
607   ;
608 }
609
610 sub _where_op_VALUE {
611   my $self = shift;
612   my ($op, $rhs) = splice @_, -2;
613
614   # in case we are called as a top level special op (no '=')
615   my $lhs = shift;
616
617   my @bind =
618     $self->_bindtype (
619       ($lhs || $self->{_nested_func_lhs}),
620       $rhs,
621     )
622   ;
623
624   return $lhs
625     ? (
626       $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
627       @bind
628     )
629     : (
630       $self->_convert('?'),
631       @bind,
632     )
633   ;
634 }
635
636 sub _where_hashpair_to_dq {
637   my ($self, $k, $v, $logic) = @_;
638
639   if ($k =~ /^-(.*)/s) {
640     my $op = uc($1);
641     if ($op eq 'AND' or $op eq 'OR') {
642       return $self->_expr_to_dq($v, $op);
643     } elsif ($op eq 'NEST') {
644       return $self->_expr_to_dq($v);
645     } elsif ($op eq 'NOT') {
646       return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
647     } elsif ($op eq 'BOOL') {
648       return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
649     } elsif ($op eq 'NOT_BOOL') {
650       return $self->_op_to_dq(
651         NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
652       );
653     } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
654       die "Use of [and|or|nest]_N modifiers is no longer supported";
655     } else {
656       my @args = do {
657         if (ref($v) eq 'HASH' and keys(%$v) == 1 and (keys %$v)[0] =~ /^-(.*)/s) {
658           my $op = uc($1);
659           my ($inner) = values %$v;
660           $self->_op_to_dq(
661             $op,
662             (map $self->_expr_to_dq($_),
663               (ref($inner) eq 'ARRAY' ? @$inner : $inner))
664           );
665         } else {
666           (map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v))
667         }
668       };
669       $self->_assert_pass_injection_guard($op);
670       return $self->_op_to_dq(
671         apply => $self->_ident_to_dq($op), @args
672       );
673     }
674   } else {
675     local our $Cur_Col_Meta = $k;
676     if (ref($v) eq 'ARRAY') {
677       if (!@$v) {
678         return $self->_literal_to_dq($self->{sqlfalse});
679       } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
680         return $self->_expr_to_dq_ARRAYREF([
681           map +{ $k => $_ }, @{$v}[1..$#$v]
682         ], uc($1));
683       }
684       return $self->_expr_to_dq_ARRAYREF([
685         map +{ $k => $_ }, @$v
686       ], $logic);
687     } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
688       return +{
689         type => DQ_LITERAL,
690         subtype => 'SQL',
691         parts => [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]
692       };
693     }
694     my ($op, $rhs) = do {
695       if (ref($v) eq 'HASH') {
696         if (keys %$v > 1) {
697           return $self->_expr_to_dq_ARRAYREF([
698             map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
699           ], $logic||'AND');
700         }
701         my ($op, $value) = %$v;
702         s/^-//, s/_/ /g for $op;
703         if ($op =~ /^(and|or)$/i) {
704           return $self->_expr_to_dq({ $k => $value }, $op);
705         } elsif (
706           my $special_op = List::Util::first {$op =~ $_->{regex}}
707                              @{$self->{special_ops}}
708         ) {
709           return $self->_literal_to_dq(
710             [ $self->${\$special_op->{handler}}($k, $op, $value) ]
711           );;
712         } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
713           die "Use of [and|or|nest]_N modifiers is no longer supported";
714         }
715         (uc($op), $value);
716       } else {
717         ($self->{cmp}, $v);
718       }
719     };
720     if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
721       if (ref($rhs) ne 'ARRAY') {
722         if ($op =~ /IN$/) {
723           # have to add parens if none present because -in => \"SELECT ..."
724           # got documented. mst hates everything.
725           if (ref($rhs) eq 'SCALAR') {
726             my $x = $$rhs;
727             1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
728             $rhs = \$x;
729           } else {
730             my ($x, @rest) = @{$$rhs};
731             1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
732             $rhs = \[ $x, @rest ];
733           }
734         }
735         return $self->_op_to_dq(
736           $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
737         );
738       }
739       return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
740       return $self->_op_to_dq(
741         $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
742       )
743     } elsif ($op =~ s/^NOT (?!LIKE)//) {
744       return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
745     } elsif (!defined($rhs)) {
746       my $null_op = do {
747         if ($op eq '=' or $op eq 'LIKE') {
748           'IS NULL'
749         } elsif ($op eq '!=') {
750           'IS NOT NULL'
751         } else {
752           die "Can't do undef -> NULL transform for operator ${op}";
753         }
754       };
755       return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
756     }
757     if (ref($rhs) eq 'ARRAY') {
758       if (!@$rhs) {
759         return $self->_literal_to_dq(
760           $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
761         );
762       } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
763         return $self->_expr_to_dq_ARRAYREF([
764           map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
765         ], uc($1));
766       } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
767         die "Use of [and|or|nest]_N modifiers is no longer supported";
768       }
769       return $self->_expr_to_dq_ARRAYREF([
770         map +{ $k => { $op => $_ } }, @$rhs
771       ]);
772     }
773     return $self->_op_to_dq(
774       $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
775     );
776   }
777 }
778
779 #======================================================================
780 # ORDER BY
781 #======================================================================
782
783 sub _order_by {
784   my ($self, $arg) = @_;
785   if (my $dq = $self->_order_by_to_dq($arg)) {
786     # SQLA generates ' ORDER BY foo'. The hilarity.
787     wantarray
788       ? do { my @r = $self->_render_dq($dq); $r[0] = ' '.$r[0]; @r }
789       : ' '.$self->_render_dq($dq);
790   } else {
791     '';
792   }
793 }
794
795 sub _order_by_to_dq {
796   my ($self, $arg, $dir, $from) = @_;
797
798   return unless $arg;
799
800   my $dq = {
801     type => DQ_ORDER,
802     ($dir ? (direction => $dir) : ()),
803     ($from ? (from => $from) : ()),
804   };
805
806   if (!ref($arg)) {
807     $dq->{by} = $self->_ident_to_dq($arg);
808   } elsif (ref($arg) eq 'ARRAY') {
809     return unless @$arg;
810     local our $Order_Inner unless our $Order_Recursing;
811     local $Order_Recursing = 1;
812     my ($outer, $inner);
813     foreach my $member (@$arg) {
814       local $Order_Inner;
815       my $next = $self->_order_by_to_dq($member, $dir, $from);
816       $outer ||= $next;
817       $inner->{from} = $next if $inner;
818       $inner = $Order_Inner || $next;
819     }
820     $Order_Inner = $inner;
821     return $outer;
822   } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
823     $dq->{by} = $self->_literal_to_dq($$arg);
824   } elsif (ref($arg) eq 'SCALAR') {
825     $dq->{by} = $self->_literal_to_dq($$arg);
826   } elsif (ref($arg) eq 'HASH') {
827     my ($key, $val, @rest) = %$arg;
828
829     return unless $key;
830
831     if (@rest or not $key =~ /^-(desc|asc)/i) {
832       puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
833     }
834     my $dir = uc $1;
835     return $self->_order_by_to_dq($val, $dir, $from);
836   } else {
837     die "Can't handle $arg in _order_by_to_dq";
838   }
839   return $dq;
840 }
841
842 #======================================================================
843 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
844 #======================================================================
845
846 sub _table  {
847   my ($self, $from) = @_;
848   $self->_render_dq($self->_table_to_dq($from));
849 }
850
851 sub _table_to_dq {
852   my ($self, $from) = @_;
853   $self->_SWITCH_refkind($from, {
854     ARRAYREF     => sub {
855       die "Empty FROM list" unless my @f = @$from;
856       my $dq = $self->_ident_to_dq(shift @f);
857       while (my $x = shift @f) {
858         $dq = {
859           type => DQ_JOIN,
860           join => [ $dq, $self->_ident_to_dq($x) ]
861         };
862       }
863       $dq;
864     },
865     SCALAR       => sub { $self->_ident_to_dq($from) },
866     SCALARREF    => sub {
867       +{
868         type => DQ_LITERAL,
869         subtype => 'SQL',
870         literal => $$from
871       }
872     },
873   });
874 }
875
876
877 #======================================================================
878 # UTILITY FUNCTIONS
879 #======================================================================
880
881 # highly optimized, as it's called way too often
882 sub _quote {
883   # my ($self, $label) = @_;
884
885   return '' unless defined $_[1];
886   return ${$_[1]} if ref($_[1]) eq 'SCALAR';
887
888   unless ($_[0]->{quote_char}) {
889     $_[0]->_assert_pass_injection_guard($_[1]);
890     return $_[1];
891   }
892
893   my $qref = ref $_[0]->{quote_char};
894   my ($l, $r);
895   if (!$qref) {
896     ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
897   }
898   elsif ($qref eq 'ARRAY') {
899     ($l, $r) = @{$_[0]->{quote_char}};
900   }
901   else {
902     puke "Unsupported quote_char format: $_[0]->{quote_char}";
903   }
904
905   # parts containing * are naturally unquoted
906   return join( $_[0]->{name_sep}||'', map
907     { $_ eq '*' ? $_ : $l . $_ . $r }
908     ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
909   );
910 }
911
912
913 # Conversion, if applicable
914 sub _convert ($) {
915   #my ($self, $arg) = @_;
916
917 # LDNOTE : modified the previous implementation below because
918 # it was not consistent : the first "return" is always an array,
919 # the second "return" is context-dependent. Anyway, _convert
920 # seems always used with just a single argument, so make it a
921 # scalar function.
922 #     return @_ unless $self->{convert};
923 #     my $conv = $self->_sqlcase($self->{convert});
924 #     my @ret = map { $conv.'('.$_.')' } @_;
925 #     return wantarray ? @ret : $ret[0];
926   if ($_[0]->{convert}) {
927     return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
928   }
929   return $_[1];
930 }
931
932 # And bindtype
933 sub _bindtype (@) {
934   #my ($self, $col, @vals) = @_;
935
936   #LDNOTE : changed original implementation below because it did not make
937   # sense when bindtype eq 'columns' and @vals > 1.
938 #  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
939
940   # called often - tighten code
941   return $_[0]->{bindtype} eq 'columns'
942     ? map {[$_[1], $_]} @_[2 .. $#_]
943     : @_[2 .. $#_]
944   ;
945 }
946
947 # Dies if any element of @bind is not in [colname => value] format
948 # if bindtype is 'columns'.
949 sub _assert_bindval_matches_bindtype {
950 #  my ($self, @bind) = @_;
951   my $self = shift;
952   if ($self->{bindtype} eq 'columns') {
953     for (@_) {
954       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
955         puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
956       }
957     }
958   }
959 }
960
961 sub _join_sql_clauses {
962   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
963
964   if (@$clauses_aref > 1) {
965     my $join  = " " . $self->_sqlcase($logic) . " ";
966     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
967     return ($sql, @$bind_aref);
968   }
969   elsif (@$clauses_aref) {
970     return ($clauses_aref->[0], @$bind_aref); # no parentheses
971   }
972   else {
973     return (); # if no SQL, ignore @$bind_aref
974   }
975 }
976
977
978 # Fix SQL case, if so requested
979 sub _sqlcase {
980   # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
981   # don't touch the argument ... crooked logic, but let's not change it!
982   return $_[0]->{case} ? $_[1] : uc($_[1]);
983 }
984
985
986 #======================================================================
987 # DISPATCHING FROM REFKIND
988 #======================================================================
989
990 sub _refkind {
991   my ($self, $data) = @_;
992
993   return 'UNDEF' unless defined $data;
994
995   # blessed objects are treated like scalars
996   my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
997
998   return 'SCALAR' unless $ref;
999
1000   my $n_steps = 1;
1001   while ($ref eq 'REF') {
1002     $data = $$data;
1003     $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1004     $n_steps++ if $ref;
1005   }
1006
1007   return ($ref||'SCALAR') . ('REF' x $n_steps);
1008 }
1009
1010 sub _try_refkind {
1011   my ($self, $data) = @_;
1012   my @try = ($self->_refkind($data));
1013   push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1014   push @try, 'FALLBACK';
1015   return \@try;
1016 }
1017
1018 sub _METHOD_FOR_refkind {
1019   my ($self, $meth_prefix, $data) = @_;
1020
1021   my $method;
1022   for (@{$self->_try_refkind($data)}) {
1023     $method = $self->can($meth_prefix."_".$_)
1024       and last;
1025   }
1026
1027   return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1028 }
1029
1030
1031 sub _SWITCH_refkind {
1032   my ($self, $data, $dispatch_table) = @_;
1033
1034   my $coderef;
1035   for (@{$self->_try_refkind($data)}) {
1036     $coderef = $dispatch_table->{$_}
1037       and last;
1038   }
1039
1040   puke "no dispatch entry for ".$self->_refkind($data)
1041     unless $coderef;
1042
1043   $coderef->();
1044 }
1045
1046
1047
1048
1049 #======================================================================
1050 # VALUES, GENERATE, AUTOLOAD
1051 #======================================================================
1052
1053 # LDNOTE: original code from nwiger, didn't touch code in that section
1054 # I feel the AUTOLOAD stuff should not be the default, it should
1055 # only be activated on explicit demand by user.
1056
1057 sub values {
1058     my $self = shift;
1059     my $data = shift || return;
1060     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1061         unless ref $data eq 'HASH';
1062
1063     my @all_bind;
1064     foreach my $k ( sort keys %$data ) {
1065         my $v = $data->{$k};
1066         $self->_SWITCH_refkind($v, {
1067           ARRAYREF => sub {
1068             if ($self->{array_datatypes}) { # array datatype
1069               push @all_bind, $self->_bindtype($k, $v);
1070             }
1071             else {                          # literal SQL with bind
1072               my ($sql, @bind) = @$v;
1073               $self->_assert_bindval_matches_bindtype(@bind);
1074               push @all_bind, @bind;
1075             }
1076           },
1077           ARRAYREFREF => sub { # literal SQL with bind
1078             my ($sql, @bind) = @${$v};
1079             $self->_assert_bindval_matches_bindtype(@bind);
1080             push @all_bind, @bind;
1081           },
1082           SCALARREF => sub {  # literal SQL without bind
1083           },
1084           SCALAR_or_UNDEF => sub {
1085             push @all_bind, $self->_bindtype($k, $v);
1086           },
1087         });
1088     }
1089
1090     return @all_bind;
1091 }
1092
1093 sub generate {
1094     my $self  = shift;
1095
1096     my(@sql, @sqlq, @sqlv);
1097
1098     for (@_) {
1099         my $ref = ref $_;
1100         if ($ref eq 'HASH') {
1101             for my $k (sort keys %$_) {
1102                 my $v = $_->{$k};
1103                 my $r = ref $v;
1104                 my $label = $self->_quote($k);
1105                 if ($r eq 'ARRAY') {
1106                     # literal SQL with bind
1107                     my ($sql, @bind) = @$v;
1108                     $self->_assert_bindval_matches_bindtype(@bind);
1109                     push @sqlq, "$label = $sql";
1110                     push @sqlv, @bind;
1111                 } elsif ($r eq 'SCALAR') {
1112                     # literal SQL without bind
1113                     push @sqlq, "$label = $$v";
1114                 } else {
1115                     push @sqlq, "$label = ?";
1116                     push @sqlv, $self->_bindtype($k, $v);
1117                 }
1118             }
1119             push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1120         } elsif ($ref eq 'ARRAY') {
1121             # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1122             for my $v (@$_) {
1123                 my $r = ref $v;
1124                 if ($r eq 'ARRAY') {   # literal SQL with bind
1125                     my ($sql, @bind) = @$v;
1126                     $self->_assert_bindval_matches_bindtype(@bind);
1127                     push @sqlq, $sql;
1128                     push @sqlv, @bind;
1129                 } elsif ($r eq 'SCALAR') {  # literal SQL without bind
1130                     # embedded literal SQL
1131                     push @sqlq, $$v;
1132                 } else {
1133                     push @sqlq, '?';
1134                     push @sqlv, $v;
1135                 }
1136             }
1137             push @sql, '(' . join(', ', @sqlq) . ')';
1138         } elsif ($ref eq 'SCALAR') {
1139             # literal SQL
1140             push @sql, $$_;
1141         } else {
1142             # strings get case twiddled
1143             push @sql, $self->_sqlcase($_);
1144         }
1145     }
1146
1147     my $sql = join ' ', @sql;
1148
1149     # this is pretty tricky
1150     # if ask for an array, return ($stmt, @bind)
1151     # otherwise, s/?/shift @sqlv/ to put it inline
1152     if (wantarray) {
1153         return ($sql, @sqlv);
1154     } else {
1155         1 while $sql =~ s/\?/my $d = shift(@sqlv);
1156                              ref $d ? $d->[1] : $d/e;
1157         return $sql;
1158     }
1159 }
1160
1161
1162 sub DESTROY { 1 }
1163
1164 sub AUTOLOAD {
1165     # This allows us to check for a local, then _form, attr
1166     my $self = shift;
1167     my($name) = $AUTOLOAD =~ /.*::(.+)/;
1168     return $self->generate($name, @_);
1169 }
1170
1171 1;
1172
1173
1174
1175 __END__
1176
1177 =head1 NAME
1178
1179 SQL::Abstract - Generate SQL from Perl data structures
1180
1181 =head1 SYNOPSIS
1182
1183     use SQL::Abstract;
1184
1185     my $sql = SQL::Abstract->new;
1186
1187     my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1188
1189     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1190
1191     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1192
1193     my($stmt, @bind) = $sql->delete($table, \%where);
1194
1195     # Then, use these in your DBI statements
1196     my $sth = $dbh->prepare($stmt);
1197     $sth->execute(@bind);
1198
1199     # Just generate the WHERE clause
1200     my($stmt, @bind) = $sql->where(\%where, \@order);
1201
1202     # Return values in the same order, for hashed queries
1203     # See PERFORMANCE section for more details
1204     my @bind = $sql->values(\%fieldvals);
1205
1206 =head1 DESCRIPTION
1207
1208 This module was inspired by the excellent L<DBIx::Abstract>.
1209 However, in using that module I found that what I really wanted
1210 to do was generate SQL, but still retain complete control over my
1211 statement handles and use the DBI interface. So, I set out to
1212 create an abstract SQL generation module.
1213
1214 While based on the concepts used by L<DBIx::Abstract>, there are
1215 several important differences, especially when it comes to WHERE
1216 clauses. I have modified the concepts used to make the SQL easier
1217 to generate from Perl data structures and, IMO, more intuitive.
1218 The underlying idea is for this module to do what you mean, based
1219 on the data structures you provide it. The big advantage is that
1220 you don't have to modify your code every time your data changes,
1221 as this module figures it out.
1222
1223 To begin with, an SQL INSERT is as easy as just specifying a hash
1224 of C<key=value> pairs:
1225
1226     my %data = (
1227         name => 'Jimbo Bobson',
1228         phone => '123-456-7890',
1229         address => '42 Sister Lane',
1230         city => 'St. Louis',
1231         state => 'Louisiana',
1232     );
1233
1234 The SQL can then be generated with this:
1235
1236     my($stmt, @bind) = $sql->insert('people', \%data);
1237
1238 Which would give you something like this:
1239
1240     $stmt = "INSERT INTO people
1241                     (address, city, name, phone, state)
1242                     VALUES (?, ?, ?, ?, ?)";
1243     @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1244              '123-456-7890', 'Louisiana');
1245
1246 These are then used directly in your DBI code:
1247
1248     my $sth = $dbh->prepare($stmt);
1249     $sth->execute(@bind);
1250
1251 =head2 Inserting and Updating Arrays
1252
1253 If your database has array types (like for example Postgres),
1254 activate the special option C<< array_datatypes => 1 >>
1255 when creating the C<SQL::Abstract> object.
1256 Then you may use an arrayref to insert and update database array types:
1257
1258     my $sql = SQL::Abstract->new(array_datatypes => 1);
1259     my %data = (
1260         planets => [qw/Mercury Venus Earth Mars/]
1261     );
1262
1263     my($stmt, @bind) = $sql->insert('solar_system', \%data);
1264
1265 This results in:
1266
1267     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1268
1269     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1270
1271
1272 =head2 Inserting and Updating SQL
1273
1274 In order to apply SQL functions to elements of your C<%data> you may
1275 specify a reference to an arrayref for the given hash value. For example,
1276 if you need to execute the Oracle C<to_date> function on a value, you can
1277 say something like this:
1278
1279     my %data = (
1280         name => 'Bill',
1281         date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1282     );
1283
1284 The first value in the array is the actual SQL. Any other values are
1285 optional and would be included in the bind values array. This gives
1286 you:
1287
1288     my($stmt, @bind) = $sql->insert('people', \%data);
1289
1290     $stmt = "INSERT INTO people (name, date_entered)
1291                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1292     @bind = ('Bill', '03/02/2003');
1293
1294 An UPDATE is just as easy, all you change is the name of the function:
1295
1296     my($stmt, @bind) = $sql->update('people', \%data);
1297
1298 Notice that your C<%data> isn't touched; the module will generate
1299 the appropriately quirky SQL for you automatically. Usually you'll
1300 want to specify a WHERE clause for your UPDATE, though, which is
1301 where handling C<%where> hashes comes in handy...
1302
1303 =head2 Complex where statements
1304
1305 This module can generate pretty complicated WHERE statements
1306 easily. For example, simple C<key=value> pairs are taken to mean
1307 equality, and if you want to see if a field is within a set
1308 of values, you can use an arrayref. Let's say we wanted to
1309 SELECT some data based on this criteria:
1310
1311     my %where = (
1312        requestor => 'inna',
1313        worker => ['nwiger', 'rcwe', 'sfz'],
1314        status => { '!=', 'completed' }
1315     );
1316
1317     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1318
1319 The above would give you something like this:
1320
1321     $stmt = "SELECT * FROM tickets WHERE
1322                 ( requestor = ? ) AND ( status != ? )
1323                 AND ( worker = ? OR worker = ? OR worker = ? )";
1324     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1325
1326 Which you could then use in DBI code like so:
1327
1328     my $sth = $dbh->prepare($stmt);
1329     $sth->execute(@bind);
1330
1331 Easy, eh?
1332
1333 =head1 FUNCTIONS
1334
1335 The functions are simple. There's one for each major SQL operation,
1336 and a constructor you use first. The arguments are specified in a
1337 similar order to each function (table, then fields, then a where
1338 clause) to try and simplify things.
1339
1340
1341
1342
1343 =head2 new(option => 'value')
1344
1345 The C<new()> function takes a list of options and values, and returns
1346 a new B<SQL::Abstract> object which can then be used to generate SQL
1347 through the methods below. The options accepted are:
1348
1349 =over
1350
1351 =item case
1352
1353 If set to 'lower', then SQL will be generated in all lowercase. By
1354 default SQL is generated in "textbook" case meaning something like:
1355
1356     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1357
1358 Any setting other than 'lower' is ignored.
1359
1360 =item cmp
1361
1362 This determines what the default comparison operator is. By default
1363 it is C<=>, meaning that a hash like this:
1364
1365     %where = (name => 'nwiger', email => 'nate@wiger.org');
1366
1367 Will generate SQL like this:
1368
1369     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1370
1371 However, you may want loose comparisons by default, so if you set
1372 C<cmp> to C<like> you would get SQL such as:
1373
1374     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1375
1376 You can also override the comparsion on an individual basis - see
1377 the huge section on L</"WHERE CLAUSES"> at the bottom.
1378
1379 =item sqltrue, sqlfalse
1380
1381 Expressions for inserting boolean values within SQL statements.
1382 By default these are C<1=1> and C<1=0>. They are used
1383 by the special operators C<-in> and C<-not_in> for generating
1384 correct SQL even when the argument is an empty array (see below).
1385
1386 =item logic
1387
1388 This determines the default logical operator for multiple WHERE
1389 statements in arrays or hashes. If absent, the default logic is "or"
1390 for arrays, and "and" for hashes. This means that a WHERE
1391 array of the form:
1392
1393     @where = (
1394         event_date => {'>=', '2/13/99'},
1395         event_date => {'<=', '4/24/03'},
1396     );
1397
1398 will generate SQL like this:
1399
1400     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1401
1402 This is probably not what you want given this query, though (look
1403 at the dates). To change the "OR" to an "AND", simply specify:
1404
1405     my $sql = SQL::Abstract->new(logic => 'and');
1406
1407 Which will change the above C<WHERE> to:
1408
1409     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1410
1411 The logic can also be changed locally by inserting
1412 a modifier in front of an arrayref :
1413
1414     @where = (-and => [event_date => {'>=', '2/13/99'},
1415                        event_date => {'<=', '4/24/03'} ]);
1416
1417 See the L</"WHERE CLAUSES"> section for explanations.
1418
1419 =item convert
1420
1421 This will automatically convert comparisons using the specified SQL
1422 function for both column and value. This is mostly used with an argument
1423 of C<upper> or C<lower>, so that the SQL will have the effect of
1424 case-insensitive "searches". For example, this:
1425
1426     $sql = SQL::Abstract->new(convert => 'upper');
1427     %where = (keywords => 'MaKe iT CAse inSeNSItive');
1428
1429 Will turn out the following SQL:
1430
1431     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1432
1433 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1434 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1435 not validate this option; it will just pass through what you specify verbatim).
1436
1437 =item bindtype
1438
1439 This is a kludge because many databases suck. For example, you can't
1440 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1441 Instead, you have to use C<bind_param()>:
1442
1443     $sth->bind_param(1, 'reg data');
1444     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1445
1446 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1447 which loses track of which field each slot refers to. Fear not.
1448
1449 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1450 Currently, you can specify either C<normal> (default) or C<columns>. If you
1451 specify C<columns>, you will get an array that looks like this:
1452
1453     my $sql = SQL::Abstract->new(bindtype => 'columns');
1454     my($stmt, @bind) = $sql->insert(...);
1455
1456     @bind = (
1457         [ 'column1', 'value1' ],
1458         [ 'column2', 'value2' ],
1459         [ 'column3', 'value3' ],
1460     );
1461
1462 You can then iterate through this manually, using DBI's C<bind_param()>.
1463
1464     $sth->prepare($stmt);
1465     my $i = 1;
1466     for (@bind) {
1467         my($col, $data) = @$_;
1468         if ($col eq 'details' || $col eq 'comments') {
1469             $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1470         } elsif ($col eq 'image') {
1471             $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1472         } else {
1473             $sth->bind_param($i, $data);
1474         }
1475         $i++;
1476     }
1477     $sth->execute;      # execute without @bind now
1478
1479 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1480 Basically, the advantage is still that you don't have to care which fields
1481 are or are not included. You could wrap that above C<for> loop in a simple
1482 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1483 get a layer of abstraction over manual SQL specification.
1484
1485 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1486 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1487 will expect the bind values in this format.
1488
1489 =item quote_char
1490
1491 This is the character that a table or column name will be quoted
1492 with.  By default this is an empty string, but you could set it to
1493 the character C<`>, to generate SQL like this:
1494
1495   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1496
1497 Alternatively, you can supply an array ref of two items, the first being the left
1498 hand quote character, and the second the right hand quote character. For
1499 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1500 that generates SQL like this:
1501
1502   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1503
1504 Quoting is useful if you have tables or columns names that are reserved
1505 words in your database's SQL dialect.
1506
1507 =item name_sep
1508
1509 This is the character that separates a table and column name.  It is
1510 necessary to specify this when the C<quote_char> option is selected,
1511 so that tables and column names can be individually quoted like this:
1512
1513   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1514
1515 =item injection_guard
1516
1517 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1518 column name specified in a query structure. This is a safety mechanism to avoid
1519 injection attacks when mishandling user input e.g.:
1520
1521   my %condition_as_column_value_pairs = get_values_from_user();
1522   $sqla->select( ... , \%condition_as_column_value_pairs );
1523
1524 If the expression matches an exception is thrown. Note that literal SQL
1525 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1526
1527 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1528
1529 =item array_datatypes
1530
1531 When this option is true, arrayrefs in INSERT or UPDATE are
1532 interpreted as array datatypes and are passed directly
1533 to the DBI layer.
1534 When this option is false, arrayrefs are interpreted
1535 as literal SQL, just like refs to arrayrefs
1536 (but this behavior is for backwards compatibility; when writing
1537 new queries, use the "reference to arrayref" syntax
1538 for literal SQL).
1539
1540
1541 =item special_ops
1542
1543 Takes a reference to a list of "special operators"
1544 to extend the syntax understood by L<SQL::Abstract>.
1545 See section L</"SPECIAL OPERATORS"> for details.
1546
1547 =item unary_ops
1548
1549 Takes a reference to a list of "unary operators"
1550 to extend the syntax understood by L<SQL::Abstract>.
1551 See section L</"UNARY OPERATORS"> for details.
1552
1553
1554
1555 =back
1556
1557 =head2 insert($table, \@values || \%fieldvals, \%options)
1558
1559 This is the simplest function. You simply give it a table name
1560 and either an arrayref of values or hashref of field/value pairs.
1561 It returns an SQL INSERT statement and a list of bind values.
1562 See the sections on L</"Inserting and Updating Arrays"> and
1563 L</"Inserting and Updating SQL"> for information on how to insert
1564 with those data types.
1565
1566 The optional C<\%options> hash reference may contain additional
1567 options to generate the insert SQL. Currently supported options
1568 are:
1569
1570 =over 4
1571
1572 =item returning
1573
1574 Takes either a scalar of raw SQL fields, or an array reference of
1575 field names, and adds on an SQL C<RETURNING> statement at the end.
1576 This allows you to return data generated by the insert statement
1577 (such as row IDs) without performing another C<SELECT> statement.
1578 Note, however, this is not part of the SQL standard and may not
1579 be supported by all database engines.
1580
1581 =back
1582
1583 =head2 update($table, \%fieldvals, \%where)
1584
1585 This takes a table, hashref of field/value pairs, and an optional
1586 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1587 of bind values.
1588 See the sections on L</"Inserting and Updating Arrays"> and
1589 L</"Inserting and Updating SQL"> for information on how to insert
1590 with those data types.
1591
1592 =head2 select($source, $fields, $where, $order)
1593
1594 This returns a SQL SELECT statement and associated list of bind values, as
1595 specified by the arguments  :
1596
1597 =over
1598
1599 =item $source
1600
1601 Specification of the 'FROM' part of the statement.
1602 The argument can be either a plain scalar (interpreted as a table
1603 name, will be quoted), or an arrayref (interpreted as a list
1604 of table names, joined by commas, quoted), or a scalarref
1605 (literal table name, not quoted), or a ref to an arrayref
1606 (list of literal table names, joined by commas, not quoted).
1607
1608 =item $fields
1609
1610 Specification of the list of fields to retrieve from
1611 the source.
1612 The argument can be either an arrayref (interpreted as a list
1613 of field names, will be joined by commas and quoted), or a
1614 plain scalar (literal SQL, not quoted).
1615 Please observe that this API is not as flexible as for
1616 the first argument C<$table>, for backwards compatibility reasons.
1617
1618 =item $where
1619
1620 Optional argument to specify the WHERE part of the query.
1621 The argument is most often a hashref, but can also be
1622 an arrayref or plain scalar --
1623 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1624
1625 =item $order
1626
1627 Optional argument to specify the ORDER BY part of the query.
1628 The argument can be a scalar, a hashref or an arrayref
1629 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1630 for details.
1631
1632 =back
1633
1634
1635 =head2 delete($table, \%where)
1636
1637 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1638 It returns an SQL DELETE statement and list of bind values.
1639
1640 =head2 where(\%where, \@order)
1641
1642 This is used to generate just the WHERE clause. For example,
1643 if you have an arbitrary data structure and know what the
1644 rest of your SQL is going to look like, but want an easy way
1645 to produce a WHERE clause, use this. It returns an SQL WHERE
1646 clause and list of bind values.
1647
1648
1649 =head2 values(\%data)
1650
1651 This just returns the values from the hash C<%data>, in the same
1652 order that would be returned from any of the other above queries.
1653 Using this allows you to markedly speed up your queries if you
1654 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1655
1656 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1657
1658 Warning: This is an experimental method and subject to change.
1659
1660 This returns arbitrarily generated SQL. It's a really basic shortcut.
1661 It will return two different things, depending on return context:
1662
1663     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1664     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1665
1666 These would return the following:
1667
1668     # First calling form
1669     $stmt = "CREATE TABLE test (?, ?)";
1670     @bind = (field1, field2);
1671
1672     # Second calling form
1673     $stmt_and_val = "CREATE TABLE test (field1, field2)";
1674
1675 Depending on what you're trying to do, it's up to you to choose the correct
1676 format. In this example, the second form is what you would want.
1677
1678 By the same token:
1679
1680     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1681
1682 Might give you:
1683
1684     ALTER SESSION SET nls_date_format = 'MM/YY'
1685
1686 You get the idea. Strings get their case twiddled, but everything
1687 else remains verbatim.
1688
1689 =head1 WHERE CLAUSES
1690
1691 =head2 Introduction
1692
1693 This module uses a variation on the idea from L<DBIx::Abstract>. It
1694 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1695 module is that things in arrays are OR'ed, and things in hashes
1696 are AND'ed.>
1697
1698 The easiest way to explain is to show lots of examples. After
1699 each C<%where> hash shown, it is assumed you used:
1700
1701     my($stmt, @bind) = $sql->where(\%where);
1702
1703 However, note that the C<%where> hash can be used directly in any
1704 of the other functions as well, as described above.
1705
1706 =head2 Key-value pairs
1707
1708 So, let's get started. To begin, a simple hash:
1709
1710     my %where  = (
1711         user   => 'nwiger',
1712         status => 'completed'
1713     );
1714
1715 Is converted to SQL C<key = val> statements:
1716
1717     $stmt = "WHERE user = ? AND status = ?";
1718     @bind = ('nwiger', 'completed');
1719
1720 One common thing I end up doing is having a list of values that
1721 a field can be in. To do this, simply specify a list inside of
1722 an arrayref:
1723
1724     my %where  = (
1725         user   => 'nwiger',
1726         status => ['assigned', 'in-progress', 'pending'];
1727     );
1728
1729 This simple code will create the following:
1730
1731     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1732     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1733
1734 A field associated to an empty arrayref will be considered a
1735 logical false and will generate 0=1.
1736
1737 =head2 Tests for NULL values
1738
1739 If the value part is C<undef> then this is converted to SQL <IS NULL>
1740
1741     my %where  = (
1742         user   => 'nwiger',
1743         status => undef,
1744     );
1745
1746 becomes:
1747
1748     $stmt = "WHERE user = ? AND status IS NULL";
1749     @bind = ('nwiger');
1750
1751 To test if a column IS NOT NULL:
1752
1753     my %where  = (
1754         user   => 'nwiger',
1755         status => { '!=', undef },
1756     );
1757
1758 =head2 Specific comparison operators
1759
1760 If you want to specify a different type of operator for your comparison,
1761 you can use a hashref for a given column:
1762
1763     my %where  = (
1764         user   => 'nwiger',
1765         status => { '!=', 'completed' }
1766     );
1767
1768 Which would generate:
1769
1770     $stmt = "WHERE user = ? AND status != ?";
1771     @bind = ('nwiger', 'completed');
1772
1773 To test against multiple values, just enclose the values in an arrayref:
1774
1775     status => { '=', ['assigned', 'in-progress', 'pending'] };
1776
1777 Which would give you:
1778
1779     "WHERE status = ? OR status = ? OR status = ?"
1780
1781
1782 The hashref can also contain multiple pairs, in which case it is expanded
1783 into an C<AND> of its elements:
1784
1785     my %where  = (
1786         user   => 'nwiger',
1787         status => { '!=', 'completed', -not_like => 'pending%' }
1788     );
1789
1790     # Or more dynamically, like from a form
1791     $where{user} = 'nwiger';
1792     $where{status}{'!='} = 'completed';
1793     $where{status}{'-not_like'} = 'pending%';
1794
1795     # Both generate this
1796     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1797     @bind = ('nwiger', 'completed', 'pending%');
1798
1799
1800 To get an OR instead, you can combine it with the arrayref idea:
1801
1802     my %where => (
1803          user => 'nwiger',
1804          priority => [ { '=', 2 }, { '>', 5 } ]
1805     );
1806
1807 Which would generate:
1808
1809     $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
1810     @bind = ('2', '5', 'nwiger');
1811
1812 If you want to include literal SQL (with or without bind values), just use a
1813 scalar reference or array reference as the value:
1814
1815     my %where  = (
1816         date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1817         date_expires => { '<' => \"now()" }
1818     );
1819
1820 Which would generate:
1821
1822     $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1823     @bind = ('11/26/2008');
1824
1825
1826 =head2 Logic and nesting operators
1827
1828 In the example above,
1829 there is a subtle trap if you want to say something like
1830 this (notice the C<AND>):
1831
1832     WHERE priority != ? AND priority != ?
1833
1834 Because, in Perl you I<can't> do this:
1835
1836     priority => { '!=', 2, '!=', 1 }
1837
1838 As the second C<!=> key will obliterate the first. The solution
1839 is to use the special C<-modifier> form inside an arrayref:
1840
1841     priority => [ -and => {'!=', 2},
1842                           {'!=', 1} ]
1843
1844
1845 Normally, these would be joined by C<OR>, but the modifier tells it
1846 to use C<AND> instead. (Hint: You can use this in conjunction with the
1847 C<logic> option to C<new()> in order to change the way your queries
1848 work by default.) B<Important:> Note that the C<-modifier> goes
1849 B<INSIDE> the arrayref, as an extra first element. This will
1850 B<NOT> do what you think it might:
1851
1852     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
1853
1854 Here is a quick list of equivalencies, since there is some overlap:
1855
1856     # Same
1857     status => {'!=', 'completed', 'not like', 'pending%' }
1858     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1859
1860     # Same
1861     status => {'=', ['assigned', 'in-progress']}
1862     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1863     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1864
1865
1866
1867 =head2 Special operators : IN, BETWEEN, etc.
1868
1869 You can also use the hashref format to compare a list of fields using the
1870 C<IN> comparison operator, by specifying the list as an arrayref:
1871
1872     my %where  = (
1873         status   => 'completed',
1874         reportid => { -in => [567, 2335, 2] }
1875     );
1876
1877 Which would generate:
1878
1879     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1880     @bind = ('completed', '567', '2335', '2');
1881
1882 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1883 the same way.
1884
1885 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
1886 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
1887 'sqltrue' (by default : C<1=1>).
1888
1889 In addition to the array you can supply a chunk of literal sql or
1890 literal sql with bind:
1891
1892     my %where = {
1893       customer => { -in => \[
1894         'SELECT cust_id FROM cust WHERE balance > ?',
1895         2000,
1896       ],
1897       status => { -in => \'SELECT status_codes FROM states' },
1898     };
1899
1900 would generate:
1901
1902     $stmt = "WHERE (
1903           customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
1904       AND status IN ( SELECT status_codes FROM states )
1905     )";
1906     @bind = ('2000');
1907
1908
1909
1910 Another pair of operators is C<-between> and C<-not_between>,
1911 used with an arrayref of two values:
1912
1913     my %where  = (
1914         user   => 'nwiger',
1915         completion_date => {
1916            -not_between => ['2002-10-01', '2003-02-06']
1917         }
1918     );
1919
1920 Would give you:
1921
1922     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1923
1924 Just like with C<-in> all plausible combinations of literal SQL
1925 are possible:
1926
1927     my %where = {
1928       start0 => { -between => [ 1, 2 ] },
1929       start1 => { -between => \["? AND ?", 1, 2] },
1930       start2 => { -between => \"lower(x) AND upper(y)" },
1931       start3 => { -between => [
1932         \"lower(x)",
1933         \["upper(?)", 'stuff' ],
1934       ] },
1935     };
1936
1937 Would give you:
1938
1939     $stmt = "WHERE (
1940           ( start0 BETWEEN ? AND ?                )
1941       AND ( start1 BETWEEN ? AND ?                )
1942       AND ( start2 BETWEEN lower(x) AND upper(y)  )
1943       AND ( start3 BETWEEN lower(x) AND upper(?)  )
1944     )";
1945     @bind = (1, 2, 1, 2, 'stuff');
1946
1947
1948 These are the two builtin "special operators"; but the
1949 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1950
1951 =head2 Unary operators: bool
1952
1953 If you wish to test against boolean columns or functions within your
1954 database you can use the C<-bool> and C<-not_bool> operators. For
1955 example to test the column C<is_user> being true and the column
1956 C<is_enabled> being false you would use:-
1957
1958     my %where  = (
1959         -bool       => 'is_user',
1960         -not_bool   => 'is_enabled',
1961     );
1962
1963 Would give you:
1964
1965     WHERE is_user AND NOT is_enabled
1966
1967 If a more complex combination is required, testing more conditions,
1968 then you should use the and/or operators:-
1969
1970     my %where  = (
1971         -and           => [
1972             -bool      => 'one',
1973             -bool      => 'two',
1974             -bool      => 'three',
1975             -not_bool  => 'four',
1976         ],
1977     );
1978
1979 Would give you:
1980
1981     WHERE one AND two AND three AND NOT four
1982
1983
1984 =head2 Nested conditions, -and/-or prefixes
1985
1986 So far, we've seen how multiple conditions are joined with a top-level
1987 C<AND>.  We can change this by putting the different conditions we want in
1988 hashes and then putting those hashes in an array. For example:
1989
1990     my @where = (
1991         {
1992             user   => 'nwiger',
1993             status => { -like => ['pending%', 'dispatched'] },
1994         },
1995         {
1996             user   => 'robot',
1997             status => 'unassigned',
1998         }
1999     );
2000
2001 This data structure would create the following:
2002
2003     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2004                 OR ( user = ? AND status = ? ) )";
2005     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2006
2007
2008 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2009 to change the logic inside :
2010
2011     my @where = (
2012          -and => [
2013             user => 'nwiger',
2014             [
2015                 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2016                 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2017             ],
2018         ],
2019     );
2020
2021 That would yield:
2022
2023     WHERE ( user = ? AND (
2024                ( workhrs > ? AND geo = ? )
2025             OR ( workhrs < ? OR geo = ? )
2026           ) )
2027
2028 =head3 Algebraic inconsistency, for historical reasons
2029
2030 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2031 operator goes C<outside> of the nested structure; whereas when connecting
2032 several constraints on one column, the C<-and> operator goes
2033 C<inside> the arrayref. Here is an example combining both features :
2034
2035    my @where = (
2036      -and => [a => 1, b => 2],
2037      -or  => [c => 3, d => 4],
2038       e   => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2039    )
2040
2041 yielding
2042
2043   WHERE ( (    ( a = ? AND b = ? )
2044             OR ( c = ? OR d = ? )
2045             OR ( e LIKE ? AND e LIKE ? ) ) )
2046
2047 This difference in syntax is unfortunate but must be preserved for
2048 historical reasons. So be careful : the two examples below would
2049 seem algebraically equivalent, but they are not
2050
2051   {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2052   # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2053
2054   [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2055   # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2056
2057
2058 =head2 Literal SQL and value type operators
2059
2060 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2061 side" is a column name and the "right side" is a value (normally rendered as
2062 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2063 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2064 alter this behavior. There are several ways of doing so.
2065
2066 =head3 -ident
2067
2068 This is a virtual operator that signals the string to its right side is an
2069 identifier (a column name) and not a value. For example to compare two
2070 columns you would write:
2071
2072     my %where = (
2073         priority => { '<', 2 },
2074         requestor => { -ident => 'submitter' },
2075     );
2076
2077 which creates:
2078
2079     $stmt = "WHERE priority < ? AND requestor = submitter";
2080     @bind = ('2');
2081
2082 If you are maintaining legacy code you may see a different construct as
2083 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
2084 code.
2085
2086 =head3 -value
2087
2088 This is a virtual operator that signals that the construct to its right side
2089 is a value to be passed to DBI. This is for example necessary when you want
2090 to write a where clause against an array (for RDBMS that support such
2091 datatypes). For example:
2092
2093     my %where = (
2094         array => { -value => [1, 2, 3] }
2095     );
2096
2097 will result in:
2098
2099     $stmt = 'WHERE array = ?';
2100     @bind = ([1, 2, 3]);
2101
2102 Note that if you were to simply say:
2103
2104     my %where = (
2105         array => [1, 2, 3]
2106     );
2107
2108 the result would porbably be not what you wanted:
2109
2110     $stmt = 'WHERE array = ? OR array = ? OR array = ?';
2111     @bind = (1, 2, 3);
2112
2113 =head3 Literal SQL
2114
2115 Finally, sometimes only literal SQL will do. To include a random snippet
2116 of SQL verbatim, you specify it as a scalar reference. Consider this only
2117 as a last resort. Usually there is a better way. For example:
2118
2119     my %where = (
2120         priority => { '<', 2 },
2121         requestor => { -in => \'(SELECT name FROM hitmen)' },
2122     );
2123
2124 Would create:
2125
2126     $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
2127     @bind = (2);
2128
2129 Note that in this example, you only get one bind parameter back, since
2130 the verbatim SQL is passed as part of the statement.
2131
2132 =head4 CAVEAT
2133
2134   Never use untrusted input as a literal SQL argument - this is a massive
2135   security risk (there is no way to check literal snippets for SQL
2136   injections and other nastyness). If you need to deal with untrusted input
2137   use literal SQL with placeholders as described next.
2138
2139 =head3 Literal SQL with placeholders and bind values (subqueries)
2140
2141 If the literal SQL to be inserted has placeholders and bind values,
2142 use a reference to an arrayref (yes this is a double reference --
2143 not so common, but perfectly legal Perl). For example, to find a date
2144 in Postgres you can use something like this:
2145
2146     my %where = (
2147        date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2148     )
2149
2150 This would create:
2151
2152     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2153     @bind = ('10');
2154
2155 Note that you must pass the bind values in the same format as they are returned
2156 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2157 provide the bind values in the C<< [ column_meta => value ] >> format, where
2158 C<column_meta> is an opaque scalar value; most commonly the column name, but
2159 you can use any scalar value (including references and blessed references),
2160 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2161 to C<columns> the above example will look like:
2162
2163     my %where = (
2164        date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2165     )
2166
2167 Literal SQL is especially useful for nesting parenthesized clauses in the
2168 main SQL query. Here is a first example :
2169
2170   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2171                                100, "foo%");
2172   my %where = (
2173     foo => 1234,
2174     bar => \["IN ($sub_stmt)" => @sub_bind],
2175   );
2176
2177 This yields :
2178
2179   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2180                                              WHERE c2 < ? AND c3 LIKE ?))";
2181   @bind = (1234, 100, "foo%");
2182
2183 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2184 are expressed in the same way. Of course the C<$sub_stmt> and
2185 its associated bind values can be generated through a former call
2186 to C<select()> :
2187
2188   my ($sub_stmt, @sub_bind)
2189      = $sql->select("t1", "c1", {c2 => {"<" => 100},
2190                                  c3 => {-like => "foo%"}});
2191   my %where = (
2192     foo => 1234,
2193     bar => \["> ALL ($sub_stmt)" => @sub_bind],
2194   );
2195
2196 In the examples above, the subquery was used as an operator on a column;
2197 but the same principle also applies for a clause within the main C<%where>
2198 hash, like an EXISTS subquery :
2199
2200   my ($sub_stmt, @sub_bind)
2201      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2202   my %where = ( -and => [
2203     foo   => 1234,
2204     \["EXISTS ($sub_stmt)" => @sub_bind],
2205   ]);
2206
2207 which yields
2208
2209   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2210                                         WHERE c1 = ? AND c2 > t0.c0))";
2211   @bind = (1234, 1);
2212
2213
2214 Observe that the condition on C<c2> in the subquery refers to
2215 column C<t0.c0> of the main query : this is I<not> a bind
2216 value, so we have to express it through a scalar ref.
2217 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2218 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2219 what we wanted here.
2220
2221 Finally, here is an example where a subquery is used
2222 for expressing unary negation:
2223
2224   my ($sub_stmt, @sub_bind)
2225      = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2226   $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2227   my %where = (
2228         lname  => {like => '%son%'},
2229         \["NOT ($sub_stmt)" => @sub_bind],
2230     );
2231
2232 This yields
2233
2234   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2235   @bind = ('%son%', 10, 20)
2236
2237 =head3 Deprecated usage of Literal SQL
2238
2239 Below are some examples of archaic use of literal SQL. It is shown only as
2240 reference for those who deal with legacy code. Each example has a much
2241 better, cleaner and safer alternative that users should opt for in new code.
2242
2243 =over
2244
2245 =item *
2246
2247     my %where = ( requestor => \'IS NOT NULL' )
2248
2249     $stmt = "WHERE requestor IS NOT NULL"
2250
2251 This used to be the way of generating NULL comparisons, before the handling
2252 of C<undef> got formalized. For new code please use the superior syntax as
2253 described in L</Tests for NULL values>.
2254
2255 =item *
2256
2257     my %where = ( requestor => \'= submitter' )
2258
2259     $stmt = "WHERE requestor = submitter"
2260
2261 This used to be the only way to compare columns. Use the superior L</-ident>
2262 method for all new code. For example an identifier declared in such a way
2263 will be properly quoted if L</quote_char> is properly set, while the legacy
2264 form will remain as supplied.
2265
2266 =item *
2267
2268     my %where = ( is_ready  => \"", completed => { '>', '2012-12-21' } )
2269
2270     $stmt = "WHERE completed > ? AND is_ready"
2271     @bind = ('2012-12-21')
2272
2273 Using an empty string literal used to be the only way to express a boolean.
2274 For all new code please use the much more readable
2275 L<-bool|/Unary operators: bool> operator.
2276
2277 =back
2278
2279 =head2 Conclusion
2280
2281 These pages could go on for a while, since the nesting of the data
2282 structures this module can handle are pretty much unlimited (the
2283 module implements the C<WHERE> expansion as a recursive function
2284 internally). Your best bet is to "play around" with the module a
2285 little to see how the data structures behave, and choose the best
2286 format for your data based on that.
2287
2288 And of course, all the values above will probably be replaced with
2289 variables gotten from forms or the command line. After all, if you
2290 knew everything ahead of time, you wouldn't have to worry about
2291 dynamically-generating SQL and could just hardwire it into your
2292 script.
2293
2294 =head1 ORDER BY CLAUSES
2295
2296 Some functions take an order by clause. This can either be a scalar (just a
2297 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2298 or an array of either of the two previous forms. Examples:
2299
2300                Given            |         Will Generate
2301     ----------------------------------------------------------
2302                                 |
2303     \'colA DESC'                | ORDER BY colA DESC
2304                                 |
2305     'colA'                      | ORDER BY colA
2306                                 |
2307     [qw/colA colB/]             | ORDER BY colA, colB
2308                                 |
2309     {-asc  => 'colA'}           | ORDER BY colA ASC
2310                                 |
2311     {-desc => 'colB'}           | ORDER BY colB DESC
2312                                 |
2313     ['colA', {-asc => 'colB'}]  | ORDER BY colA, colB ASC
2314                                 |
2315     { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2316                                 |
2317     [                           |
2318       { -asc => 'colA' },       | ORDER BY colA ASC, colB DESC,
2319       { -desc => [qw/colB/],    |          colC ASC, colD ASC
2320       { -asc => [qw/colC colD/],|
2321     ]                           |
2322     ===========================================================
2323
2324
2325
2326 =head1 SPECIAL OPERATORS
2327
2328   my $sqlmaker = SQL::Abstract->new(special_ops => [
2329      {
2330       regex => qr/.../,
2331       handler => sub {
2332         my ($self, $field, $op, $arg) = @_;
2333         ...
2334       },
2335      },
2336      {
2337       regex => qr/.../,
2338       handler => 'method_name',
2339      },
2340    ]);
2341
2342 A "special operator" is a SQL syntactic clause that can be
2343 applied to a field, instead of a usual binary operator.
2344 For example :
2345
2346    WHERE field IN (?, ?, ?)
2347    WHERE field BETWEEN ? AND ?
2348    WHERE MATCH(field) AGAINST (?, ?)
2349
2350 Special operators IN and BETWEEN are fairly standard and therefore
2351 are builtin within C<SQL::Abstract> (as the overridable methods
2352 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2353 like the MATCH .. AGAINST example above which is specific to MySQL,
2354 you can write your own operator handlers - supply a C<special_ops>
2355 argument to the C<new> method. That argument takes an arrayref of
2356 operator definitions; each operator definition is a hashref with two
2357 entries:
2358
2359 =over
2360
2361 =item regex
2362
2363 the regular expression to match the operator
2364
2365 =item handler
2366
2367 Either a coderef or a plain scalar method name. In both cases
2368 the expected return is C<< ($sql, @bind) >>.
2369
2370 When supplied with a method name, it is simply called on the
2371 L<SQL::Abstract/> object as:
2372
2373  $self->$method_name ($field, $op, $arg)
2374
2375  Where:
2376
2377   $op is the part that matched the handler regex
2378   $field is the LHS of the operator
2379   $arg is the RHS
2380
2381 When supplied with a coderef, it is called as:
2382
2383  $coderef->($self, $field, $op, $arg)
2384
2385
2386 =back
2387
2388 For example, here is an implementation
2389 of the MATCH .. AGAINST syntax for MySQL
2390
2391   my $sqlmaker = SQL::Abstract->new(special_ops => [
2392
2393     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2394     {regex => qr/^match$/i,
2395      handler => sub {
2396        my ($self, $field, $op, $arg) = @_;
2397        $arg = [$arg] if not ref $arg;
2398        my $label         = $self->_quote($field);
2399        my ($placeholder) = $self->_convert('?');
2400        my $placeholders  = join ", ", (($placeholder) x @$arg);
2401        my $sql           = $self->_sqlcase('match') . " ($label) "
2402                          . $self->_sqlcase('against') . " ($placeholders) ";
2403        my @bind = $self->_bindtype($field, @$arg);
2404        return ($sql, @bind);
2405        }
2406      },
2407
2408   ]);
2409
2410
2411 =head1 UNARY OPERATORS
2412
2413   my $sqlmaker = SQL::Abstract->new(unary_ops => [
2414      {
2415       regex => qr/.../,
2416       handler => sub {
2417         my ($self, $op, $arg) = @_;
2418         ...
2419       },
2420      },
2421      {
2422       regex => qr/.../,
2423       handler => 'method_name',
2424      },
2425    ]);
2426
2427 A "unary operator" is a SQL syntactic clause that can be
2428 applied to a field - the operator goes before the field
2429
2430 You can write your own operator handlers - supply a C<unary_ops>
2431 argument to the C<new> method. That argument takes an arrayref of
2432 operator definitions; each operator definition is a hashref with two
2433 entries:
2434
2435 =over
2436
2437 =item regex
2438
2439 the regular expression to match the operator
2440
2441 =item handler
2442
2443 Either a coderef or a plain scalar method name. In both cases
2444 the expected return is C<< $sql >>.
2445
2446 When supplied with a method name, it is simply called on the
2447 L<SQL::Abstract/> object as:
2448
2449  $self->$method_name ($op, $arg)
2450
2451  Where:
2452
2453   $op is the part that matched the handler regex
2454   $arg is the RHS or argument of the operator
2455
2456 When supplied with a coderef, it is called as:
2457
2458  $coderef->($self, $op, $arg)
2459
2460
2461 =back
2462
2463
2464 =head1 PERFORMANCE
2465
2466 Thanks to some benchmarking by Mark Stosberg, it turns out that
2467 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2468 I must admit this wasn't an intentional design issue, but it's a
2469 byproduct of the fact that you get to control your C<DBI> handles
2470 yourself.
2471
2472 To maximize performance, use a code snippet like the following:
2473
2474     # prepare a statement handle using the first row
2475     # and then reuse it for the rest of the rows
2476     my($sth, $stmt);
2477     for my $href (@array_of_hashrefs) {
2478         $stmt ||= $sql->insert('table', $href);
2479         $sth  ||= $dbh->prepare($stmt);
2480         $sth->execute($sql->values($href));
2481     }
2482
2483 The reason this works is because the keys in your C<$href> are sorted
2484 internally by B<SQL::Abstract>. Thus, as long as your data retains
2485 the same structure, you only have to generate the SQL the first time
2486 around. On subsequent queries, simply use the C<values> function provided
2487 by this module to return your values in the correct order.
2488
2489 However this depends on the values having the same type - if, for
2490 example, the values of a where clause may either have values
2491 (resulting in sql of the form C<column = ?> with a single bind
2492 value), or alternatively the values might be C<undef> (resulting in
2493 sql of the form C<column IS NULL> with no bind value) then the
2494 caching technique suggested will not work.
2495
2496 =head1 FORMBUILDER
2497
2498 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2499 really like this part (I do, at least). Building up a complex query
2500 can be as simple as the following:
2501
2502     #!/usr/bin/perl
2503
2504     use CGI::FormBuilder;
2505     use SQL::Abstract;
2506
2507     my $form = CGI::FormBuilder->new(...);
2508     my $sql  = SQL::Abstract->new;
2509
2510     if ($form->submitted) {
2511         my $field = $form->field;
2512         my $id = delete $field->{id};
2513         my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2514     }
2515
2516 Of course, you would still have to connect using C<DBI> to run the
2517 query, but the point is that if you make your form look like your
2518 table, the actual query script can be extremely simplistic.
2519
2520 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2521 a fast interface to returning and formatting data. I frequently
2522 use these three modules together to write complex database query
2523 apps in under 50 lines.
2524
2525 =head1 REPO
2526
2527 =over
2528
2529 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
2530
2531 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
2532
2533 =back
2534
2535 =head1 CHANGES
2536
2537 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2538 Great care has been taken to preserve the I<published> behavior
2539 documented in previous versions in the 1.* family; however,
2540 some features that were previously undocumented, or behaved
2541 differently from the documentation, had to be changed in order
2542 to clarify the semantics. Hence, client code that was relying
2543 on some dark areas of C<SQL::Abstract> v1.*
2544 B<might behave differently> in v1.50.
2545
2546 The main changes are :
2547
2548 =over
2549
2550 =item *
2551
2552 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2553
2554 =item *
2555
2556 support for the { operator => \"..." } construct (to embed literal SQL)
2557
2558 =item *
2559
2560 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2561
2562 =item *
2563
2564 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2565
2566 =item *
2567
2568 defensive programming : check arguments
2569
2570 =item *
2571
2572 fixed bug with global logic, which was previously implemented
2573 through global variables yielding side-effects. Prior versions would
2574 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2575 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2576 Now this is interpreted
2577 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2578
2579
2580 =item *
2581
2582 fixed semantics of  _bindtype on array args
2583
2584 =item *
2585
2586 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2587 we just avoid shifting arrays within that tree.
2588
2589 =item *
2590
2591 dropped the C<_modlogic> function
2592
2593 =back
2594
2595 =head1 ACKNOWLEDGEMENTS
2596
2597 There are a number of individuals that have really helped out with
2598 this module. Unfortunately, most of them submitted bugs via CPAN
2599 so I have no idea who they are! But the people I do know are:
2600
2601     Ash Berlin (order_by hash term support)
2602     Matt Trout (DBIx::Class support)
2603     Mark Stosberg (benchmarking)
2604     Chas Owens (initial "IN" operator support)
2605     Philip Collins (per-field SQL functions)
2606     Eric Kolve (hashref "AND" support)
2607     Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2608     Dan Kubb (support for "quote_char" and "name_sep")
2609     Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2610     Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2611     Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2612     Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2613     Oliver Charles (support for "RETURNING" after "INSERT")
2614
2615 Thanks!
2616
2617 =head1 SEE ALSO
2618
2619 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2620
2621 =head1 AUTHOR
2622
2623 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2624
2625 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2626
2627 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2628 While not an official support venue, C<DBIx::Class> makes heavy use of
2629 C<SQL::Abstract>, and as such list members there are very familiar with
2630 how to create queries.
2631
2632 =head1 LICENSE
2633
2634 This module is free software; you may copy this under the same
2635 terms as perl itself (either the GNU General Public License or
2636 the Artistic License)
2637
2638 =cut
2639