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