lib/SQL/Abstract.pm

   1 package SQL::Abstract; # see doc at end of file
   2
   3 use strict;
   4 use warnings;
   5 use Carp ();
   6 use List::Util ();
   7 use Scalar::Util ();
   8
   9 use Exporter 'import';
  10 our @EXPORT_OK = qw(is_plain_value is_literal_value);
  11
  12 BEGIN {
  13   if ($] < 5.009_005) {
  14     require MRO::Compat;
  15   }
  16   else {
  17     require mro;
  18   }
  19
  20   *SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}
  21     ? sub () { 0 }
  22     : sub () { 1 }
  23   ;
  24 }
  25
  26 #======================================================================
  27 # GLOBALS
  28 #======================================================================
  29
  30 our $VERSION  = '1.86';
  31
  32 # This would confuse some packagers
  33 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
  34
  35 our $AUTOLOAD;
  36
  37 # special operators (-in, -between). May be extended/overridden by user.
  38 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
  39 my @BUILTIN_SPECIAL_OPS = (
  40   {regex => qr/^ (?: not \s )? between $/ix, handler => sub { die "NOPE" }},
  41   {regex => qr/^ (?: not \s )? in      $/ix, handler => sub { die "NOPE" }},
  42   {regex => qr/^ ident                 $/ix, handler => sub { die "NOPE" }},
  43   {regex => qr/^ value                 $/ix, handler => '_where_op_VALUE'},
  44   {regex => qr/^ is (?: \s+ not )?     $/ix, handler => '_where_field_IS'},
  45 );
  46
  47 # unaryish operators - key maps to handler
  48 my @BUILTIN_UNARY_OPS = (
  49   # the digits are backcompat stuff
  50   { regex => qr/^ and  (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
  51   { regex => qr/^ or   (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
  52   { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
  53   { regex => qr/^ (?: not \s )? bool     $/xi, handler => '_where_op_BOOL' },
  54   { regex => qr/^ ident                  $/xi, handler => '_where_op_IDENT' },
  55   { regex => qr/^ value                  $/xi, handler => '_where_op_VALUE' },
  56   { regex => qr/^ op                     $/xi, handler => '_where_op_OP' },
  57   { regex => qr/^ bind                   $/xi, handler => '_where_op_BIND' },
  58   { regex => qr/^ literal                $/xi, handler => '_where_op_LITERAL' },
  59 );
  60
  61 #======================================================================
  62 # DEBUGGING AND ERROR REPORTING
  63 #======================================================================
  64
  65 sub _debug {
  66   return unless $_[0]->{debug}; shift; # a little faster
  67   my $func = (caller(1))[3];
  68   warn "[$func] ", @_, "\n";
  69 }
  70
  71 sub belch (@) {
  72   my($func) = (caller(1))[3];
  73   Carp::carp "[$func] Warning: ", @_;
  74 }
  75
  76 sub puke (@) {
  77   my($func) = (caller(1))[3];
  78   Carp::croak "[$func] Fatal: ", @_;
  79 }
  80
  81 sub is_literal_value ($) {
  82     ref $_[0] eq 'SCALAR'                                     ? [ ${$_[0]} ]
  83   : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' )        ? [ @${ $_[0] } ]
  84   : undef;
  85 }
  86
  87 # FIXME XSify - this can be done so much more efficiently
  88 sub is_plain_value ($) {
  89   no strict 'refs';
  90     ! length ref $_[0]                                        ? \($_[0])
  91   : (
  92     ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
  93       and
  94     exists $_[0]->{-value}
  95   )                                                           ? \($_[0]->{-value})
  96   : (
  97       # reuse @_ for even moar speedz
  98       defined ( $_[1] = Scalar::Util::blessed $_[0] )
  99         and
 100       # deliberately not using Devel::OverloadInfo - the checks we are
 101       # intersted in are much more limited than the fullblown thing, and
 102       # this is a very hot piece of code
 103       (
 104         # simply using ->can('(""') can leave behind stub methods that
 105         # break actually using the overload later (see L<perldiag/Stub
 106         # found while resolving method "%s" overloading "%s" in package
 107         # "%s"> and the source of overload::mycan())
 108         #
 109         # either has stringification which DBI SHOULD prefer out of the box
 110         grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
 111           or
 112         # has nummification or boolification, AND fallback is *not* disabled
 113         (
 114           SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
 115             and
 116           (
 117             grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
 118               or
 119             grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
 120           )
 121             and
 122           (
 123             # no fallback specified at all
 124             ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
 125               or
 126             # fallback explicitly undef
 127             ! defined ${"$_[3]::()"}
 128               or
 129             # explicitly true
 130             !! ${"$_[3]::()"}
 131           )
 132         )
 133       )
 134     )                                                          ? \($_[0])
 135   : undef;
 136 }
 137
 138
 139
 140 #======================================================================
 141 # NEW
 142 #======================================================================
 143
 144 sub new {
 145   my $self = shift;
 146   my $class = ref($self) || $self;
 147   my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
 148
 149   # choose our case by keeping an option around
 150   delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
 151
 152   # default logic for interpreting arrayrefs
 153   $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
 154
 155   # how to return bind vars
 156   $opt{bindtype} ||= 'normal';
 157
 158   # default comparison is "=", but can be overridden
 159   $opt{cmp} ||= '=';
 160
 161   # try to recognize which are the 'equality' and 'inequality' ops
 162   # (temporary quickfix (in 2007), should go through a more seasoned API)
 163   $opt{equality_op}   = qr/^( \Q$opt{cmp}\E | \= )$/ix;
 164   $opt{inequality_op} = qr/^( != | <> )$/ix;
 165
 166   $opt{like_op}       = qr/^ (is\s+)? r?like $/xi;
 167   $opt{not_like_op}   = qr/^ (is\s+)? not \s+ r?like $/xi;
 168
 169   # SQL booleans
 170   $opt{sqltrue}  ||= '1=1';
 171   $opt{sqlfalse} ||= '0=1';
 172
 173   # special operators
 174   $opt{special_ops} ||= [];
 175   # regexes are applied in order, thus push after user-defines
 176   push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
 177
 178   # unary operators
 179   $opt{unary_ops} ||= [];
 180   push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
 181
 182   # rudimentary sanity-check for user supplied bits treated as functions/operators
 183   # If a purported  function matches this regular expression, an exception is thrown.
 184   # Literal SQL is *NOT* subject to this check, only functions (and column names
 185   # when quoting is not in effect)
 186
 187   # FIXME
 188   # need to guard against ()'s in column names too, but this will break tons of
 189   # hacks... ideas anyone?
 190   $opt{injection_guard} ||= qr/
 191     \;
 192       |
 193     ^ \s* go \s
 194   /xmi;
 195
 196   return bless \%opt, $class;
 197 }
 198
 199
 200 sub _assert_pass_injection_guard {
 201   if ($_[1] =~ $_[0]->{injection_guard}) {
 202     my $class = ref $_[0];
 203     puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
 204      . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
 205      . "{injection_guard} attribute to ${class}->new()"
 206   }
 207 }
 208
 209
 210 #======================================================================
 211 # INSERT methods
 212 #======================================================================
 213
 214 sub insert {
 215   my $self    = shift;
 216   my $table   = $self->_table(shift);
 217   my $data    = shift || return;
 218   my $options = shift;
 219
 220   my $method       = $self->_METHOD_FOR_refkind("_insert", $data);
 221   my ($sql, @bind) = $self->$method($data);
 222   $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
 223
 224   if ($options->{returning}) {
 225     my ($s, @b) = $self->_insert_returning($options);
 226     $sql .= $s;
 227     push @bind, @b;
 228   }
 229
 230   return wantarray ? ($sql, @bind) : $sql;
 231 }
 232
 233 # So that subclasses can override INSERT ... RETURNING separately from
 234 # UPDATE and DELETE (e.g. DBIx::Class::SQLMaker::Oracle does this)
 235 sub _insert_returning { shift->_returning(@_) }
 236
 237 sub _returning {
 238   my ($self, $options) = @_;
 239
 240   my $f = $options->{returning};
 241
 242   my $fieldlist = $self->_SWITCH_refkind($f, {
 243     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$f;},
 244     SCALAR       => sub {$self->_quote($f)},
 245     SCALARREF    => sub {$$f},
 246   });
 247   return $self->_sqlcase(' returning ') . $fieldlist;
 248 }
 249
 250 sub _insert_HASHREF { # explicit list of fields and then values
 251   my ($self, $data) = @_;
 252
 253   my @fields = sort keys %$data;
 254
 255   my ($sql, @bind) = $self->_insert_values($data);
 256
 257   # assemble SQL
 258   $_ = $self->_quote($_) foreach @fields;
 259   $sql = "( ".join(", ", @fields).") ".$sql;
 260
 261   return ($sql, @bind);
 262 }
 263
 264 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
 265   my ($self, $data) = @_;
 266
 267   # no names (arrayref) so can't generate bindtype
 268   $self->{bindtype} ne 'columns'
 269     or belch "can't do 'columns' bindtype when called with arrayref";
 270
 271   my (@values, @all_bind);
 272   foreach my $value (@$data) {
 273     my ($values, @bind) = $self->_insert_value(undef, $value);
 274     push @values, $values;
 275     push @all_bind, @bind;
 276   }
 277   my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
 278   return ($sql, @all_bind);
 279 }
 280
 281 sub _insert_ARRAYREFREF { # literal SQL with bind
 282   my ($self, $data) = @_;
 283
 284   my ($sql, @bind) = @${$data};
 285   $self->_assert_bindval_matches_bindtype(@bind);
 286
 287   return ($sql, @bind);
 288 }
 289
 290
 291 sub _insert_SCALARREF { # literal SQL without bind
 292   my ($self, $data) = @_;
 293
 294   return ($$data);
 295 }
 296
 297 sub _insert_values {
 298   my ($self, $data) = @_;
 299
 300   my (@values, @all_bind);
 301   foreach my $column (sort keys %$data) {
 302     my ($values, @bind) = $self->_insert_value($column, $data->{$column});
 303     push @values, $values;
 304     push @all_bind, @bind;
 305   }
 306   my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
 307   return ($sql, @all_bind);
 308 }
 309
 310 sub _insert_value {
 311   my ($self, $column, $v) = @_;
 312
 313   my (@values, @all_bind);
 314   $self->_SWITCH_refkind($v, {
 315
 316     ARRAYREF => sub {
 317       if ($self->{array_datatypes}) { # if array datatype are activated
 318         push @values, '?';
 319         push @all_bind, $self->_bindtype($column, $v);
 320       }
 321       else {                  # else literal SQL with bind
 322         my ($sql, @bind) = @$v;
 323         $self->_assert_bindval_matches_bindtype(@bind);
 324         push @values, $sql;
 325         push @all_bind, @bind;
 326       }
 327     },
 328
 329     ARRAYREFREF => sub {        # literal SQL with bind
 330       my ($sql, @bind) = @${$v};
 331       $self->_assert_bindval_matches_bindtype(@bind);
 332       push @values, $sql;
 333       push @all_bind, @bind;
 334     },
 335
 336     # THINK: anything useful to do with a HASHREF ?
 337     HASHREF => sub {       # (nothing, but old SQLA passed it through)
 338       #TODO in SQLA >= 2.0 it will die instead
 339       belch "HASH ref as bind value in insert is not supported";
 340       push @values, '?';
 341       push @all_bind, $self->_bindtype($column, $v);
 342     },
 343
 344     SCALARREF => sub {          # literal SQL without bind
 345       push @values, $$v;
 346     },
 347
 348     SCALAR_or_UNDEF => sub {
 349       push @values, '?';
 350       push @all_bind, $self->_bindtype($column, $v);
 351     },
 352
 353   });
 354
 355   my $sql = join(", ", @values);
 356   return ($sql, @all_bind);
 357 }
 358
 359
 360
 361 #======================================================================
 362 # UPDATE methods
 363 #======================================================================
 364
 365
 366 sub update {
 367   my $self    = shift;
 368   my $table   = $self->_table(shift);
 369   my $data    = shift || return;
 370   my $where   = shift;
 371   my $options = shift;
 372
 373   # first build the 'SET' part of the sql statement
 374   puke "Unsupported data type specified to \$sql->update"
 375     unless ref $data eq 'HASH';
 376
 377   my ($sql, @all_bind) = $self->_update_set_values($data);
 378   $sql = $self->_sqlcase('update ') . $table . $self->_sqlcase(' set ')
 379           . $sql;
 380
 381   if ($where) {
 382     my($where_sql, @where_bind) = $self->where($where);
 383     $sql .= $where_sql;
 384     push @all_bind, @where_bind;
 385   }
 386
 387   if ($options->{returning}) {
 388     my ($returning_sql, @returning_bind) = $self->_update_returning($options);
 389     $sql .= $returning_sql;
 390     push @all_bind, @returning_bind;
 391   }
 392
 393   return wantarray ? ($sql, @all_bind) : $sql;
 394 }
 395
 396 sub _update_set_values {
 397   my ($self, $data) = @_;
 398
 399   my (@set, @all_bind);
 400   for my $k (sort keys %$data) {
 401     my $v = $data->{$k};
 402     my $r = ref $v;
 403     my $label = $self->_quote($k);
 404
 405     $self->_SWITCH_refkind($v, {
 406       ARRAYREF => sub {
 407         if ($self->{array_datatypes}) { # array datatype
 408           push @set, "$label = ?";
 409           push @all_bind, $self->_bindtype($k, $v);
 410         }
 411         else {                          # literal SQL with bind
 412           my ($sql, @bind) = @$v;
 413           $self->_assert_bindval_matches_bindtype(@bind);
 414           push @set, "$label = $sql";
 415           push @all_bind, @bind;
 416         }
 417       },
 418       ARRAYREFREF => sub { # literal SQL with bind
 419         my ($sql, @bind) = @${$v};
 420         $self->_assert_bindval_matches_bindtype(@bind);
 421         push @set, "$label = $sql";
 422         push @all_bind, @bind;
 423       },
 424       SCALARREF => sub {  # literal SQL without bind
 425         push @set, "$label = $$v";
 426       },
 427       HASHREF => sub {
 428         my ($op, $arg, @rest) = %$v;
 429
 430         puke 'Operator calls in update must be in the form { -op => $arg }'
 431           if (@rest or not $op =~ /^\-(.+)/);
 432
 433         local $self->{_nested_func_lhs} = $k;
 434         my ($sql, @bind) = $self->_where_unary_op($1, $arg);
 435
 436         push @set, "$label = $sql";
 437         push @all_bind, @bind;
 438       },
 439       SCALAR_or_UNDEF => sub {
 440         push @set, "$label = ?";
 441         push @all_bind, $self->_bindtype($k, $v);
 442       },
 443     });
 444   }
 445
 446   # generate sql
 447   my $sql = join ', ', @set;
 448
 449   return ($sql, @all_bind);
 450 }
 451
 452 # So that subclasses can override UPDATE ... RETURNING separately from
 453 # INSERT and DELETE
 454 sub _update_returning { shift->_returning(@_) }
 455
 456
 457
 458 #======================================================================
 459 # SELECT
 460 #======================================================================
 461
 462
 463 sub select {
 464   my $self   = shift;
 465   my $table  = $self->_table(shift);
 466   my $fields = shift || '*';
 467   my $where  = shift;
 468   my $order  = shift;
 469
 470   my ($fields_sql, @bind) = $self->_select_fields($fields);
 471
 472   my ($where_sql, @where_bind) = $self->where($where, $order);
 473   push @bind, @where_bind;
 474
 475   my $sql = join(' ', $self->_sqlcase('select'), $fields_sql,
 476                       $self->_sqlcase('from'),   $table)
 477           . $where_sql;
 478
 479   return wantarray ? ($sql, @bind) : $sql;
 480 }
 481
 482 sub _select_fields {
 483   my ($self, $fields) = @_;
 484   return ref $fields eq 'ARRAY' ? join ', ', map { $self->_quote($_) } @$fields
 485                                 : $fields;
 486 }
 487
 488 #======================================================================
 489 # DELETE
 490 #======================================================================
 491
 492
 493 sub delete {
 494   my $self    = shift;
 495   my $table   = $self->_table(shift);
 496   my $where   = shift;
 497   my $options = shift;
 498
 499   my($where_sql, @bind) = $self->where($where);
 500   my $sql = $self->_sqlcase('delete from ') . $table . $where_sql;
 501
 502   if ($options->{returning}) {
 503     my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
 504     $sql .= $returning_sql;
 505     push @bind, @returning_bind;
 506   }
 507
 508   return wantarray ? ($sql, @bind) : $sql;
 509 }
 510
 511 # So that subclasses can override DELETE ... RETURNING separately from
 512 # INSERT and UPDATE
 513 sub _delete_returning { shift->_returning(@_) }
 514
 515
 516
 517 #======================================================================
 518 # WHERE: entry point
 519 #======================================================================
 520
 521
 522
 523 # Finally, a separate routine just to handle WHERE clauses
 524 sub where {
 525   my ($self, $where, $order) = @_;
 526
 527   # where ?
 528   my ($sql, @bind) = $self->_recurse_where($where);
 529   $sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
 530
 531   # order by?
 532   if ($order) {
 533     my ($order_sql, @order_bind) = $self->_order_by($order);
 534     $sql .= $order_sql;
 535     push @bind, @order_bind;
 536   }
 537
 538   return wantarray ? ($sql, @bind) : $sql;
 539 }
 540
 541 sub _expand_expr {
 542   my ($self, $expr, $logic) = @_;
 543   if (ref($expr) eq 'HASH') {
 544     if (keys %$expr > 1) {
 545       $logic ||= 'and';
 546       return +{ "-${logic}" => [
 547         map $self->_expand_expr_hashpair($_ => $expr->{$_}, $logic),
 548           sort keys %$expr
 549       ] };
 550     }
 551     return $self->_expand_expr_hashpair(%$expr, $logic);
 552   }
 553   if (ref($expr) eq 'ARRAY') {
 554     $logic = lc($logic || $self->{logic});
 555     $logic eq 'and' or $logic eq 'or' or puke "unknown logic: $logic";
 556
 557     my @expr = @$expr;
 558
 559     my @res;
 560
 561     while (my ($el) = splice @expr, 0, 1) {
 562       puke "Supplying an empty left hand side argument is not supported in array-pairs"
 563         unless defined($el) and length($el);
 564       my $elref = ref($el);
 565       if (!$elref) {
 566         push(@res, $self->_expand_expr({ $el, shift(@expr) }));
 567       } elsif ($elref eq 'ARRAY') {
 568         push(@res, $self->_expand_expr($el)) if @$el;
 569       } elsif (is_literal_value($el)) {
 570         push @res, $el;
 571       } elsif ($elref eq 'HASH') {
 572         push @res, $self->_expand_expr($el);
 573       } else {
 574         die "unimplemented"
 575       }
 576     }
 577     return { '-'.$logic => \@res };
 578   }
 579   if (my $literal = is_literal_value($expr)) {
 580     return +{ -literal => $literal };
 581   }
 582   return $expr;
 583 }
 584
 585 sub _expand_expr_hashpair {
 586   my ($self, $k, $v, $logic) = @_;
 587   unless (defined($k) and length($k)) {
 588     if (defined($k) and my $literal = is_literal_value($v)) {
 589       belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
 590       return { -literal => $literal };
 591     }
 592     puke "Supplying an empty left hand side argument is not supported";
 593   }
 594   if ($k =~ /^-/) {
 595     if ($k eq '-nest') {
 596       return $self->_expand_expr($v);
 597     }
 598     if ($k eq '-bool') {
 599       if (ref($v)) {
 600         return $self->_expand_expr($v);
 601       }
 602       puke "-bool => undef not supported" unless defined($v);
 603       return { -ident => $v };
 604     }
 605     if (my ($rest) = $k =~/^-not[_ ](.*)$/) {
 606       return $self->_expand_expr({ -not => { "-${rest}", $v } }, $logic);
 607     }
 608     if (my ($logic) = $k =~ /^-(and|or)$/) {
 609       if (ref($v) eq 'HASH') {
 610         return $self->_expand_expr($v, $logic);
 611       }
 612     }
 613   } else {
 614     unless (defined($v)) {
 615       my $orig_op = my $op = $self->{cmp};
 616       my $is =
 617         $op =~ /^not$/i               ? 'is not'  # legacy
 618       : $op =~ $self->{equality_op}   ? 'is'
 619       : $op =~ $self->{like_op}       ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
 620       : $op =~ $self->{inequality_op} ? 'is not'
 621       : $op =~ $self->{not_like_op}   ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
 622       : puke "unexpected operator '$orig_op' with undef operand";
 623       return +{ -op => [ $is.' null', { -ident => $k } ] };
 624     }
 625     if (!ref($v)) {
 626       return +{
 627         -op => [
 628           $self->{cmp},
 629           { -ident => $k },
 630           { -bind => [ $k, $v ] }
 631         ]
 632       };
 633     }
 634     if (ref($v) eq 'HASH') {
 635       if (keys %$v > 1) {
 636         return { -and => [
 637           map $self->_expand_expr_hashpair($k => { $_ => $v->{$_} }),
 638             sort keys %$v
 639         ] };
 640       }
 641       my ($vk, $vv) = %$v;
 642       $vk =~ s/^-//;
 643       $vk = lc($vk);
 644       if ($vk =~ /^(?:not[ _])?between$/) {
 645         my @rhs = map $self->_expand_expr($_),
 646                     ref($vv) eq 'ARRAY' ? @$vv : $vv;
 647         unless (
 648           (@rhs == 1 and ref($rhs[0]) eq 'HASH' and $rhs[0]->{-literal})
 649           or
 650           (@rhs == 2 and defined($rhs[0]) and defined($rhs[1]))
 651         ) {
 652           puke "Operator '${\uc($vk)}' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
 653         }
 654         return +{ -op => [
 655           join(' ', split '_', $vk),
 656           { -ident => $k },
 657           map {
 658             my $v = ref($_) ? $_->{-value} :$_;
 659             ($v ? { -bind => [ $k, $v ] } : $_)
 660           } @rhs
 661         ] }
 662       }
 663       if ($vk =~ /^(?:not[ _])?in$/) {
 664         if (my $literal = is_literal_value($vv)) {
 665           my ($sql, @bind) = @$literal;
 666           my $opened_sql = $self->_open_outer_paren($sql);
 667           return +{ -op => [
 668             $vk, { -ident => $k },
 669             [ { -literal => [ $opened_sql, @bind ] } ]
 670           ] };
 671         }
 672         my $undef_err =
 673           'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
 674         . "-${\uc($vk)} operator was given an undef-containing list: !!!AUDIT YOUR CODE "
 675         . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
 676         . 'will emit the logically correct SQL instead of raising this exception)'
 677         ;
 678         puke("Argument passed to the '${\uc($vk)}' operator can not be undefined")
 679           if !defined($vv);
 680         my @rhs = map $self->_expand_expr($_),
 681                     map { ref($_) ? $_ : { -bind => [ $k, $_ ] } }
 682                     map { defined($_) ? $_: puke($undef_err) }
 683                       (ref($vv) eq 'ARRAY' ? @$vv : $vv);
 684         return +{
 685           -literal => [ $self->{$vk =~ /^not/ ? 'sqltrue' : 'sqlfalse'} ]
 686         } unless @rhs;
 687
 688         return +{ -op => [
 689           join(' ', split '_', $vk),
 690           { -ident => $k },
 691           \@rhs
 692         ] };
 693       }
 694       if ($vk eq 'ident') {
 695         if (! defined $vv or ref $vv) {
 696           puke "-$vk requires a single plain scalar argument (a quotable identifier)";
 697         }
 698         return +{ -op => [
 699           $self->{cmp},
 700           { -ident => $k },
 701           { -ident => $vv }
 702         ] };
 703       }
 704     }
 705     if (ref($v) eq 'ARRAY') {
 706       return $self->{sqlfalse} unless @$v;
 707       $self->_debug("ARRAY($k) means distribute over elements");
 708       my $this_logic = (
 709         $v->[0] =~ /^-((?:and|or))$/i
 710           ? ($v = [ @{$v}[1..$#$v] ], $1)
 711           : ($self->{logic} || 'or')
 712       );
 713       return +{ "-${this_logic}" => [ map $self->_expand_expr({ $k => $_ }, $this_logic), @$v ] };
 714     }
 715     if (my $literal = is_literal_value($v)) {
 716       unless (length $k) {
 717         belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
 718         return \$literal;
 719       }
 720       my ($sql, @bind) = @$literal;
 721       if ($self->{bindtype} eq 'columns') {
 722         for (@bind) {
 723           if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
 724             puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
 725           }
 726         }
 727       }
 728       return +{ -literal => [ $self->_quote($k).' '.$sql, @bind ] };
 729     }
 730   }
 731   return { $k => $v };
 732 }
 733
 734 sub _recurse_where {
 735   my ($self, $where, $logic) = @_;
 736
 737   my $where_exp = $self->_expand_expr($where, $logic);
 738
 739   # dispatch on appropriate method according to refkind of $where
 740   my $method = $self->_METHOD_FOR_refkind("_where", $where_exp);
 741
 742   my ($sql, @bind) =  $self->$method($where_exp, $logic);
 743
 744   # DBIx::Class used to call _recurse_where in scalar context
 745   # something else might too...
 746   if (wantarray) {
 747     return ($sql, @bind);
 748   }
 749   else {
 750     belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
 751     return $sql;
 752   }
 753 }
 754
 755
 756
 757 #======================================================================
 758 # WHERE: top-level ARRAYREF
 759 #======================================================================
 760
 761
 762 sub _where_ARRAYREF {
 763   my ($self, $where, $logic) = @_;
 764
 765   $logic = uc($logic || $self->{logic});
 766   $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
 767
 768   my @clauses = @$where;
 769
 770   my (@sql_clauses, @all_bind);
 771   # need to use while() so can shift() for pairs
 772   while (@clauses) {
 773     my $el = shift @clauses;
 774
 775     $el = undef if (defined $el and ! length $el);
 776
 777     # switch according to kind of $el and get corresponding ($sql, @bind)
 778     my ($sql, @bind) = $self->_SWITCH_refkind($el, {
 779
 780       # skip empty elements, otherwise get invalid trailing AND stuff
 781       ARRAYREF  => sub {$self->_recurse_where($el)        if @$el},
 782
 783       ARRAYREFREF => sub {
 784         my ($s, @b) = @$$el;
 785         $self->_assert_bindval_matches_bindtype(@b);
 786         ($s, @b);
 787       },
 788
 789       HASHREF   => sub {$self->_recurse_where($el, 'and') if %$el},
 790
 791       SCALARREF => sub { ($$el);                                 },
 792
 793       SCALAR    => sub {
 794         # top-level arrayref with scalars, recurse in pairs
 795         $self->_recurse_where({$el => shift(@clauses)})
 796       },
 797
 798       UNDEF     => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
 799     });
 800
 801     if ($sql) {
 802       push @sql_clauses, $sql;
 803       push @all_bind, @bind;
 804     }
 805   }
 806
 807   return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
 808 }
 809
 810 #======================================================================
 811 # WHERE: top-level ARRAYREFREF
 812 #======================================================================
 813
 814 sub _where_ARRAYREFREF {
 815     my ($self, $where) = @_;
 816     my ($sql, @bind) = @$$where;
 817     $self->_assert_bindval_matches_bindtype(@bind);
 818     return ($sql, @bind);
 819 }
 820
 821 #======================================================================
 822 # WHERE: top-level HASHREF
 823 #======================================================================
 824
 825 sub _where_HASHREF {
 826   my ($self, $where) = @_;
 827   my (@sql_clauses, @all_bind);
 828
 829   for my $k (sort keys %$where) {
 830     my $v = $where->{$k};
 831
 832     # ($k => $v) is either a special unary op or a regular hashpair
 833     my ($sql, @bind) = do {
 834       if ($k =~ /^-./) {
 835         # put the operator in canonical form
 836         my $op = $k;
 837         $op = substr $op, 1;  # remove initial dash
 838         $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
 839         $op =~ s/\s+/ /g;     # compress whitespace
 840
 841         # so that -not_foo works correctly
 842         $op =~ s/^not_/NOT /i;
 843
 844         $self->_debug("Unary OP(-$op) within hashref, recursing...");
 845         my ($s, @b) = $self->_where_unary_op($op, $v);
 846
 847         # top level vs nested
 848         # we assume that handled unary ops will take care of their ()s
 849         $s = "($s)" unless (
 850           List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
 851             or
 852           ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
 853         );
 854         ($s, @b);
 855       }
 856       else {
 857         if (! length $k) {
 858           if (is_literal_value ($v) ) {
 859             belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
 860           }
 861           else {
 862             puke "Supplying an empty left hand side argument is not supported in hash-pairs";
 863           }
 864         }
 865
 866         my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
 867         $self->$method($k, $v);
 868       }
 869     };
 870
 871     push @sql_clauses, $sql;
 872     push @all_bind, @bind;
 873   }
 874
 875   return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
 876 }
 877
 878 sub _where_unary_op {
 879   my ($self, $op, $rhs) = @_;
 880
 881   $op =~ s/^-// if length($op) > 1;
 882
 883   # top level special ops are illegal in general
 884   puke "Illegal use of top-level '-$op'"
 885     if !(defined $self->{_nested_func_lhs})
 886     and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
 887     and not List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}};
 888
 889   if (my $op_entry = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
 890     my $handler = $op_entry->{handler};
 891
 892     if (not ref $handler) {
 893       if ($op =~ s/ [_\s]? \d+ $//x ) {
 894         belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
 895             . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
 896       }
 897       return $self->$handler($op, $rhs);
 898     }
 899     elsif (ref $handler eq 'CODE') {
 900       return $handler->($self, $op, $rhs);
 901     }
 902     else {
 903       puke "Illegal handler for operator $op - expecting a method name or a coderef";
 904     }
 905   }
 906
 907   $self->_debug("Generic unary OP: $op - recursing as function");
 908
 909   $self->_assert_pass_injection_guard($op);
 910
 911   my ($sql, @bind) = $self->_SWITCH_refkind($rhs, {
 912     SCALAR =>   sub {
 913       puke "Illegal use of top-level '-$op'"
 914         unless defined $self->{_nested_func_lhs};
 915
 916       return (
 917         $self->_convert('?'),
 918         $self->_bindtype($self->{_nested_func_lhs}, $rhs)
 919       );
 920     },
 921     FALLBACK => sub {
 922       $self->_recurse_where($rhs)
 923     },
 924   });
 925
 926   $sql = sprintf('%s %s',
 927     $self->_sqlcase($op),
 928     $sql,
 929   );
 930
 931   return ($sql, @bind);
 932 }
 933
 934 sub _where_op_ANDOR {
 935   my ($self, $op, $v) = @_;
 936
 937   $self->_SWITCH_refkind($v, {
 938     ARRAYREF => sub {
 939       return $self->_where_ARRAYREF($v, $op);
 940     },
 941
 942     HASHREF => sub {
 943       return ($op =~ /^or/i)
 944         ? $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], $op)
 945         : $self->_where_HASHREF($v);
 946     },
 947
 948     SCALARREF  => sub {
 949       puke "-$op => \\\$scalar makes little sense, use " .
 950         ($op =~ /^or/i
 951           ? '[ \$scalar, \%rest_of_conditions ] instead'
 952           : '-and => [ \$scalar, \%rest_of_conditions ] instead'
 953         );
 954     },
 955
 956     ARRAYREFREF => sub {
 957       puke "-$op => \\[...] makes little sense, use " .
 958         ($op =~ /^or/i
 959           ? '[ \[...], \%rest_of_conditions ] instead'
 960           : '-and => [ \[...], \%rest_of_conditions ] instead'
 961         );
 962     },
 963
 964     SCALAR => sub { # permissively interpreted as SQL
 965       puke "-$op => \$value makes little sense, use -bool => \$value instead";
 966     },
 967
 968     UNDEF => sub {
 969       puke "-$op => undef not supported";
 970     },
 971    });
 972 }
 973
 974 sub _where_op_NEST {
 975   my ($self, $op, $v) = @_;
 976
 977   $self->_SWITCH_refkind($v, {
 978
 979     SCALAR => sub { # permissively interpreted as SQL
 980       belch "literal SQL should be -nest => \\'scalar' "
 981           . "instead of -nest => 'scalar' ";
 982       return ($v);
 983     },
 984
 985     UNDEF => sub {
 986       puke "-$op => undef not supported";
 987     },
 988
 989     FALLBACK => sub {
 990       $self->_recurse_where($v);
 991     },
 992
 993    });
 994 }
 995
 996
 997 sub _where_op_BOOL {
 998   my ($self, $op, $v) = @_;
 999
1000   my ($s, @b) = $self->_SWITCH_refkind($v, {
1001     SCALAR => sub { # interpreted as SQL column
1002       $self->_convert($self->_quote($v));
1003     },
1004
1005     UNDEF => sub {
1006       puke "-$op => undef not supported";
1007     },
1008
1009     FALLBACK => sub {
1010       $self->_recurse_where($v);
1011     },
1012   });
1013
1014   $s = "(NOT $s)" if $op =~ /^not/i;
1015   ($s, @b);
1016 }
1017
1018
1019 sub _where_op_IDENT {
1020   my $self = shift;
1021   my ($op, $rhs) = splice @_, -2;
1022   if (! defined $rhs or length ref $rhs) {
1023     puke "-$op requires a single plain scalar argument (a quotable identifier)";
1024   }
1025
1026   # in case we are called as a top level special op (no '=')
1027   my $has_lhs = my $lhs = shift;
1028
1029   $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
1030
1031   return $has_lhs
1032     ? "$lhs = $rhs"
1033     : $rhs
1034   ;
1035 }
1036
1037 sub _where_op_VALUE {
1038   my $self = shift;
1039   my ($op, $rhs) = splice @_, -2;
1040
1041   # in case we are called as a top level special op (no '=')
1042   my $lhs = shift;
1043
1044   # special-case NULL
1045   if (! defined $rhs) {
1046     return defined $lhs
1047       ? $self->_where_hashpair_HASHREF($lhs, { -is => undef })
1048       : undef
1049     ;
1050   }
1051
1052   my @bind =
1053     $self->_bindtype(
1054       (defined $lhs ? $lhs : $self->{_nested_func_lhs}),
1055       $rhs,
1056     )
1057   ;
1058
1059   return $lhs
1060     ? (
1061       $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
1062       @bind
1063     )
1064     : (
1065       $self->_convert('?'),
1066       @bind,
1067     )
1068   ;
1069 }
1070
1071
1072 my %unop_postfix = map +($_ => 1), 'is null', 'is not null';
1073
1074 my %special = (
1075   (map +($_ => do {
1076     my $op = $_;
1077     sub {
1078       my ($self, $args) = @_;
1079       my ($left, $low, $high) = @$args;
1080       my ($rhsql, @rhbind) = do {
1081         if (@$args == 2) {
1082           puke "Single arg to between must be a literal"
1083             unless $low->{-literal};
1084           @{$low->{-literal}}
1085         } else {
1086           local $self->{_nested_func_lhs} = $left->{-ident}
1087             if ref($left) eq 'HASH' and $left->{-ident};
1088           my ($l, $h) = map [ $self->_where_unary_op(%$_) ], $low, $high;
1089           (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
1090            @{$l}[1..$#$l], @{$h}[1..$#$h])
1091         }
1092       };
1093       my ($lhsql, @lhbind) = $self->_recurse_where($left);
1094       return (
1095         join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
1096         @lhbind, @rhbind
1097       );
1098     }
1099   }), 'between', 'not between'),
1100   (map +($_ => do {
1101     my $op = $_;
1102     sub {
1103       my ($self, $args) = @_;
1104       my ($lhs, $rhs) = @$args;
1105       my @in_bind;
1106       my @in_sql = map {
1107         local $self->{_nested_func_lhs} = $lhs->{-ident}
1108           if ref($lhs) eq 'HASH' and $lhs->{-ident};
1109         my ($sql, @bind) = $self->_where_unary_op(%$_);
1110         push @in_bind, @bind;
1111         $sql;
1112       } @$rhs;
1113       my ($lhsql, @lbind) = $self->_recurse_where($lhs);
1114       return (
1115         $lhsql.' '.$self->_sqlcase($op).' ( '
1116         .join(', ', @in_sql)
1117         .' )',
1118         @lbind, @in_bind
1119       );
1120     }
1121   }), 'in', 'not in'),
1122 );
1123
1124 sub _where_op_OP {
1125   my ($self, undef, $v) = @_;
1126   my ($op, @args) = @$v;
1127   $op =~ s/^-// if length($op) > 1;
1128   local $self->{_nested_func_lhs};
1129   if (my $h = $special{$op}) {
1130     return $self->$h(\@args);
1131   }
1132   if (@args == 1) {
1133     my ($expr_sql, @bind) = $self->_recurse_where($args[0]);
1134     my $final_op = join ' ', split '_', $op;
1135     my $op_sql = $self->_sqlcase($final_op);
1136     my $final_sql = (
1137       $unop_postfix{lc($final_op)}
1138         ? "${expr_sql} ${op_sql}"
1139         : "${op_sql} ${expr_sql}"
1140     );
1141     return ($final_sql, @bind);
1142   } elsif (@args == 2) {
1143      my ($l, $r) = map [ $self->_recurse_where($_) ], @args;
1144      return (                                                                          $l->[0].' '.$self->_sqlcase(join ' ', split '_', $op).' '.$r->[0],              @{$l}[1..$#$l], @{$r}[1..$#$r]                                                );
1145   }
1146   die "unhandled";
1147 }
1148
1149 sub _where_op_BIND {
1150   my ($self, undef, $bind) = @_;
1151   return ($self->_convert('?'), $self->_bindtype(@$bind));
1152 }
1153
1154 sub _where_op_LITERAL {
1155   my ($self, undef, $literal) = @_;
1156   $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
1157   return @$literal;
1158 }
1159
1160 sub _where_hashpair_ARRAYREF {
1161   my ($self, $k, $v) = @_;
1162
1163   if (@$v) {
1164     my @v = @$v; # need copy because of shift below
1165     $self->_debug("ARRAY($k) means distribute over elements");
1166
1167     # put apart first element if it is an operator (-and, -or)
1168     my $op = (
1169        (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
1170          ? shift @v
1171          : ''
1172     );
1173     my @distributed = map { {$k =>  $_} } @v;
1174
1175     if ($op) {
1176       $self->_debug("OP($op) reinjected into the distributed array");
1177       unshift @distributed, $op;
1178     }
1179
1180     my $logic = $op ? substr($op, 1) : '';
1181
1182     return $self->_recurse_where(\@distributed, $logic);
1183   }
1184   else {
1185     $self->_debug("empty ARRAY($k) means 0=1");
1186     return ($self->{sqlfalse});
1187   }
1188 }
1189
1190 sub _where_hashpair_HASHREF {
1191   my ($self, $k, $v, $logic) = @_;
1192   $logic ||= 'and';
1193
1194   local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
1195     ? $self->{_nested_func_lhs}
1196     : $k
1197   ;
1198
1199   my ($all_sql, @all_bind);
1200
1201   for my $orig_op (sort keys %$v) {
1202     my $val = $v->{$orig_op};
1203
1204     # put the operator in canonical form
1205     my $op = $orig_op;
1206
1207     # FIXME - we need to phase out dash-less ops
1208     $op =~ s/^-//;        # remove possible initial dash
1209     $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
1210     $op =~ s/\s+/ /g;     # compress whitespace
1211
1212     $self->_assert_pass_injection_guard($op);
1213
1214     # fixup is_not
1215     $op =~ s/^is_not/IS NOT/i;
1216
1217     # so that -not_foo works correctly
1218     $op =~ s/^not_/NOT /i;
1219
1220     # another retarded special case: foo => { $op => { -value => undef } }
1221     if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
1222       $val = undef;
1223     }
1224
1225     my ($sql, @bind);
1226
1227     # CASE: col-value logic modifiers
1228     if ($orig_op =~ /^ \- (and|or) $/xi) {
1229       ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
1230     }
1231     # CASE: special operators like -in or -between
1232     elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
1233       my $handler = $special_op->{handler};
1234       if (! $handler) {
1235         puke "No handler supplied for special operator $orig_op";
1236       }
1237       elsif (not ref $handler) {
1238         ($sql, @bind) = $self->$handler($k, $op, $val);
1239       }
1240       elsif (ref $handler eq 'CODE') {
1241         ($sql, @bind) = $handler->($self, $k, $op, $val);
1242       }
1243       else {
1244         puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
1245       }
1246     }
1247     else {
1248       $self->_SWITCH_refkind($val, {
1249
1250         ARRAYREF => sub {       # CASE: col => {op => \@vals}
1251           ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
1252         },
1253
1254         ARRAYREFREF => sub {    # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
1255           my ($sub_sql, @sub_bind) = @$$val;
1256           $self->_assert_bindval_matches_bindtype(@sub_bind);
1257           $sql  = join ' ', $self->_convert($self->_quote($k)),
1258                             $self->_sqlcase($op),
1259                             $sub_sql;
1260           @bind = @sub_bind;
1261         },
1262
1263         UNDEF => sub {          # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
1264           my $is =
1265             $op =~ /^not$/i               ? 'is not'  # legacy
1266           : $op =~ $self->{equality_op}   ? 'is'
1267           : $op =~ $self->{like_op}       ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
1268           : $op =~ $self->{inequality_op} ? 'is not'
1269           : $op =~ $self->{not_like_op}   ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
1270           : puke "unexpected operator '$orig_op' with undef operand";
1271
1272           $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
1273         },
1274
1275         FALLBACK => sub {       # CASE: col => {op/func => $stuff}
1276           ($sql, @bind) = $self->_where_unary_op($op, $val);
1277
1278           $sql = join(' ',
1279             $self->_convert($self->_quote($k)),
1280             $self->{_nested_func_lhs} eq $k ? $sql : "($sql)",  # top level vs nested
1281           );
1282         },
1283       });
1284     }
1285
1286     ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
1287     push @all_bind, @bind;
1288   }
1289   return ($all_sql, @all_bind);
1290 }
1291
1292 sub _where_field_IS {
1293   my ($self, $k, $op, $v) = @_;
1294
1295   my ($s) = $self->_SWITCH_refkind($v, {
1296     UNDEF => sub {
1297       join ' ',
1298         $self->_convert($self->_quote($k)),
1299         map { $self->_sqlcase($_)} ($op, 'null')
1300     },
1301     FALLBACK => sub {
1302       puke "$op can only take undef as argument";
1303     },
1304   });
1305
1306   $s;
1307 }
1308
1309 sub _where_field_op_ARRAYREF {
1310   my ($self, $k, $op, $vals) = @_;
1311
1312   my @vals = @$vals;  #always work on a copy
1313
1314   if (@vals) {
1315     $self->_debug(sprintf '%s means multiple elements: [ %s ]',
1316       $vals,
1317       join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
1318     );
1319
1320     # see if the first element is an -and/-or op
1321     my $logic;
1322     if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) {
1323       $logic = uc $1;
1324       shift @vals;
1325     }
1326
1327     # a long standing API wart - an attempt to change this behavior during
1328     # the 1.50 series failed *spectacularly*. Warn instead and leave the
1329     # behavior as is
1330     if (
1331       @vals > 1
1332         and
1333       (!$logic or $logic eq 'OR')
1334         and
1335       ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op})
1336     ) {
1337       my $o = uc($op);
1338       belch "A multi-element arrayref as an argument to the inequality op '$o' "
1339           . 'is technically equivalent to an always-true 1=1 (you probably wanted '
1340           . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1341       ;
1342     }
1343
1344     # distribute $op over each remaining member of @vals, append logic if exists
1345     return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1346
1347   }
1348   else {
1349     # try to DWIM on equality operators
1350     return
1351       $op =~ $self->{equality_op}   ? $self->{sqlfalse}
1352     : $op =~ $self->{like_op}       ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1353     : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1354     : $op =~ $self->{not_like_op}   ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1355     : puke "operator '$op' applied on an empty array (field '$k')";
1356   }
1357 }
1358
1359
1360 sub _where_hashpair_SCALARREF {
1361   my ($self, $k, $v) = @_;
1362   $self->_debug("SCALAR($k) means literal SQL: $$v");
1363   my $sql = $self->_quote($k) . " " . $$v;
1364   return ($sql);
1365 }
1366
1367 # literal SQL with bind
1368 sub _where_hashpair_ARRAYREFREF {
1369   my ($self, $k, $v) = @_;
1370   $self->_debug("REF($k) means literal SQL: @${$v}");
1371   my ($sql, @bind) = @$$v;
1372   $self->_assert_bindval_matches_bindtype(@bind);
1373   $sql  = $self->_quote($k) . " " . $sql;
1374   return ($sql, @bind );
1375 }
1376
1377 # literal SQL without bind
1378 sub _where_hashpair_SCALAR {
1379   my ($self, $k, $v) = @_;
1380   $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1381   return ($self->_where_hashpair_HASHREF($k, { $self->{cmp} => $v }));
1382 }
1383
1384
1385 sub _where_hashpair_UNDEF {
1386   my ($self, $k, $v) = @_;
1387   $self->_debug("UNDEF($k) means IS NULL");
1388   return $self->_where_hashpair_HASHREF($k, { -is => undef });
1389 }
1390
1391 #======================================================================
1392 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1393 #======================================================================
1394
1395
1396 sub _where_SCALARREF {
1397   my ($self, $where) = @_;
1398
1399   # literal sql
1400   $self->_debug("SCALAR(*top) means literal SQL: $$where");
1401   return ($$where);
1402 }
1403
1404
1405 sub _where_SCALAR {
1406   my ($self, $where) = @_;
1407
1408   # literal sql
1409   $self->_debug("NOREF(*top) means literal SQL: $where");
1410   return ($where);
1411 }
1412
1413
1414 sub _where_UNDEF {
1415   my ($self) = @_;
1416   return ();
1417 }
1418
1419
1420 #======================================================================
1421 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1422 #======================================================================
1423
1424
1425 sub _where_field_BETWEEN {
1426   my ($self, $k, $op, $vals) = @_;
1427
1428   my ($label, $and, $placeholder);
1429   $label       = $self->_convert($self->_quote($k));
1430   $and         = ' ' . $self->_sqlcase('and') . ' ';
1431   $placeholder = $self->_convert('?');
1432   $op               = $self->_sqlcase($op);
1433
1434   my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1435
1436   my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1437     ARRAYREFREF => sub {
1438       my ($s, @b) = @$$vals;
1439       $self->_assert_bindval_matches_bindtype(@b);
1440       ($s, @b);
1441     },
1442     SCALARREF => sub {
1443       return $$vals;
1444     },
1445     ARRAYREF => sub {
1446       puke $invalid_args if @$vals != 2;
1447
1448       my (@all_sql, @all_bind);
1449       foreach my $val (@$vals) {
1450         my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1451            SCALAR => sub {
1452              return ($placeholder, $self->_bindtype($k, $val) );
1453            },
1454            SCALARREF => sub {
1455              return $$val;
1456            },
1457            ARRAYREFREF => sub {
1458              my ($sql, @bind) = @$$val;
1459              $self->_assert_bindval_matches_bindtype(@bind);
1460              return ($sql, @bind);
1461            },
1462            HASHREF => sub {
1463              my ($func, $arg, @rest) = %$val;
1464              puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN"
1465                if (@rest or $func !~ /^ \- (.+)/x);
1466              $self->_where_unary_op($1 => $arg);
1467            },
1468            FALLBACK => sub {
1469              puke $invalid_args,
1470            },
1471         });
1472         push @all_sql, $sql;
1473         push @all_bind, @bind;
1474       }
1475
1476       return (
1477         (join $and, @all_sql),
1478         @all_bind
1479       );
1480     },
1481     FALLBACK => sub {
1482       puke $invalid_args,
1483     },
1484   });
1485
1486   my $sql = "( $label $op $clause )";
1487   return ($sql, @bind)
1488 }
1489
1490
1491 sub _where_field_IN {
1492   my ($self, $k, $op, $vals) = @_;
1493
1494   # backwards compatibility: if scalar, force into an arrayref
1495   $vals = [$vals] if defined $vals && ! ref $vals;
1496
1497   my ($label)       = $self->_convert($self->_quote($k));
1498   my ($placeholder) = $self->_convert('?');
1499   $op               = $self->_sqlcase($op);
1500
1501   my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1502     ARRAYREF => sub {     # list of choices
1503       if (@$vals) { # nonempty list
1504         my (@all_sql, @all_bind);
1505
1506         for my $val (@$vals) {
1507           my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1508             SCALAR => sub {
1509               return ($placeholder, $val);
1510             },
1511             SCALARREF => sub {
1512               return $$val;
1513             },
1514             ARRAYREFREF => sub {
1515               my ($sql, @bind) = @$$val;
1516               $self->_assert_bindval_matches_bindtype(@bind);
1517               return ($sql, @bind);
1518             },
1519             HASHREF => sub {
1520               my ($func, $arg, @rest) = %$val;
1521               puke "Only simple { -func => arg } functions accepted as sub-arguments to IN"
1522                 if (@rest or $func !~ /^ \- (.+)/x);
1523               $self->_where_unary_op($1 => $arg);
1524             },
1525             UNDEF => sub {
1526               puke(
1527                 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1528               . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1529               . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1530               . 'will emit the logically correct SQL instead of raising this exception)'
1531               );
1532             },
1533           });
1534           push @all_sql, $sql;
1535           push @all_bind, @bind;
1536         }
1537
1538         return (
1539           sprintf('%s %s ( %s )',
1540             $label,
1541             $op,
1542             join(', ', @all_sql)
1543           ),
1544           $self->_bindtype($k, @all_bind),
1545         );
1546       }
1547       else { # empty list: some databases won't understand "IN ()", so DWIM
1548         my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1549         return ($sql);
1550       }
1551     },
1552
1553     SCALARREF => sub {  # literal SQL
1554       my $sql = $self->_open_outer_paren($$vals);
1555       return ("$label $op ( $sql )");
1556     },
1557     ARRAYREFREF => sub {  # literal SQL with bind
1558       my ($sql, @bind) = @$$vals;
1559       $self->_assert_bindval_matches_bindtype(@bind);
1560       $sql = $self->_open_outer_paren($sql);
1561       return ("$label $op ( $sql )", @bind);
1562     },
1563
1564     UNDEF => sub {
1565       puke "Argument passed to the '$op' operator can not be undefined";
1566     },
1567
1568     FALLBACK => sub {
1569       puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1570     },
1571   });
1572
1573   return ($sql, @bind);
1574 }
1575
1576 # Some databases (SQLite) treat col IN (1, 2) different from
1577 # col IN ( (1, 2) ). Use this to strip all outer parens while
1578 # adding them back in the corresponding method
1579 sub _open_outer_paren {
1580   my ($self, $sql) = @_;
1581
1582   while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
1583
1584     # there are closing parens inside, need the heavy duty machinery
1585     # to reevaluate the extraction starting from $sql (full reevaluation)
1586     if ($inner =~ /\)/) {
1587       require Text::Balanced;
1588
1589       my (undef, $remainder) = do {
1590         # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1591         local $@;
1592         Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
1593       };
1594
1595       # the entire expression needs to be a balanced bracketed thing
1596       # (after an extract no remainder sans trailing space)
1597       last if defined $remainder and $remainder =~ /\S/;
1598     }
1599
1600     $sql = $inner;
1601   }
1602
1603   $sql;
1604 }
1605
1606
1607 #======================================================================
1608 # ORDER BY
1609 #======================================================================
1610
1611 sub _order_by {
1612   my ($self, $arg) = @_;
1613
1614   my (@sql, @bind);
1615   for my $c ($self->_order_by_chunks($arg) ) {
1616     $self->_SWITCH_refkind($c, {
1617       SCALAR => sub { push @sql, $c },
1618       ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1619     });
1620   }
1621
1622   my $sql = @sql
1623     ? sprintf('%s %s',
1624         $self->_sqlcase(' order by'),
1625         join(', ', @sql)
1626       )
1627     : ''
1628   ;
1629
1630   return wantarray ? ($sql, @bind) : $sql;
1631 }
1632
1633 sub _order_by_chunks {
1634   my ($self, $arg) = @_;
1635
1636   return $self->_SWITCH_refkind($arg, {
1637
1638     ARRAYREF => sub {
1639       map { $self->_order_by_chunks($_ ) } @$arg;
1640     },
1641
1642     ARRAYREFREF => sub {
1643       my ($s, @b) = @$$arg;
1644       $self->_assert_bindval_matches_bindtype(@b);
1645       [ $s, @b ];
1646     },
1647
1648     SCALAR    => sub {$self->_quote($arg)},
1649
1650     UNDEF     => sub {return () },
1651
1652     SCALARREF => sub {$$arg}, # literal SQL, no quoting
1653
1654     HASHREF   => sub {
1655       # get first pair in hash
1656       my ($key, $val, @rest) = %$arg;
1657
1658       return () unless $key;
1659
1660       if (@rest or not $key =~ /^-(desc|asc)/i) {
1661         puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1662       }
1663
1664       my $direction = $1;
1665
1666       my @ret;
1667       for my $c ($self->_order_by_chunks($val)) {
1668         my ($sql, @bind);
1669
1670         $self->_SWITCH_refkind($c, {
1671           SCALAR => sub {
1672             $sql = $c;
1673           },
1674           ARRAYREF => sub {
1675             ($sql, @bind) = @$c;
1676           },
1677         });
1678
1679         $sql = $sql . ' ' . $self->_sqlcase($direction);
1680
1681         push @ret, [ $sql, @bind];
1682       }
1683
1684       return @ret;
1685     },
1686   });
1687 }
1688
1689
1690 #======================================================================
1691 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1692 #======================================================================
1693
1694 sub _table  {
1695   my $self = shift;
1696   my $from = shift;
1697   $self->_SWITCH_refkind($from, {
1698     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$from;},
1699     SCALAR       => sub {$self->_quote($from)},
1700     SCALARREF    => sub {$$from},
1701   });
1702 }
1703
1704
1705 #======================================================================
1706 # UTILITY FUNCTIONS
1707 #======================================================================
1708
1709 # highly optimized, as it's called way too often
1710 sub _quote {
1711   # my ($self, $label) = @_;
1712
1713   return '' unless defined $_[1];
1714   return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1715
1716   $_[0]->{quote_char} or
1717     ($_[0]->_assert_pass_injection_guard($_[1]), return $_[1]);
1718
1719   my $qref = ref $_[0]->{quote_char};
1720   my ($l, $r) =
1721       !$qref             ? ($_[0]->{quote_char}, $_[0]->{quote_char})
1722     : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}}
1723     : puke "Unsupported quote_char format: $_[0]->{quote_char}";
1724
1725   my $esc = $_[0]->{escape_char} || $r;
1726
1727   # parts containing * are naturally unquoted
1728   return join($_[0]->{name_sep}||'', map
1729     +( $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } ),
1730     ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1731   );
1732 }
1733
1734
1735 # Conversion, if applicable
1736 sub _convert {
1737   #my ($self, $arg) = @_;
1738   if ($_[0]->{convert}) {
1739     return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1740   }
1741   return $_[1];
1742 }
1743
1744 # And bindtype
1745 sub _bindtype {
1746   #my ($self, $col, @vals) = @_;
1747   # called often - tighten code
1748   return $_[0]->{bindtype} eq 'columns'
1749     ? map {[$_[1], $_]} @_[2 .. $#_]
1750     : @_[2 .. $#_]
1751   ;
1752 }
1753
1754 # Dies if any element of @bind is not in [colname => value] format
1755 # if bindtype is 'columns'.
1756 sub _assert_bindval_matches_bindtype {
1757 #  my ($self, @bind) = @_;
1758   my $self = shift;
1759   if ($self->{bindtype} eq 'columns') {
1760     for (@_) {
1761       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1762         puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1763       }
1764     }
1765   }
1766 }
1767
1768 sub _join_sql_clauses {
1769   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1770
1771   if (@$clauses_aref > 1) {
1772     my $join  = " " . $self->_sqlcase($logic) . " ";
1773     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1774     return ($sql, @$bind_aref);
1775   }
1776   elsif (@$clauses_aref) {
1777     return ($clauses_aref->[0], @$bind_aref); # no parentheses
1778   }
1779   else {
1780     return (); # if no SQL, ignore @$bind_aref
1781   }
1782 }
1783
1784
1785 # Fix SQL case, if so requested
1786 sub _sqlcase {
1787   # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1788   # don't touch the argument ... crooked logic, but let's not change it!
1789   return $_[0]->{case} ? $_[1] : uc($_[1]);
1790 }
1791
1792
1793 #======================================================================
1794 # DISPATCHING FROM REFKIND
1795 #======================================================================
1796
1797 sub _refkind {
1798   my ($self, $data) = @_;
1799
1800   return 'UNDEF' unless defined $data;
1801
1802   # blessed objects are treated like scalars
1803   my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1804
1805   return 'SCALAR' unless $ref;
1806
1807   my $n_steps = 1;
1808   while ($ref eq 'REF') {
1809     $data = $$data;
1810     $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1811     $n_steps++ if $ref;
1812   }
1813
1814   return ($ref||'SCALAR') . ('REF' x $n_steps);
1815 }
1816
1817 sub _try_refkind {
1818   my ($self, $data) = @_;
1819   my @try = ($self->_refkind($data));
1820   push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1821   push @try, 'FALLBACK';
1822   return \@try;
1823 }
1824
1825 sub _METHOD_FOR_refkind {
1826   my ($self, $meth_prefix, $data) = @_;
1827
1828   my $method;
1829   for (@{$self->_try_refkind($data)}) {
1830     $method = $self->can($meth_prefix."_".$_)
1831       and last;
1832   }
1833
1834   return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1835 }
1836
1837
1838 sub _SWITCH_refkind {
1839   my ($self, $data, $dispatch_table) = @_;
1840
1841   my $coderef;
1842   for (@{$self->_try_refkind($data)}) {
1843     $coderef = $dispatch_table->{$_}
1844       and last;
1845   }
1846
1847   puke "no dispatch entry for ".$self->_refkind($data)
1848     unless $coderef;
1849
1850   $coderef->();
1851 }
1852
1853
1854
1855
1856 #======================================================================
1857 # VALUES, GENERATE, AUTOLOAD
1858 #======================================================================
1859
1860 # LDNOTE: original code from nwiger, didn't touch code in that section
1861 # I feel the AUTOLOAD stuff should not be the default, it should
1862 # only be activated on explicit demand by user.
1863
1864 sub values {
1865     my $self = shift;
1866     my $data = shift || return;
1867     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1868         unless ref $data eq 'HASH';
1869
1870     my @all_bind;
1871     foreach my $k (sort keys %$data) {
1872         my $v = $data->{$k};
1873         $self->_SWITCH_refkind($v, {
1874           ARRAYREF => sub {
1875             if ($self->{array_datatypes}) { # array datatype
1876               push @all_bind, $self->_bindtype($k, $v);
1877             }
1878             else {                          # literal SQL with bind
1879               my ($sql, @bind) = @$v;
1880               $self->_assert_bindval_matches_bindtype(@bind);
1881               push @all_bind, @bind;
1882             }
1883           },
1884           ARRAYREFREF => sub { # literal SQL with bind
1885             my ($sql, @bind) = @${$v};
1886             $self->_assert_bindval_matches_bindtype(@bind);
1887             push @all_bind, @bind;
1888           },
1889           SCALARREF => sub {  # literal SQL without bind
1890           },
1891           SCALAR_or_UNDEF => sub {
1892             push @all_bind, $self->_bindtype($k, $v);
1893           },
1894         });
1895     }
1896
1897     return @all_bind;
1898 }
1899
1900 sub generate {
1901     my $self  = shift;
1902
1903     my(@sql, @sqlq, @sqlv);
1904
1905     for (@_) {
1906         my $ref = ref $_;
1907         if ($ref eq 'HASH') {
1908             for my $k (sort keys %$_) {
1909                 my $v = $_->{$k};
1910                 my $r = ref $v;
1911                 my $label = $self->_quote($k);
1912                 if ($r eq 'ARRAY') {
1913                     # literal SQL with bind
1914                     my ($sql, @bind) = @$v;
1915                     $self->_assert_bindval_matches_bindtype(@bind);
1916                     push @sqlq, "$label = $sql";
1917                     push @sqlv, @bind;
1918                 } elsif ($r eq 'SCALAR') {
1919                     # literal SQL without bind
1920                     push @sqlq, "$label = $$v";
1921                 } else {
1922                     push @sqlq, "$label = ?";
1923                     push @sqlv, $self->_bindtype($k, $v);
1924                 }
1925             }
1926             push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1927         } elsif ($ref eq 'ARRAY') {
1928             # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1929             for my $v (@$_) {
1930                 my $r = ref $v;
1931                 if ($r eq 'ARRAY') {   # literal SQL with bind
1932                     my ($sql, @bind) = @$v;
1933                     $self->_assert_bindval_matches_bindtype(@bind);
1934                     push @sqlq, $sql;
1935                     push @sqlv, @bind;
1936                 } elsif ($r eq 'SCALAR') {  # literal SQL without bind
1937                     # embedded literal SQL
1938                     push @sqlq, $$v;
1939                 } else {
1940                     push @sqlq, '?';
1941                     push @sqlv, $v;
1942                 }
1943             }
1944             push @sql, '(' . join(', ', @sqlq) . ')';
1945         } elsif ($ref eq 'SCALAR') {
1946             # literal SQL
1947             push @sql, $$_;
1948         } else {
1949             # strings get case twiddled
1950             push @sql, $self->_sqlcase($_);
1951         }
1952     }
1953
1954     my $sql = join ' ', @sql;
1955
1956     # this is pretty tricky
1957     # if ask for an array, return ($stmt, @bind)
1958     # otherwise, s/?/shift @sqlv/ to put it inline
1959     if (wantarray) {
1960         return ($sql, @sqlv);
1961     } else {
1962         1 while $sql =~ s/\?/my $d = shift(@sqlv);
1963                              ref $d ? $d->[1] : $d/e;
1964         return $sql;
1965     }
1966 }
1967
1968
1969 sub DESTROY { 1 }
1970
1971 sub AUTOLOAD {
1972     # This allows us to check for a local, then _form, attr
1973     my $self = shift;
1974     my($name) = $AUTOLOAD =~ /.*::(.+)/;
1975     return $self->generate($name, @_);
1976 }
1977
1978 1;
1979
1980
1981
1982 __END__
1983
1984 =head1 NAME
1985
1986 SQL::Abstract - Generate SQL from Perl data structures
1987
1988 =head1 SYNOPSIS
1989
1990     use SQL::Abstract;
1991
1992     my $sql = SQL::Abstract->new;
1993
1994     my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order);
1995
1996     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1997
1998     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1999
2000     my($stmt, @bind) = $sql->delete($table, \%where);
2001
2002     # Then, use these in your DBI statements
2003     my $sth = $dbh->prepare($stmt);
2004     $sth->execute(@bind);
2005
2006     # Just generate the WHERE clause
2007     my($stmt, @bind) = $sql->where(\%where, $order);
2008
2009     # Return values in the same order, for hashed queries
2010     # See PERFORMANCE section for more details
2011     my @bind = $sql->values(\%fieldvals);
2012
2013 =head1 DESCRIPTION
2014
2015 This module was inspired by the excellent L<DBIx::Abstract>.
2016 However, in using that module I found that what I really wanted
2017 to do was generate SQL, but still retain complete control over my
2018 statement handles and use the DBI interface. So, I set out to
2019 create an abstract SQL generation module.
2020
2021 While based on the concepts used by L<DBIx::Abstract>, there are
2022 several important differences, especially when it comes to WHERE
2023 clauses. I have modified the concepts used to make the SQL easier
2024 to generate from Perl data structures and, IMO, more intuitive.
2025 The underlying idea is for this module to do what you mean, based
2026 on the data structures you provide it. The big advantage is that
2027 you don't have to modify your code every time your data changes,
2028 as this module figures it out.
2029
2030 To begin with, an SQL INSERT is as easy as just specifying a hash
2031 of C<key=value> pairs:
2032
2033     my %data = (
2034         name => 'Jimbo Bobson',
2035         phone => '123-456-7890',
2036         address => '42 Sister Lane',
2037         city => 'St. Louis',
2038         state => 'Louisiana',
2039     );
2040
2041 The SQL can then be generated with this:
2042
2043     my($stmt, @bind) = $sql->insert('people', \%data);
2044
2045 Which would give you something like this:
2046
2047     $stmt = "INSERT INTO people
2048                     (address, city, name, phone, state)
2049                     VALUES (?, ?, ?, ?, ?)";
2050     @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
2051              '123-456-7890', 'Louisiana');
2052
2053 These are then used directly in your DBI code:
2054
2055     my $sth = $dbh->prepare($stmt);
2056     $sth->execute(@bind);
2057
2058 =head2 Inserting and Updating Arrays
2059
2060 If your database has array types (like for example Postgres),
2061 activate the special option C<< array_datatypes => 1 >>
2062 when creating the C<SQL::Abstract> object.
2063 Then you may use an arrayref to insert and update database array types:
2064
2065     my $sql = SQL::Abstract->new(array_datatypes => 1);
2066     my %data = (
2067         planets => [qw/Mercury Venus Earth Mars/]
2068     );
2069
2070     my($stmt, @bind) = $sql->insert('solar_system', \%data);
2071
2072 This results in:
2073
2074     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
2075
2076     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
2077
2078
2079 =head2 Inserting and Updating SQL
2080
2081 In order to apply SQL functions to elements of your C<%data> you may
2082 specify a reference to an arrayref for the given hash value. For example,
2083 if you need to execute the Oracle C<to_date> function on a value, you can
2084 say something like this:
2085
2086     my %data = (
2087         name => 'Bill',
2088         date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ],
2089     );
2090
2091 The first value in the array is the actual SQL. Any other values are
2092 optional and would be included in the bind values array. This gives
2093 you:
2094
2095     my($stmt, @bind) = $sql->insert('people', \%data);
2096
2097     $stmt = "INSERT INTO people (name, date_entered)
2098                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
2099     @bind = ('Bill', '03/02/2003');
2100
2101 An UPDATE is just as easy, all you change is the name of the function:
2102
2103     my($stmt, @bind) = $sql->update('people', \%data);
2104
2105 Notice that your C<%data> isn't touched; the module will generate
2106 the appropriately quirky SQL for you automatically. Usually you'll
2107 want to specify a WHERE clause for your UPDATE, though, which is
2108 where handling C<%where> hashes comes in handy...
2109
2110 =head2 Complex where statements
2111
2112 This module can generate pretty complicated WHERE statements
2113 easily. For example, simple C<key=value> pairs are taken to mean
2114 equality, and if you want to see if a field is within a set
2115 of values, you can use an arrayref. Let's say we wanted to
2116 SELECT some data based on this criteria:
2117
2118     my %where = (
2119        requestor => 'inna',
2120        worker => ['nwiger', 'rcwe', 'sfz'],
2121        status => { '!=', 'completed' }
2122     );
2123
2124     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
2125
2126 The above would give you something like this:
2127
2128     $stmt = "SELECT * FROM tickets WHERE
2129                 ( requestor = ? ) AND ( status != ? )
2130                 AND ( worker = ? OR worker = ? OR worker = ? )";
2131     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
2132
2133 Which you could then use in DBI code like so:
2134
2135     my $sth = $dbh->prepare($stmt);
2136     $sth->execute(@bind);
2137
2138 Easy, eh?
2139
2140 =head1 METHODS
2141
2142 The methods are simple. There's one for every major SQL operation,
2143 and a constructor you use first. The arguments are specified in a
2144 similar order for each method (table, then fields, then a where
2145 clause) to try and simplify things.
2146
2147 =head2 new(option => 'value')
2148
2149 The C<new()> function takes a list of options and values, and returns
2150 a new B<SQL::Abstract> object which can then be used to generate SQL
2151 through the methods below. The options accepted are:
2152
2153 =over
2154
2155 =item case
2156
2157 If set to 'lower', then SQL will be generated in all lowercase. By
2158 default SQL is generated in "textbook" case meaning something like:
2159
2160     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
2161
2162 Any setting other than 'lower' is ignored.
2163
2164 =item cmp
2165
2166 This determines what the default comparison operator is. By default
2167 it is C<=>, meaning that a hash like this:
2168
2169     %where = (name => 'nwiger', email => 'nate@wiger.org');
2170
2171 Will generate SQL like this:
2172
2173     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
2174
2175 However, you may want loose comparisons by default, so if you set
2176 C<cmp> to C<like> you would get SQL such as:
2177
2178     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
2179
2180 You can also override the comparison on an individual basis - see
2181 the huge section on L</"WHERE CLAUSES"> at the bottom.
2182
2183 =item sqltrue, sqlfalse
2184
2185 Expressions for inserting boolean values within SQL statements.
2186 By default these are C<1=1> and C<1=0>. They are used
2187 by the special operators C<-in> and C<-not_in> for generating
2188 correct SQL even when the argument is an empty array (see below).
2189
2190 =item logic
2191
2192 This determines the default logical operator for multiple WHERE
2193 statements in arrays or hashes. If absent, the default logic is "or"
2194 for arrays, and "and" for hashes. This means that a WHERE
2195 array of the form:
2196
2197     @where = (
2198         event_date => {'>=', '2/13/99'},
2199         event_date => {'<=', '4/24/03'},
2200     );
2201
2202 will generate SQL like this:
2203
2204     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
2205
2206 This is probably not what you want given this query, though (look
2207 at the dates). To change the "OR" to an "AND", simply specify:
2208
2209     my $sql = SQL::Abstract->new(logic => 'and');
2210
2211 Which will change the above C<WHERE> to:
2212
2213     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
2214
2215 The logic can also be changed locally by inserting
2216 a modifier in front of an arrayref:
2217
2218     @where = (-and => [event_date => {'>=', '2/13/99'},
2219                        event_date => {'<=', '4/24/03'} ]);
2220
2221 See the L</"WHERE CLAUSES"> section for explanations.
2222
2223 =item convert
2224
2225 This will automatically convert comparisons using the specified SQL
2226 function for both column and value. This is mostly used with an argument
2227 of C<upper> or C<lower>, so that the SQL will have the effect of
2228 case-insensitive "searches". For example, this:
2229
2230     $sql = SQL::Abstract->new(convert => 'upper');
2231     %where = (keywords => 'MaKe iT CAse inSeNSItive');
2232
2233 Will turn out the following SQL:
2234
2235     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
2236
2237 The conversion can be C<upper()>, C<lower()>, or any other SQL function
2238 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
2239 not validate this option; it will just pass through what you specify verbatim).
2240
2241 =item bindtype
2242
2243 This is a kludge because many databases suck. For example, you can't
2244 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
2245 Instead, you have to use C<bind_param()>:
2246
2247     $sth->bind_param(1, 'reg data');
2248     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
2249
2250 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
2251 which loses track of which field each slot refers to. Fear not.
2252
2253 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
2254 Currently, you can specify either C<normal> (default) or C<columns>. If you
2255 specify C<columns>, you will get an array that looks like this:
2256
2257     my $sql = SQL::Abstract->new(bindtype => 'columns');
2258     my($stmt, @bind) = $sql->insert(...);
2259
2260     @bind = (
2261         [ 'column1', 'value1' ],
2262         [ 'column2', 'value2' ],
2263         [ 'column3', 'value3' ],
2264     );
2265
2266 You can then iterate through this manually, using DBI's C<bind_param()>.
2267
2268     $sth->prepare($stmt);
2269     my $i = 1;
2270     for (@bind) {
2271         my($col, $data) = @$_;
2272         if ($col eq 'details' || $col eq 'comments') {
2273             $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
2274         } elsif ($col eq 'image') {
2275             $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
2276         } else {
2277             $sth->bind_param($i, $data);
2278         }
2279         $i++;
2280     }
2281     $sth->execute;      # execute without @bind now
2282
2283 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
2284 Basically, the advantage is still that you don't have to care which fields
2285 are or are not included. You could wrap that above C<for> loop in a simple
2286 sub called C<bind_fields()> or something and reuse it repeatedly. You still
2287 get a layer of abstraction over manual SQL specification.
2288
2289 Note that if you set L</bindtype> to C<columns>, the C<\[ $sql, @bind ]>
2290 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
2291 will expect the bind values in this format.
2292
2293 =item quote_char
2294
2295 This is the character that a table or column name will be quoted
2296 with.  By default this is an empty string, but you could set it to
2297 the character C<`>, to generate SQL like this:
2298
2299   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
2300
2301 Alternatively, you can supply an array ref of two items, the first being the left
2302 hand quote character, and the second the right hand quote character. For
2303 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
2304 that generates SQL like this:
2305
2306   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
2307
2308 Quoting is useful if you have tables or columns names that are reserved
2309 words in your database's SQL dialect.
2310
2311 =item escape_char
2312
2313 This is the character that will be used to escape L</quote_char>s appearing
2314 in an identifier before it has been quoted.
2315
2316 The parameter default in case of a single L</quote_char> character is the quote
2317 character itself.
2318
2319 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
2320 this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences
2321 of the B<opening (left)> L</quote_char> within the identifier are currently left
2322 untouched. The default for opening-closing-style quotes may change in future
2323 versions, thus you are B<strongly encouraged> to specify the escape character
2324 explicitly.
2325
2326 =item name_sep
2327
2328 This is the character that separates a table and column name.  It is
2329 necessary to specify this when the C<quote_char> option is selected,
2330 so that tables and column names can be individually quoted like this:
2331
2332   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
2333
2334 =item injection_guard
2335
2336 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
2337 column name specified in a query structure. This is a safety mechanism to avoid
2338 injection attacks when mishandling user input e.g.:
2339
2340   my %condition_as_column_value_pairs = get_values_from_user();
2341   $sqla->select( ... , \%condition_as_column_value_pairs );
2342
2343 If the expression matches an exception is thrown. Note that literal SQL
2344 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
2345
2346 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
2347
2348 =item array_datatypes
2349
2350 When this option is true, arrayrefs in INSERT or UPDATE are
2351 interpreted as array datatypes and are passed directly
2352 to the DBI layer.
2353 When this option is false, arrayrefs are interpreted
2354 as literal SQL, just like refs to arrayrefs
2355 (but this behavior is for backwards compatibility; when writing
2356 new queries, use the "reference to arrayref" syntax
2357 for literal SQL).
2358
2359
2360 =item special_ops
2361
2362 Takes a reference to a list of "special operators"
2363 to extend the syntax understood by L<SQL::Abstract>.
2364 See section L</"SPECIAL OPERATORS"> for details.
2365
2366 =item unary_ops
2367
2368 Takes a reference to a list of "unary operators"
2369 to extend the syntax understood by L<SQL::Abstract>.
2370 See section L</"UNARY OPERATORS"> for details.
2371
2372
2373
2374 =back
2375
2376 =head2 insert($table, \@values || \%fieldvals, \%options)
2377
2378 This is the simplest function. You simply give it a table name
2379 and either an arrayref of values or hashref of field/value pairs.
2380 It returns an SQL INSERT statement and a list of bind values.
2381 See the sections on L</"Inserting and Updating Arrays"> and
2382 L</"Inserting and Updating SQL"> for information on how to insert
2383 with those data types.
2384
2385 The optional C<\%options> hash reference may contain additional
2386 options to generate the insert SQL. Currently supported options
2387 are:
2388
2389 =over 4
2390
2391 =item returning
2392
2393 Takes either a scalar of raw SQL fields, or an array reference of
2394 field names, and adds on an SQL C<RETURNING> statement at the end.
2395 This allows you to return data generated by the insert statement
2396 (such as row IDs) without performing another C<SELECT> statement.
2397 Note, however, this is not part of the SQL standard and may not
2398 be supported by all database engines.
2399
2400 =back
2401
2402 =head2 update($table, \%fieldvals, \%where, \%options)
2403
2404 This takes a table, hashref of field/value pairs, and an optional
2405 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
2406 of bind values.
2407 See the sections on L</"Inserting and Updating Arrays"> and
2408 L</"Inserting and Updating SQL"> for information on how to insert
2409 with those data types.
2410
2411 The optional C<\%options> hash reference may contain additional
2412 options to generate the update SQL. Currently supported options
2413 are:
2414
2415 =over 4
2416
2417 =item returning
2418
2419 See the C<returning> option to
2420 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2421
2422 =back
2423
2424 =head2 select($source, $fields, $where, $order)
2425
2426 This returns a SQL SELECT statement and associated list of bind values, as
2427 specified by the arguments:
2428
2429 =over
2430
2431 =item $source
2432
2433 Specification of the 'FROM' part of the statement.
2434 The argument can be either a plain scalar (interpreted as a table
2435 name, will be quoted), or an arrayref (interpreted as a list
2436 of table names, joined by commas, quoted), or a scalarref
2437 (literal SQL, not quoted).
2438
2439 =item $fields
2440
2441 Specification of the list of fields to retrieve from
2442 the source.
2443 The argument can be either an arrayref (interpreted as a list
2444 of field names, will be joined by commas and quoted), or a
2445 plain scalar (literal SQL, not quoted).
2446 Please observe that this API is not as flexible as that of
2447 the first argument C<$source>, for backwards compatibility reasons.
2448
2449 =item $where
2450
2451 Optional argument to specify the WHERE part of the query.
2452 The argument is most often a hashref, but can also be
2453 an arrayref or plain scalar --
2454 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2455
2456 =item $order
2457
2458 Optional argument to specify the ORDER BY part of the query.
2459 The argument can be a scalar, a hashref or an arrayref
2460 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2461 for details.
2462
2463 =back
2464
2465
2466 =head2 delete($table, \%where, \%options)
2467
2468 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2469 It returns an SQL DELETE statement and list of bind values.
2470
2471 The optional C<\%options> hash reference may contain additional
2472 options to generate the delete SQL. Currently supported options
2473 are:
2474
2475 =over 4
2476
2477 =item returning
2478
2479 See the C<returning> option to
2480 L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
2481
2482 =back
2483
2484 =head2 where(\%where, $order)
2485
2486 This is used to generate just the WHERE clause. For example,
2487 if you have an arbitrary data structure and know what the
2488 rest of your SQL is going to look like, but want an easy way
2489 to produce a WHERE clause, use this. It returns an SQL WHERE
2490 clause and list of bind values.
2491
2492
2493 =head2 values(\%data)
2494
2495 This just returns the values from the hash C<%data>, in the same
2496 order that would be returned from any of the other above queries.
2497 Using this allows you to markedly speed up your queries if you
2498 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2499
2500 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2501
2502 Warning: This is an experimental method and subject to change.
2503
2504 This returns arbitrarily generated SQL. It's a really basic shortcut.
2505 It will return two different things, depending on return context:
2506
2507     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2508     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2509
2510 These would return the following:
2511
2512     # First calling form
2513     $stmt = "CREATE TABLE test (?, ?)";
2514     @bind = (field1, field2);
2515
2516     # Second calling form
2517     $stmt_and_val = "CREATE TABLE test (field1, field2)";
2518
2519 Depending on what you're trying to do, it's up to you to choose the correct
2520 format. In this example, the second form is what you would want.
2521
2522 By the same token:
2523
2524     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2525
2526 Might give you:
2527
2528     ALTER SESSION SET nls_date_format = 'MM/YY'
2529
2530 You get the idea. Strings get their case twiddled, but everything
2531 else remains verbatim.
2532
2533 =head1 EXPORTABLE FUNCTIONS
2534
2535 =head2 is_plain_value
2536
2537 Determines if the supplied argument is a plain value as understood by this
2538 module:
2539
2540 =over
2541
2542 =item * The value is C<undef>
2543
2544 =item * The value is a non-reference
2545
2546 =item * The value is an object with stringification overloading
2547
2548 =item * The value is of the form C<< { -value => $anything } >>
2549
2550 =back
2551
2552 On failure returns C<undef>, on success returns a B<scalar> reference
2553 to the original supplied argument.
2554
2555 =over
2556
2557 =item * Note
2558
2559 The stringification overloading detection is rather advanced: it takes
2560 into consideration not only the presence of a C<""> overload, but if that
2561 fails also checks for enabled
2562 L<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
2563 on either C<0+> or C<bool>.
2564
2565 Unfortunately testing in the field indicates that this
2566 detection B<< may tickle a latent bug in perl versions before 5.018 >>,
2567 but only when very large numbers of stringifying objects are involved.
2568 At the time of writing ( Sep 2014 ) there is no clear explanation of
2569 the direct cause, nor is there a manageably small test case that reliably
2570 reproduces the problem.
2571
2572 If you encounter any of the following exceptions in B<random places within
2573 your application stack> - this module may be to blame:
2574
2575   Operation "ne": no method found,
2576     left argument in overloaded package <something>,
2577     right argument in overloaded package <something>
2578
2579 or perhaps even
2580
2581   Stub found while resolving method "???" overloading """" in package <something>
2582
2583 If you fall victim to the above - please attempt to reduce the problem
2584 to something that could be sent to the L<SQL::Abstract developers
2585 |DBIx::Class/GETTING HELP/SUPPORT>
2586 (either publicly or privately). As a workaround in the meantime you can
2587 set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
2588 value, which will most likely eliminate your problem (at the expense of
2589 not being able to properly detect exotic forms of stringification).
2590
2591 This notice and environment variable will be removed in a future version,
2592 as soon as the underlying problem is found and a reliable workaround is
2593 devised.
2594
2595 =back
2596
2597 =head2 is_literal_value
2598
2599 Determines if the supplied argument is a literal value as understood by this
2600 module:
2601
2602 =over
2603
2604 =item * C<\$sql_string>
2605
2606 =item * C<\[ $sql_string, @bind_values ]>
2607
2608 =back
2609
2610 On failure returns C<undef>, on success returns an B<array> reference
2611 containing the unpacked version of the supplied literal SQL and bind values.
2612
2613 =head1 WHERE CLAUSES
2614
2615 =head2 Introduction
2616
2617 This module uses a variation on the idea from L<DBIx::Abstract>. It
2618 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2619 module is that things in arrays are OR'ed, and things in hashes
2620 are AND'ed.>
2621
2622 The easiest way to explain is to show lots of examples. After
2623 each C<%where> hash shown, it is assumed you used:
2624
2625     my($stmt, @bind) = $sql->where(\%where);
2626
2627 However, note that the C<%where> hash can be used directly in any
2628 of the other functions as well, as described above.
2629
2630 =head2 Key-value pairs
2631
2632 So, let's get started. To begin, a simple hash:
2633
2634     my %where  = (
2635         user   => 'nwiger',
2636         status => 'completed'
2637     );
2638
2639 Is converted to SQL C<key = val> statements:
2640
2641     $stmt = "WHERE user = ? AND status = ?";
2642     @bind = ('nwiger', 'completed');
2643
2644 One common thing I end up doing is having a list of values that
2645 a field can be in. To do this, simply specify a list inside of
2646 an arrayref:
2647
2648     my %where  = (
2649         user   => 'nwiger',
2650         status => ['assigned', 'in-progress', 'pending'];
2651     );
2652
2653 This simple code will create the following:
2654
2655     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2656     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2657
2658 A field associated to an empty arrayref will be considered a
2659 logical false and will generate 0=1.
2660
2661 =head2 Tests for NULL values
2662
2663 If the value part is C<undef> then this is converted to SQL <IS NULL>
2664
2665     my %where  = (
2666         user   => 'nwiger',
2667         status => undef,
2668     );
2669
2670 becomes:
2671
2672     $stmt = "WHERE user = ? AND status IS NULL";
2673     @bind = ('nwiger');
2674
2675 To test if a column IS NOT NULL:
2676
2677     my %where  = (
2678         user   => 'nwiger',
2679         status => { '!=', undef },
2680     );
2681
2682 =head2 Specific comparison operators
2683
2684 If you want to specify a different type of operator for your comparison,
2685 you can use a hashref for a given column:
2686
2687     my %where  = (
2688         user   => 'nwiger',
2689         status => { '!=', 'completed' }
2690     );
2691
2692 Which would generate:
2693
2694     $stmt = "WHERE user = ? AND status != ?";
2695     @bind = ('nwiger', 'completed');
2696
2697 To test against multiple values, just enclose the values in an arrayref:
2698
2699     status => { '=', ['assigned', 'in-progress', 'pending'] };
2700
2701 Which would give you:
2702
2703     "WHERE status = ? OR status = ? OR status = ?"
2704
2705
2706 The hashref can also contain multiple pairs, in which case it is expanded
2707 into an C<AND> of its elements:
2708
2709     my %where  = (
2710         user   => 'nwiger',
2711         status => { '!=', 'completed', -not_like => 'pending%' }
2712     );
2713
2714     # Or more dynamically, like from a form
2715     $where{user} = 'nwiger';
2716     $where{status}{'!='} = 'completed';
2717     $where{status}{'-not_like'} = 'pending%';
2718
2719     # Both generate this
2720     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2721     @bind = ('nwiger', 'completed', 'pending%');
2722
2723
2724 To get an OR instead, you can combine it with the arrayref idea:
2725
2726     my %where => (
2727          user => 'nwiger',
2728          priority => [ { '=', 2 }, { '>', 5 } ]
2729     );
2730
2731 Which would generate:
2732
2733     $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?";
2734     @bind = ('2', '5', 'nwiger');
2735
2736 If you want to include literal SQL (with or without bind values), just use a
2737 scalar reference or reference to an arrayref as the value:
2738
2739     my %where  = (
2740         date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2741         date_expires => { '<' => \"now()" }
2742     );
2743
2744 Which would generate:
2745
2746     $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2747     @bind = ('11/26/2008');
2748
2749
2750 =head2 Logic and nesting operators
2751
2752 In the example above,
2753 there is a subtle trap if you want to say something like
2754 this (notice the C<AND>):
2755
2756     WHERE priority != ? AND priority != ?
2757
2758 Because, in Perl you I<can't> do this:
2759
2760     priority => { '!=' => 2, '!=' => 1 }
2761
2762 As the second C<!=> key will obliterate the first. The solution
2763 is to use the special C<-modifier> form inside an arrayref:
2764
2765     priority => [ -and => {'!=', 2},
2766                           {'!=', 1} ]
2767
2768
2769 Normally, these would be joined by C<OR>, but the modifier tells it
2770 to use C<AND> instead. (Hint: You can use this in conjunction with the
2771 C<logic> option to C<new()> in order to change the way your queries
2772 work by default.) B<Important:> Note that the C<-modifier> goes
2773 B<INSIDE> the arrayref, as an extra first element. This will
2774 B<NOT> do what you think it might:
2775
2776     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
2777
2778 Here is a quick list of equivalencies, since there is some overlap:
2779
2780     # Same
2781     status => {'!=', 'completed', 'not like', 'pending%' }
2782     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2783
2784     # Same
2785     status => {'=', ['assigned', 'in-progress']}
2786     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2787     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2788
2789
2790
2791 =head2 Special operators: IN, BETWEEN, etc.
2792
2793 You can also use the hashref format to compare a list of fields using the
2794 C<IN> comparison operator, by specifying the list as an arrayref:
2795
2796     my %where  = (
2797         status   => 'completed',
2798         reportid => { -in => [567, 2335, 2] }
2799     );
2800
2801 Which would generate:
2802
2803     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2804     @bind = ('completed', '567', '2335', '2');
2805
2806 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2807 the same way.
2808
2809 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2810 (by default: C<1=0>). Similarly, C<< -not_in => [] >> generates
2811 'sqltrue' (by default: C<1=1>).
2812
2813 In addition to the array you can supply a chunk of literal sql or
2814 literal sql with bind:
2815
2816     my %where = {
2817       customer => { -in => \[
2818         'SELECT cust_id FROM cust WHERE balance > ?',
2819         2000,
2820       ],
2821       status => { -in => \'SELECT status_codes FROM states' },
2822     };
2823
2824 would generate:
2825
2826     $stmt = "WHERE (
2827           customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2828       AND status IN ( SELECT status_codes FROM states )
2829     )";
2830     @bind = ('2000');
2831
2832 Finally, if the argument to C<-in> is not a reference, it will be
2833 treated as a single-element array.
2834
2835 Another pair of operators is C<-between> and C<-not_between>,
2836 used with an arrayref of two values:
2837
2838     my %where  = (
2839         user   => 'nwiger',
2840         completion_date => {
2841            -not_between => ['2002-10-01', '2003-02-06']
2842         }
2843     );
2844
2845 Would give you:
2846
2847     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2848
2849 Just like with C<-in> all plausible combinations of literal SQL
2850 are possible:
2851
2852     my %where = {
2853       start0 => { -between => [ 1, 2 ] },
2854       start1 => { -between => \["? AND ?", 1, 2] },
2855       start2 => { -between => \"lower(x) AND upper(y)" },
2856       start3 => { -between => [
2857         \"lower(x)",
2858         \["upper(?)", 'stuff' ],
2859       ] },
2860     };
2861
2862 Would give you:
2863
2864     $stmt = "WHERE (
2865           ( start0 BETWEEN ? AND ?                )
2866       AND ( start1 BETWEEN ? AND ?                )
2867       AND ( start2 BETWEEN lower(x) AND upper(y)  )
2868       AND ( start3 BETWEEN lower(x) AND upper(?)  )
2869     )";
2870     @bind = (1, 2, 1, 2, 'stuff');
2871
2872
2873 These are the two builtin "special operators"; but the
2874 list can be expanded: see section L</"SPECIAL OPERATORS"> below.
2875
2876 =head2 Unary operators: bool
2877
2878 If you wish to test against boolean columns or functions within your
2879 database you can use the C<-bool> and C<-not_bool> operators. For
2880 example to test the column C<is_user> being true and the column
2881 C<is_enabled> being false you would use:-
2882
2883     my %where  = (
2884         -bool       => 'is_user',
2885         -not_bool   => 'is_enabled',
2886     );
2887
2888 Would give you:
2889
2890     WHERE is_user AND NOT is_enabled
2891
2892 If a more complex combination is required, testing more conditions,
2893 then you should use the and/or operators:-
2894
2895     my %where  = (
2896         -and           => [
2897             -bool      => 'one',
2898             -not_bool  => { two=> { -rlike => 'bar' } },
2899             -not_bool  => { three => [ { '=', 2 }, { '>', 5 } ] },
2900         ],
2901     );
2902
2903 Would give you:
2904
2905     WHERE
2906       one
2907         AND
2908       (NOT two RLIKE ?)
2909         AND
2910       (NOT ( three = ? OR three > ? ))
2911
2912
2913 =head2 Nested conditions, -and/-or prefixes
2914
2915 So far, we've seen how multiple conditions are joined with a top-level
2916 C<AND>.  We can change this by putting the different conditions we want in
2917 hashes and then putting those hashes in an array. For example:
2918
2919     my @where = (
2920         {
2921             user   => 'nwiger',
2922             status => { -like => ['pending%', 'dispatched'] },
2923         },
2924         {
2925             user   => 'robot',
2926             status => 'unassigned',
2927         }
2928     );
2929
2930 This data structure would create the following:
2931
2932     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2933                 OR ( user = ? AND status = ? ) )";
2934     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2935
2936
2937 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2938 to change the logic inside:
2939
2940     my @where = (
2941          -and => [
2942             user => 'nwiger',
2943             [
2944                 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2945                 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2946             ],
2947         ],
2948     );
2949
2950 That would yield:
2951
2952     $stmt = "WHERE ( user = ?
2953                AND ( ( workhrs > ? AND geo = ? )
2954                   OR ( workhrs < ? OR geo = ? ) ) )";
2955     @bind = ('nwiger', '20', 'ASIA', '50', 'EURO');
2956
2957 =head3 Algebraic inconsistency, for historical reasons
2958
2959 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2960 operator goes C<outside> of the nested structure; whereas when connecting
2961 several constraints on one column, the C<-and> operator goes
2962 C<inside> the arrayref. Here is an example combining both features:
2963
2964    my @where = (
2965      -and => [a => 1, b => 2],
2966      -or  => [c => 3, d => 4],
2967       e   => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2968    )
2969
2970 yielding
2971
2972   WHERE ( (    ( a = ? AND b = ? )
2973             OR ( c = ? OR d = ? )
2974             OR ( e LIKE ? AND e LIKE ? ) ) )
2975
2976 This difference in syntax is unfortunate but must be preserved for
2977 historical reasons. So be careful: the two examples below would
2978 seem algebraically equivalent, but they are not
2979
2980   { col => [ -and =>
2981     { -like => 'foo%' },
2982     { -like => '%bar' },
2983   ] }
2984   # yields: WHERE ( ( col LIKE ? AND col LIKE ? ) )
2985
2986   [ -and =>
2987     { col => { -like => 'foo%' } },
2988     { col => { -like => '%bar' } },
2989   ]
2990   # yields: WHERE ( ( col LIKE ? OR col LIKE ? ) )
2991
2992
2993 =head2 Literal SQL and value type operators
2994
2995 The basic premise of SQL::Abstract is that in WHERE specifications the "left
2996 side" is a column name and the "right side" is a value (normally rendered as
2997 a placeholder). This holds true for both hashrefs and arrayref pairs as you
2998 see in the L</WHERE CLAUSES> examples above. Sometimes it is necessary to
2999 alter this behavior. There are several ways of doing so.
3000
3001 =head3 -ident
3002
3003 This is a virtual operator that signals the string to its right side is an
3004 identifier (a column name) and not a value. For example to compare two
3005 columns you would write:
3006
3007     my %where = (
3008         priority => { '<', 2 },
3009         requestor => { -ident => 'submitter' },
3010     );
3011
3012 which creates:
3013
3014     $stmt = "WHERE priority < ? AND requestor = submitter";
3015     @bind = ('2');
3016
3017 If you are maintaining legacy code you may see a different construct as
3018 described in L</Deprecated usage of Literal SQL>, please use C<-ident> in new
3019 code.
3020
3021 =head3 -value
3022
3023 This is a virtual operator that signals that the construct to its right side
3024 is a value to be passed to DBI. This is for example necessary when you want
3025 to write a where clause against an array (for RDBMS that support such
3026 datatypes). For example:
3027
3028     my %where = (
3029         array => { -value => [1, 2, 3] }
3030     );
3031
3032 will result in:
3033
3034     $stmt = 'WHERE array = ?';
3035     @bind = ([1, 2, 3]);
3036
3037 Note that if you were to simply say:
3038
3039     my %where = (
3040         array => [1, 2, 3]
3041     );
3042
3043 the result would probably not be what you wanted:
3044
3045     $stmt = 'WHERE array = ? OR array = ? OR array = ?';
3046     @bind = (1, 2, 3);
3047
3048 =head3 Literal SQL
3049
3050 Finally, sometimes only literal SQL will do. To include a random snippet
3051 of SQL verbatim, you specify it as a scalar reference. Consider this only
3052 as a last resort. Usually there is a better way. For example:
3053
3054     my %where = (
3055         priority => { '<', 2 },
3056         requestor => { -in => \'(SELECT name FROM hitmen)' },
3057     );
3058
3059 Would create:
3060
3061     $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)"
3062     @bind = (2);
3063
3064 Note that in this example, you only get one bind parameter back, since
3065 the verbatim SQL is passed as part of the statement.
3066
3067 =head4 CAVEAT
3068
3069   Never use untrusted input as a literal SQL argument - this is a massive
3070   security risk (there is no way to check literal snippets for SQL
3071   injections and other nastyness). If you need to deal with untrusted input
3072   use literal SQL with placeholders as described next.
3073
3074 =head3 Literal SQL with placeholders and bind values (subqueries)
3075
3076 If the literal SQL to be inserted has placeholders and bind values,
3077 use a reference to an arrayref (yes this is a double reference --
3078 not so common, but perfectly legal Perl). For example, to find a date
3079 in Postgres you can use something like this:
3080
3081     my %where = (
3082        date_column => \[ "= date '2008-09-30' - ?::integer", 10 ]
3083     )
3084
3085 This would create:
3086
3087     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
3088     @bind = ('10');
3089
3090 Note that you must pass the bind values in the same format as they are returned
3091 by L<where|/where(\%where, $order)>. This means that if you set L</bindtype>
3092 to C<columns>, you must provide the bind values in the
3093 C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque
3094 scalar value; most commonly the column name, but you can use any scalar value
3095 (including references and blessed references), L<SQL::Abstract> will simply
3096 pass it through intact. So if C<bindtype> is set to C<columns> the above
3097 example will look like:
3098
3099     my %where = (
3100        date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ]
3101     )
3102
3103 Literal SQL is especially useful for nesting parenthesized clauses in the
3104 main SQL query. Here is a first example:
3105
3106   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
3107                                100, "foo%");
3108   my %where = (
3109     foo => 1234,
3110     bar => \["IN ($sub_stmt)" => @sub_bind],
3111   );
3112
3113 This yields:
3114
3115   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
3116                                              WHERE c2 < ? AND c3 LIKE ?))";
3117   @bind = (1234, 100, "foo%");
3118
3119 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
3120 are expressed in the same way. Of course the C<$sub_stmt> and
3121 its associated bind values can be generated through a former call
3122 to C<select()> :
3123
3124   my ($sub_stmt, @sub_bind)
3125      = $sql->select("t1", "c1", {c2 => {"<" => 100},
3126                                  c3 => {-like => "foo%"}});
3127   my %where = (
3128     foo => 1234,
3129     bar => \["> ALL ($sub_stmt)" => @sub_bind],
3130   );
3131
3132 In the examples above, the subquery was used as an operator on a column;
3133 but the same principle also applies for a clause within the main C<%where>
3134 hash, like an EXISTS subquery:
3135
3136   my ($sub_stmt, @sub_bind)
3137      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
3138   my %where = ( -and => [
3139     foo   => 1234,
3140     \["EXISTS ($sub_stmt)" => @sub_bind],
3141   ]);
3142
3143 which yields
3144
3145   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
3146                                         WHERE c1 = ? AND c2 > t0.c0))";
3147   @bind = (1234, 1);
3148
3149
3150 Observe that the condition on C<c2> in the subquery refers to
3151 column C<t0.c0> of the main query: this is I<not> a bind
3152 value, so we have to express it through a scalar ref.
3153 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
3154 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
3155 what we wanted here.
3156
3157 Finally, here is an example where a subquery is used
3158 for expressing unary negation:
3159
3160   my ($sub_stmt, @sub_bind)
3161      = $sql->where({age => [{"<" => 10}, {">" => 20}]});
3162   $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
3163   my %where = (
3164         lname  => {like => '%son%'},
3165         \["NOT ($sub_stmt)" => @sub_bind],
3166     );
3167
3168 This yields
3169
3170   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
3171   @bind = ('%son%', 10, 20)
3172
3173 =head3 Deprecated usage of Literal SQL
3174
3175 Below are some examples of archaic use of literal SQL. It is shown only as
3176 reference for those who deal with legacy code. Each example has a much
3177 better, cleaner and safer alternative that users should opt for in new code.
3178
3179 =over
3180
3181 =item *
3182
3183     my %where = ( requestor => \'IS NOT NULL' )
3184
3185     $stmt = "WHERE requestor IS NOT NULL"
3186
3187 This used to be the way of generating NULL comparisons, before the handling
3188 of C<undef> got formalized. For new code please use the superior syntax as
3189 described in L</Tests for NULL values>.
3190
3191 =item *
3192
3193     my %where = ( requestor => \'= submitter' )
3194
3195     $stmt = "WHERE requestor = submitter"
3196
3197 This used to be the only way to compare columns. Use the superior L</-ident>
3198 method for all new code. For example an identifier declared in such a way
3199 will be properly quoted if L</quote_char> is properly set, while the legacy
3200 form will remain as supplied.
3201
3202 =item *
3203
3204     my %where = ( is_ready  => \"", completed => { '>', '2012-12-21' } )
3205
3206     $stmt = "WHERE completed > ? AND is_ready"
3207     @bind = ('2012-12-21')
3208
3209 Using an empty string literal used to be the only way to express a boolean.
3210 For all new code please use the much more readable
3211 L<-bool|/Unary operators: bool> operator.
3212
3213 =back
3214
3215 =head2 Conclusion
3216
3217 These pages could go on for a while, since the nesting of the data
3218 structures this module can handle are pretty much unlimited (the
3219 module implements the C<WHERE> expansion as a recursive function
3220 internally). Your best bet is to "play around" with the module a
3221 little to see how the data structures behave, and choose the best
3222 format for your data based on that.
3223
3224 And of course, all the values above will probably be replaced with
3225 variables gotten from forms or the command line. After all, if you
3226 knew everything ahead of time, you wouldn't have to worry about
3227 dynamically-generating SQL and could just hardwire it into your
3228 script.
3229
3230 =head1 ORDER BY CLAUSES
3231
3232 Some functions take an order by clause. This can either be a scalar (just a
3233 column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' }
3234 >>, a scalarref, an arrayref-ref, or an arrayref of any of the previous
3235 forms. Examples:
3236
3237                Given              |         Will Generate
3238     ---------------------------------------------------------------
3239                                   |
3240     'colA'                        | ORDER BY colA
3241                                   |
3242     [qw/colA colB/]               | ORDER BY colA, colB
3243                                   |
3244     {-asc  => 'colA'}             | ORDER BY colA ASC
3245                                   |
3246     {-desc => 'colB'}             | ORDER BY colB DESC
3247                                   |
3248     ['colA', {-asc => 'colB'}]    | ORDER BY colA, colB ASC
3249                                   |
3250     { -asc => [qw/colA colB/] }   | ORDER BY colA ASC, colB ASC
3251                                   |
3252     \'colA DESC'                  | ORDER BY colA DESC
3253                                   |
3254     \[ 'FUNC(colA, ?)', $x ]      | ORDER BY FUNC(colA, ?)
3255                                   |   /* ...with $x bound to ? */
3256                                   |
3257     [                             | ORDER BY
3258       { -asc => 'colA' },         |     colA ASC,
3259       { -desc => [qw/colB/] },    |     colB DESC,
3260       { -asc => [qw/colC colD/] },|     colC ASC, colD ASC,
3261       \'colE DESC',               |     colE DESC,
3262       \[ 'FUNC(colF, ?)', $x ],   |     FUNC(colF, ?)
3263     ]                             |   /* ...with $x bound to ? */
3264     ===============================================================
3265
3266
3267
3268 =head1 SPECIAL OPERATORS
3269
3270   my $sqlmaker = SQL::Abstract->new(special_ops => [
3271      {
3272       regex => qr/.../,
3273       handler => sub {
3274         my ($self, $field, $op, $arg) = @_;
3275         ...
3276       },
3277      },
3278      {
3279       regex => qr/.../,
3280       handler => 'method_name',
3281      },
3282    ]);
3283
3284 A "special operator" is a SQL syntactic clause that can be
3285 applied to a field, instead of a usual binary operator.
3286 For example:
3287
3288    WHERE field IN (?, ?, ?)
3289    WHERE field BETWEEN ? AND ?
3290    WHERE MATCH(field) AGAINST (?, ?)
3291
3292 Special operators IN and BETWEEN are fairly standard and therefore
3293 are builtin within C<SQL::Abstract> (as the overridable methods
3294 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
3295 like the MATCH .. AGAINST example above which is specific to MySQL,
3296 you can write your own operator handlers - supply a C<special_ops>
3297 argument to the C<new> method. That argument takes an arrayref of
3298 operator definitions; each operator definition is a hashref with two
3299 entries:
3300
3301 =over
3302
3303 =item regex
3304
3305 the regular expression to match the operator
3306
3307 =item handler
3308
3309 Either a coderef or a plain scalar method name. In both cases
3310 the expected return is C<< ($sql, @bind) >>.
3311
3312 When supplied with a method name, it is simply called on the
3313 L<SQL::Abstract> object as:
3314
3315  $self->$method_name($field, $op, $arg)
3316
3317  Where:
3318
3319   $field is the LHS of the operator
3320   $op is the part that matched the handler regex
3321   $arg is the RHS
3322
3323 When supplied with a coderef, it is called as:
3324
3325  $coderef->($self, $field, $op, $arg)
3326
3327
3328 =back
3329
3330 For example, here is an implementation
3331 of the MATCH .. AGAINST syntax for MySQL
3332
3333   my $sqlmaker = SQL::Abstract->new(special_ops => [
3334
3335     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
3336     {regex => qr/^match$/i,
3337      handler => sub {
3338        my ($self, $field, $op, $arg) = @_;
3339        $arg = [$arg] if not ref $arg;
3340        my $label         = $self->_quote($field);
3341        my ($placeholder) = $self->_convert('?');
3342        my $placeholders  = join ", ", (($placeholder) x @$arg);
3343        my $sql           = $self->_sqlcase('match') . " ($label) "
3344                          . $self->_sqlcase('against') . " ($placeholders) ";
3345        my @bind = $self->_bindtype($field, @$arg);
3346        return ($sql, @bind);
3347        }
3348      },
3349
3350   ]);
3351
3352
3353 =head1 UNARY OPERATORS
3354
3355   my $sqlmaker = SQL::Abstract->new(unary_ops => [
3356      {
3357       regex => qr/.../,
3358       handler => sub {
3359         my ($self, $op, $arg) = @_;
3360         ...
3361       },
3362      },
3363      {
3364       regex => qr/.../,
3365       handler => 'method_name',
3366      },
3367    ]);
3368
3369 A "unary operator" is a SQL syntactic clause that can be
3370 applied to a field - the operator goes before the field
3371
3372 You can write your own operator handlers - supply a C<unary_ops>
3373 argument to the C<new> method. That argument takes an arrayref of
3374 operator definitions; each operator definition is a hashref with two
3375 entries:
3376
3377 =over
3378
3379 =item regex
3380
3381 the regular expression to match the operator
3382
3383 =item handler
3384
3385 Either a coderef or a plain scalar method name. In both cases
3386 the expected return is C<< $sql >>.
3387
3388 When supplied with a method name, it is simply called on the
3389 L<SQL::Abstract> object as:
3390
3391  $self->$method_name($op, $arg)
3392
3393  Where:
3394
3395   $op is the part that matched the handler regex
3396   $arg is the RHS or argument of the operator
3397
3398 When supplied with a coderef, it is called as:
3399
3400  $coderef->($self, $op, $arg)
3401
3402
3403 =back
3404
3405
3406 =head1 PERFORMANCE
3407
3408 Thanks to some benchmarking by Mark Stosberg, it turns out that
3409 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
3410 I must admit this wasn't an intentional design issue, but it's a
3411 byproduct of the fact that you get to control your C<DBI> handles
3412 yourself.
3413
3414 To maximize performance, use a code snippet like the following:
3415
3416     # prepare a statement handle using the first row
3417     # and then reuse it for the rest of the rows
3418     my($sth, $stmt);
3419     for my $href (@array_of_hashrefs) {
3420         $stmt ||= $sql->insert('table', $href);
3421         $sth  ||= $dbh->prepare($stmt);
3422         $sth->execute($sql->values($href));
3423     }
3424
3425 The reason this works is because the keys in your C<$href> are sorted
3426 internally by B<SQL::Abstract>. Thus, as long as your data retains
3427 the same structure, you only have to generate the SQL the first time
3428 around. On subsequent queries, simply use the C<values> function provided
3429 by this module to return your values in the correct order.
3430
3431 However this depends on the values having the same type - if, for
3432 example, the values of a where clause may either have values
3433 (resulting in sql of the form C<column = ?> with a single bind
3434 value), or alternatively the values might be C<undef> (resulting in
3435 sql of the form C<column IS NULL> with no bind value) then the
3436 caching technique suggested will not work.
3437
3438 =head1 FORMBUILDER
3439
3440 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
3441 really like this part (I do, at least). Building up a complex query
3442 can be as simple as the following:
3443
3444     #!/usr/bin/perl
3445
3446     use warnings;
3447     use strict;
3448
3449     use CGI::FormBuilder;
3450     use SQL::Abstract;
3451
3452     my $form = CGI::FormBuilder->new(...);
3453     my $sql  = SQL::Abstract->new;
3454
3455     if ($form->submitted) {
3456         my $field = $form->field;
3457         my $id = delete $field->{id};
3458         my($stmt, @bind) = $sql->update('table', $field, {id => $id});
3459     }
3460
3461 Of course, you would still have to connect using C<DBI> to run the
3462 query, but the point is that if you make your form look like your
3463 table, the actual query script can be extremely simplistic.
3464
3465 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
3466 a fast interface to returning and formatting data. I frequently
3467 use these three modules together to write complex database query
3468 apps in under 50 lines.
3469
3470 =head1 HOW TO CONTRIBUTE
3471
3472 Contributions are always welcome, in all usable forms (we especially
3473 welcome documentation improvements). The delivery methods include git-
3474 or unified-diff formatted patches, GitHub pull requests, or plain bug
3475 reports either via RT or the Mailing list. Contributors are generally
3476 granted full access to the official repository after their first several
3477 patches pass successful review.
3478
3479 This project is maintained in a git repository. The code and related tools are
3480 accessible at the following locations:
3481
3482 =over
3483
3484 =item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git>
3485
3486 =item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Abstract.git>
3487
3488 =item * GitHub mirror: L<https://github.com/dbsrgits/sql-abstract>
3489
3490 =item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/SQL-Abstract.git>
3491
3492 =back
3493
3494 =head1 CHANGES
3495
3496 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
3497 Great care has been taken to preserve the I<published> behavior
3498 documented in previous versions in the 1.* family; however,
3499 some features that were previously undocumented, or behaved
3500 differently from the documentation, had to be changed in order
3501 to clarify the semantics. Hence, client code that was relying
3502 on some dark areas of C<SQL::Abstract> v1.*
3503 B<might behave differently> in v1.50.
3504
3505 The main changes are:
3506
3507 =over
3508
3509 =item *
3510
3511 support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax.
3512
3513 =item *
3514
3515 support for the { operator => \"..." } construct (to embed literal SQL)
3516
3517 =item *
3518
3519 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
3520
3521 =item *
3522
3523 optional support for L<array datatypes|/"Inserting and Updating Arrays">
3524
3525 =item *
3526
3527 defensive programming: check arguments
3528
3529 =item *
3530
3531 fixed bug with global logic, which was previously implemented
3532 through global variables yielding side-effects. Prior versions would
3533 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
3534 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
3535 Now this is interpreted
3536 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
3537
3538
3539 =item *
3540
3541 fixed semantics of  _bindtype on array args
3542
3543 =item *
3544
3545 dropped the C<_anoncopy> of the %where tree. No longer necessary,
3546 we just avoid shifting arrays within that tree.
3547
3548 =item *
3549
3550 dropped the C<_modlogic> function
3551
3552 =back
3553
3554 =head1 ACKNOWLEDGEMENTS
3555
3556 There are a number of individuals that have really helped out with
3557 this module. Unfortunately, most of them submitted bugs via CPAN
3558 so I have no idea who they are! But the people I do know are:
3559
3560     Ash Berlin (order_by hash term support)
3561     Matt Trout (DBIx::Class support)
3562     Mark Stosberg (benchmarking)
3563     Chas Owens (initial "IN" operator support)
3564     Philip Collins (per-field SQL functions)
3565     Eric Kolve (hashref "AND" support)
3566     Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
3567     Dan Kubb (support for "quote_char" and "name_sep")
3568     Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
3569     Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
3570     Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
3571     Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
3572     Oliver Charles (support for "RETURNING" after "INSERT")
3573
3574 Thanks!
3575
3576 =head1 SEE ALSO
3577
3578 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
3579
3580 =head1 AUTHOR
3581
3582 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
3583
3584 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
3585
3586 For support, your best bet is to try the C<DBIx::Class> users mailing list.
3587 While not an official support venue, C<DBIx::Class> makes heavy use of
3588 C<SQL::Abstract>, and as such list members there are very familiar with
3589 how to create queries.
3590
3591 =head1 LICENSE
3592
3593 This module is free software; you may copy this under the same
3594 terms as perl itself (either the GNU General Public License or
3595 the Artistic License)
3596
3597 =cut