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