lib/SQL/Abstract.pm

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