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