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