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