lib/SQL/Abstract.pm

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