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