lib/SQL/Abstract.pm

   1 package SQL::Abstract; # see doc at end of file
   2
   3 # LDNOTE : this code is heavy refactoring from original SQLA.
   4 # Several design decisions will need discussion during
   5 # the test / diffusion / acceptance phase; those are marked with flag
   6 # 'LDNOTE' (note by laurent.dami AT free.fr)
   7
   8 use Carp;
   9 use strict;
  10 use warnings;
  11 use List::Util   qw/first/;
  12 use Scalar::Util qw/blessed/;
  13
  14 #======================================================================
  15 # GLOBALS
  16 #======================================================================
  17
  18 our $VERSION  = '1.50';
  19
  20 # This would confuse some packagers
  21 #$VERSION      = eval $VERSION; # numify for warning-free dev releases
  22
  23 our $AUTOLOAD;
  24
  25 # special operators (-in, -between). May be extended/overridden by user.
  26 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
  27 my @BUILTIN_SPECIAL_OPS = (
  28   {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
  29   {regex => qr/^(not )?in$/i,      handler => \&_where_field_IN},
  30 );
  31
  32 #======================================================================
  33 # DEBUGGING AND ERROR REPORTING
  34 #======================================================================
  35
  36 sub _debug {
  37   return unless $_[0]->{debug}; shift; # a little faster
  38   my $func = (caller(1))[3];
  39   warn "[$func] ", @_, "\n";
  40 }
  41
  42 sub belch (@) {
  43   my($func) = (caller(1))[3];
  44   carp "[$func] Warning: ", @_;
  45 }
  46
  47 sub puke (@) {
  48   my($func) = (caller(1))[3];
  49   croak "[$func] Fatal: ", @_;
  50 }
  51
  52
  53 #======================================================================
  54 # NEW
  55 #======================================================================
  56
  57 sub new {
  58   my $self = shift;
  59   my $class = ref($self) || $self;
  60   my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
  61
  62   # choose our case by keeping an option around
  63   delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
  64
  65   # default logic for interpreting arrayrefs
  66   $opt{logic} = uc $opt{logic} || 'OR';
  67
  68   # how to return bind vars
  69   # LDNOTE: changed nwiger code : why this 'delete' ??
  70   # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
  71   $opt{bindtype} ||= 'normal';
  72
  73   # default comparison is "=", but can be overridden
  74   $opt{cmp} ||= '=';
  75
  76   # try to recognize which are the 'equality' and 'unequality' ops
  77   # (temporary quickfix, should go through a more seasoned API)
  78  $opt{equality_op}   = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
  79  $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
  80
  81   # SQL booleans
  82   $opt{sqltrue}  ||= '1=1';
  83   $opt{sqlfalse} ||= '0=1';
  84
  85   # special operators
  86   $opt{special_ops} ||= [];
  87   push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
  88
  89   return bless \%opt, $class;
  90 }
  91
  92
  93
  94 #======================================================================
  95 # INSERT methods
  96 #======================================================================
  97
  98 sub insert {
  99   my $self  = shift;
 100   my $table = $self->_table(shift);
 101   my $data  = shift || return;
 102
 103   my $method       = $self->_METHOD_FOR_refkind("_insert", $data);
 104   my ($sql, @bind) = $self->$method($data);
 105   $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
 106   return wantarray ? ($sql, @bind) : $sql;
 107 }
 108
 109 sub _insert_HASHREF { # explicit list of fields and then values
 110   my ($self, $data) = @_;
 111
 112   my @fields = sort keys %$data;
 113
 114   my ($sql, @bind) = $self->_insert_values($data);
 115
 116   # assemble SQL
 117   $_ = $self->_quote($_) foreach @fields;
 118   $sql = "( ".join(", ", @fields).") ".$sql;
 119
 120   return ($sql, @bind);
 121 }
 122
 123 sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
 124   my ($self, $data) = @_;
 125
 126   # no names (arrayref) so can't generate bindtype
 127   $self->{bindtype} ne 'columns'
 128     or belch "can't do 'columns' bindtype when called with arrayref";
 129
 130   # fold the list of values into a hash of column name - value pairs
 131   # (where the column names are artificially generated, and their
 132   # lexicographical ordering keep the ordering of the original list)
 133   my $i = "a";  # incremented values will be in lexicographical order
 134   my $data_in_hash = { map { ($i++ => $_) } @$data };
 135
 136   return $self->_insert_values($data_in_hash);
 137 }
 138
 139 sub _insert_ARRAYREFREF { # literal SQL with bind
 140   my ($self, $data) = @_;
 141
 142   my ($sql, @bind) = @${$data};
 143   $self->_assert_bindval_matches_bindtype(@bind);
 144
 145   return ($sql, @bind);
 146 }
 147
 148
 149 sub _insert_SCALARREF { # literal SQL without bind
 150   my ($self, $data) = @_;
 151
 152   return ($$data);
 153 }
 154
 155 sub _insert_values {
 156   my ($self, $data) = @_;
 157
 158   my (@values, @all_bind);
 159   foreach my $column (sort keys %$data) {
 160     my $v = $data->{$column};
 161
 162     $self->_SWITCH_refkind($v, {
 163
 164       ARRAYREF => sub {
 165         if ($self->{array_datatypes}) { # if array datatype are activated
 166           push @values, '?';
 167           push @all_bind, $self->_bindtype($column, $v);
 168         }
 169         else {                          # else literal SQL with bind
 170           my ($sql, @bind) = @$v;
 171           $self->_assert_bindval_matches_bindtype(@bind);
 172           push @values, $sql;
 173           push @all_bind, @bind;
 174         }
 175       },
 176
 177       ARRAYREFREF => sub { # literal SQL with bind
 178         my ($sql, @bind) = @${$v};
 179         $self->_assert_bindval_matches_bindtype(@bind);
 180         push @values, $sql;
 181         push @all_bind, @bind;
 182       },
 183
 184       # THINK : anything useful to do with a HASHREF ?
 185       HASHREF => sub {  # (nothing, but old SQLA passed it through)
 186         #TODO in SQLA >= 2.0 it will die instead
 187         belch "HASH ref as bind value in insert is not supported";
 188         push @values, '?';
 189         push @all_bind, $self->_bindtype($column, $v);
 190       },
 191
 192       SCALARREF => sub {  # literal SQL without bind
 193         push @values, $$v;
 194       },
 195
 196       SCALAR_or_UNDEF => sub {
 197         push @values, '?';
 198         push @all_bind, $self->_bindtype($column, $v);
 199       },
 200
 201      });
 202
 203   }
 204
 205   my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
 206   return ($sql, @all_bind);
 207 }
 208
 209
 210
 211 #======================================================================
 212 # UPDATE methods
 213 #======================================================================
 214
 215
 216 sub update {
 217   my $self  = shift;
 218   my $table = $self->_table(shift);
 219   my $data  = shift || return;
 220   my $where = shift;
 221
 222   # first build the 'SET' part of the sql statement
 223   my (@set, @all_bind);
 224   puke "Unsupported data type specified to \$sql->update"
 225     unless ref $data eq 'HASH';
 226
 227   for my $k (sort keys %$data) {
 228     my $v = $data->{$k};
 229     my $r = ref $v;
 230     my $label = $self->_quote($k);
 231
 232     $self->_SWITCH_refkind($v, {
 233       ARRAYREF => sub {
 234         if ($self->{array_datatypes}) { # array datatype
 235           push @set, "$label = ?";
 236           push @all_bind, $self->_bindtype($k, $v);
 237         }
 238         else {                          # literal SQL with bind
 239           my ($sql, @bind) = @$v;
 240           $self->_assert_bindval_matches_bindtype(@bind);
 241           push @set, "$label = $sql";
 242           push @all_bind, @bind;
 243         }
 244       },
 245       ARRAYREFREF => sub { # literal SQL with bind
 246         my ($sql, @bind) = @${$v};
 247         $self->_assert_bindval_matches_bindtype(@bind);
 248         push @set, "$label = $sql";
 249         push @all_bind, @bind;
 250       },
 251       SCALARREF => sub {  # literal SQL without bind
 252         push @set, "$label = $$v";
 253        },
 254       SCALAR_or_UNDEF => sub {
 255         push @set, "$label = ?";
 256         push @all_bind, $self->_bindtype($k, $v);
 257       },
 258     });
 259   }
 260
 261   # generate sql
 262   my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
 263           . join ', ', @set;
 264
 265   if ($where) {
 266     my($where_sql, @where_bind) = $self->where($where);
 267     $sql .= $where_sql;
 268     push @all_bind, @where_bind;
 269   }
 270
 271   return wantarray ? ($sql, @all_bind) : $sql;
 272 }
 273
 274
 275
 276
 277 #======================================================================
 278 # SELECT
 279 #======================================================================
 280
 281
 282 sub select {
 283   my $self   = shift;
 284   my $table  = $self->_table(shift);
 285   my $fields = shift || '*';
 286   my $where  = shift;
 287   my $order  = shift;
 288
 289   my($where_sql, @bind) = $self->where($where, $order);
 290
 291   my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
 292                                    : $fields;
 293   my $sql = join(' ', $self->_sqlcase('select'), $f,
 294                       $self->_sqlcase('from'),   $table)
 295           . $where_sql;
 296
 297   return wantarray ? ($sql, @bind) : $sql;
 298 }
 299
 300 #======================================================================
 301 # DELETE
 302 #======================================================================
 303
 304
 305 sub delete {
 306   my $self  = shift;
 307   my $table = $self->_table(shift);
 308   my $where = shift;
 309
 310
 311   my($where_sql, @bind) = $self->where($where);
 312   my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
 313
 314   return wantarray ? ($sql, @bind) : $sql;
 315 }
 316
 317
 318 #======================================================================
 319 # WHERE: entry point
 320 #======================================================================
 321
 322
 323
 324 # Finally, a separate routine just to handle WHERE clauses
 325 sub where {
 326   my ($self, $where, $order) = @_;
 327
 328   # where ?
 329   my ($sql, @bind) = $self->_recurse_where($where);
 330   $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
 331
 332   # order by?
 333   if ($order) {
 334     $sql .= $self->_order_by($order);
 335   }
 336
 337   return wantarray ? ($sql, @bind) : $sql;
 338 }
 339
 340
 341 sub _recurse_where {
 342   my ($self, $where, $logic) = @_;
 343
 344   # dispatch on appropriate method according to refkind of $where
 345   my $method = $self->_METHOD_FOR_refkind("_where", $where);
 346
 347
 348   my ($sql, @bind) =  $self->$method($where, $logic);
 349
 350   # DBIx::Class directly calls _recurse_where in scalar context, so
 351   # we must implement it, even if not in the official API
 352   return wantarray ? ($sql, @bind) : $sql;
 353 }
 354
 355
 356
 357 #======================================================================
 358 # WHERE: top-level ARRAYREF
 359 #======================================================================
 360
 361
 362 sub _where_ARRAYREF {
 363   my ($self, $where, $logic) = @_;
 364
 365   $logic = uc($logic || $self->{logic});
 366   $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
 367
 368   my @clauses = @$where;
 369
 370   my (@sql_clauses, @all_bind);
 371   # need to use while() so can shift() for pairs
 372   while (my $el = shift @clauses) {
 373
 374     # switch according to kind of $el and get corresponding ($sql, @bind)
 375     my ($sql, @bind) = $self->_SWITCH_refkind($el, {
 376
 377       # skip empty elements, otherwise get invalid trailing AND stuff
 378       ARRAYREF  => sub {$self->_recurse_where($el)        if @$el},
 379
 380       ARRAYREFREF => sub { @{${$el}}                 if @{${$el}}},
 381
 382       HASHREF   => sub {$self->_recurse_where($el, 'and') if %$el},
 383            # LDNOTE : previous SQLA code for hashrefs was creating a dirty
 384            # side-effect: the first hashref within an array would change
 385            # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
 386            # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
 387            # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
 388
 389       SCALARREF => sub { ($$el);                                 },
 390
 391       SCALAR    => sub {# top-level arrayref with scalars, recurse in pairs
 392                         $self->_recurse_where({$el => shift(@clauses)})},
 393
 394       UNDEF     => sub {puke "not supported : UNDEF in arrayref" },
 395     });
 396
 397     if ($sql) {
 398       push @sql_clauses, $sql;
 399       push @all_bind, @bind;
 400     }
 401   }
 402
 403   return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
 404 }
 405
 406 #======================================================================
 407 # WHERE: top-level ARRAYREFREF
 408 #======================================================================
 409
 410 sub _where_ARRAYREFREF {
 411     my ($self, $where) = @_;
 412     my ($sql, @bind) = @{${$where}};
 413
 414     return ($sql, @bind);
 415 }
 416
 417 #======================================================================
 418 # WHERE: top-level HASHREF
 419 #======================================================================
 420
 421 sub _where_HASHREF {
 422   my ($self, $where) = @_;
 423   my (@sql_clauses, @all_bind);
 424
 425   # LDNOTE : don't really know why we need to sort keys
 426   for my $k (sort keys %$where) {
 427     my $v = $where->{$k};
 428
 429     # ($k => $v) is either a special op or a regular hashpair
 430     my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
 431                                         : do {
 432          my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
 433          $self->$method($k, $v);
 434        };
 435
 436     push @sql_clauses, $sql;
 437     push @all_bind, @bind;
 438   }
 439
 440   return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
 441 }
 442
 443
 444 sub _where_op_in_hash {
 445   my ($self, $op, $v) = @_;
 446
 447   $op =~ /^(AND|OR|NEST)[_\d]*/i
 448     or puke "unknown operator: -$op";
 449   $op = uc($1); # uppercase, remove trailing digits
 450   $self->_debug("OP(-$op) within hashref, recursing...");
 451
 452   $self->_SWITCH_refkind($v, {
 453
 454     ARRAYREF => sub {
 455       # LDNOTE : should deprecate {-or => [...]} and {-and => [...]}
 456       # because they are misleading; the only proper way would be
 457       # -nest => [-or => ...], -nest => [-and ...]
 458       return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
 459     },
 460
 461     HASHREF => sub {
 462       if ($op eq 'OR') {
 463         belch "-or => {...} should be -nest => [...]";
 464         return $self->_where_ARRAYREF([%$v], 'OR');
 465       }
 466       else {                  # NEST | AND
 467         return $self->_where_HASHREF($v);
 468       }
 469     },
 470
 471     SCALARREF  => sub {         # literal SQL
 472       $op eq 'NEST'
 473         or puke "-$op => \\\$scalar not supported, use -nest => ...";
 474       return ($$v);
 475     },
 476
 477     ARRAYREFREF => sub {        # literal SQL
 478       $op eq 'NEST'
 479         or puke "-$op => \\[..] not supported, use -nest => ...";
 480       return @{${$v}};
 481     },
 482
 483     SCALAR => sub { # permissively interpreted as SQL
 484       $op eq 'NEST'
 485         or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
 486       belch "literal SQL should be -nest => \\'scalar' "
 487           . "instead of -nest => 'scalar' ";
 488       return ($v);
 489     },
 490
 491     UNDEF => sub {
 492       puke "-$op => undef not supported";
 493     },
 494    });
 495 }
 496
 497
 498 sub _where_hashpair_ARRAYREF {
 499   my ($self, $k, $v) = @_;
 500
 501   if( @$v ) {
 502     my @v = @$v; # need copy because of shift below
 503     $self->_debug("ARRAY($k) means distribute over elements");
 504
 505     # put apart first element if it is an operator (-and, -or)
 506     my $op = $v[0] =~ /^-/ ? shift @v : undef;
 507     $self->_debug("OP($op) reinjected into the distributed array") if $op;
 508
 509     my @distributed = map { {$k =>  $_} } @v;
 510     unshift @distributed, $op if $op;
 511     my $logic = $op ? substr($op, 1) : '';
 512
 513     return $self->_recurse_where(\@distributed, $logic);
 514   }
 515   else {
 516     # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
 517     $self->_debug("empty ARRAY($k) means 0=1");
 518     return ($self->{sqlfalse});
 519   }
 520 }
 521
 522 sub _where_hashpair_HASHREF {
 523   my ($self, $k, $v) = @_;
 524
 525   my (@all_sql, @all_bind);
 526
 527   for my $op (sort keys %$v) {
 528     my $val = $v->{$op};
 529
 530     # put the operator in canonical form
 531     $op =~ s/^-//;       # remove initial dash
 532     $op =~ tr/_/ /;      # underscores become spaces
 533     $op =~ s/^\s+//;     # no initial space
 534     $op =~ s/\s+$//;     # no final space
 535     $op =~ s/\s+/ /;     # multiple spaces become one
 536
 537     my ($sql, @bind);
 538
 539     # CASE: special operators like -in or -between
 540     my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
 541     if ($special_op) {
 542       ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
 543     }
 544     else {
 545       $self->_SWITCH_refkind($val, {
 546
 547         ARRAYREF => sub {       # CASE: col => {op => \@vals}
 548           ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
 549         },
 550
 551         SCALARREF => sub {      # CASE: col => {op => \$scalar} (literal SQL without bind)
 552           $sql  = join ' ', $self->_convert($self->_quote($k)),
 553                             $self->_sqlcase($op),
 554                             $$val;
 555         },
 556
 557         ARRAYREFREF => sub {    # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
 558           my ($sub_sql, @sub_bind) = @$$val;
 559           $self->_assert_bindval_matches_bindtype(@sub_bind);
 560           $sql  = join ' ', $self->_convert($self->_quote($k)),
 561                             $self->_sqlcase($op),
 562                             $sub_sql;
 563           @bind = @sub_bind;
 564         },
 565
 566         UNDEF => sub {          # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
 567           my $is = ($op =~ $self->{equality_op})   ? 'is'     :
 568                    ($op =~ $self->{inequality_op}) ? 'is not' :
 569                puke "unexpected operator '$op' with undef operand";
 570           $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
 571         },
 572
 573         FALLBACK => sub {       # CASE: col => {op => $scalar}
 574           $sql  = join ' ', $self->_convert($self->_quote($k)),
 575                             $self->_sqlcase($op),
 576                             $self->_convert('?');
 577           @bind = $self->_bindtype($k, $val);
 578         },
 579       });
 580     }
 581
 582     push @all_sql, $sql;
 583     push @all_bind, @bind;
 584   }
 585
 586   return $self->_join_sql_clauses('and', \@all_sql, \@all_bind);
 587 }
 588
 589
 590
 591 sub _where_field_op_ARRAYREF {
 592   my ($self, $k, $op, $vals) = @_;
 593
 594   if(@$vals) {
 595     $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
 596
 597
 598
 599     # LDNOTE : change the distribution logic when
 600     # $op =~ $self->{inequality_op}, because of Morgan laws :
 601     # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
 602     # WHERE field != 22 OR  field != 33 : the user probably means
 603     # WHERE field != 22 AND field != 33.
 604     my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
 605
 606     # distribute $op over each member of @$vals
 607     return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
 608
 609   }
 610   else {
 611     # try to DWIM on equality operators
 612     # LDNOTE : not 100% sure this is the correct thing to do ...
 613     return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
 614     return ($self->{sqltrue})  if $op =~ $self->{inequality_op};
 615
 616     # otherwise
 617     puke "operator '$op' applied on an empty array (field '$k')";
 618   }
 619 }
 620
 621
 622 sub _where_hashpair_SCALARREF {
 623   my ($self, $k, $v) = @_;
 624   $self->_debug("SCALAR($k) means literal SQL: $$v");
 625   my $sql = $self->_quote($k) . " " . $$v;
 626   return ($sql);
 627 }
 628
 629 # literal SQL with bind
 630 sub _where_hashpair_ARRAYREFREF {
 631   my ($self, $k, $v) = @_;
 632   $self->_debug("REF($k) means literal SQL: @${$v}");
 633   my ($sql, @bind) = @${$v};
 634   $self->_assert_bindval_matches_bindtype(@bind);
 635   $sql  = $self->_quote($k) . " " . $sql;
 636   return ($sql, @bind );
 637 }
 638
 639 # literal SQL without bind
 640 sub _where_hashpair_SCALAR {
 641   my ($self, $k, $v) = @_;
 642   $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
 643   my $sql = join ' ', $self->_convert($self->_quote($k)),
 644                       $self->_sqlcase($self->{cmp}),
 645                       $self->_convert('?');
 646   my @bind =  $self->_bindtype($k, $v);
 647   return ( $sql, @bind);
 648 }
 649
 650
 651 sub _where_hashpair_UNDEF {
 652   my ($self, $k, $v) = @_;
 653   $self->_debug("UNDEF($k) means IS NULL");
 654   my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
 655   return ($sql);
 656 }
 657
 658 #======================================================================
 659 # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
 660 #======================================================================
 661
 662
 663 sub _where_SCALARREF {
 664   my ($self, $where) = @_;
 665
 666   # literal sql
 667   $self->_debug("SCALAR(*top) means literal SQL: $$where");
 668   return ($$where);
 669 }
 670
 671
 672 sub _where_SCALAR {
 673   my ($self, $where) = @_;
 674
 675   # literal sql
 676   $self->_debug("NOREF(*top) means literal SQL: $where");
 677   return ($where);
 678 }
 679
 680
 681 sub _where_UNDEF {
 682   my ($self) = @_;
 683   return ();
 684 }
 685
 686
 687 #======================================================================
 688 # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
 689 #======================================================================
 690
 691
 692 sub _where_field_BETWEEN {
 693   my ($self, $k, $op, $vals) = @_;
 694
 695   ref $vals eq 'ARRAY' && @$vals == 2
 696     or puke "special op 'between' requires an arrayref of two values";
 697
 698   my ($label)       = $self->_convert($self->_quote($k));
 699   my ($placeholder) = $self->_convert('?');
 700   my $and           = $self->_sqlcase('and');
 701   $op               = $self->_sqlcase($op);
 702
 703   my $sql  = "( $label $op $placeholder $and $placeholder )";
 704   my @bind = $self->_bindtype($k, @$vals);
 705   return ($sql, @bind)
 706 }
 707
 708
 709 sub _where_field_IN {
 710   my ($self, $k, $op, $vals) = @_;
 711
 712   # backwards compatibility : if scalar, force into an arrayref
 713   $vals = [$vals] if defined $vals && ! ref $vals;
 714
 715   my ($label)       = $self->_convert($self->_quote($k));
 716   my ($placeholder) = $self->_convert('?');
 717   $op               = $self->_sqlcase($op);
 718
 719   my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
 720     ARRAYREF => sub {     # list of choices
 721       if (@$vals) { # nonempty list
 722         my $placeholders  = join ", ", (($placeholder) x @$vals);
 723         my $sql           = "$label $op ( $placeholders )";
 724         my @bind = $self->_bindtype($k, @$vals);
 725
 726         return ($sql, @bind);
 727       }
 728       else { # empty list : some databases won't understand "IN ()", so DWIM
 729         my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
 730         return ($sql);
 731       }
 732     },
 733
 734     ARRAYREFREF => sub {  # literal SQL with bind
 735       my ($sql, @bind) = @$$vals;
 736       $self->_assert_bindval_matches_bindtype(@bind);
 737       return ("$label $op ( $sql )", @bind);
 738     },
 739
 740     FALLBACK => sub {
 741       puke "special op 'in' requires an arrayref (or arrayref-ref)";
 742     },
 743   });
 744
 745   return ($sql, @bind);
 746 }
 747
 748
 749
 750
 751
 752
 753 #======================================================================
 754 # ORDER BY
 755 #======================================================================
 756
 757 sub _order_by {
 758   my ($self, $arg) = @_;
 759
 760   # construct list of ordering instructions
 761   my @order = $self->_SWITCH_refkind($arg, {
 762
 763     ARRAYREF => sub {
 764       map {$self->_SWITCH_refkind($_, {
 765               SCALAR    => sub {$self->_quote($_)},
 766               UNDEF     => sub {},
 767               SCALARREF => sub {$$_}, # literal SQL, no quoting
 768               HASHREF   => sub {$self->_order_by_hash($_)}
 769              }) } @$arg;
 770     },
 771
 772     SCALAR    => sub {$self->_quote($arg)},
 773     UNDEF     => sub {},
 774     SCALARREF => sub {$$arg}, # literal SQL, no quoting
 775     HASHREF   => sub {$self->_order_by_hash($arg)},
 776
 777   });
 778
 779   # build SQL
 780   my $order = join ', ', @order;
 781   return $order ? $self->_sqlcase(' order by')." $order" : '';
 782 }
 783
 784
 785 sub _order_by_hash {
 786   my ($self, $hash) = @_;
 787
 788   # get first pair in hash
 789   my ($key, $val) = each %$hash;
 790
 791   # check if one pair was found and no other pair in hash
 792   $key && !(each %$hash)
 793     or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
 794
 795   my ($order) = ($key =~ /^-(desc|asc)/i)
 796     or puke "invalid key in _order_by hash : $key";
 797
 798   return $self->_quote($val) ." ". $self->_sqlcase($order);
 799 }
 800
 801
 802
 803 #======================================================================
 804 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
 805 #======================================================================
 806
 807 sub _table  {
 808   my $self = shift;
 809   my $from = shift;
 810   $self->_SWITCH_refkind($from, {
 811     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$from;},
 812     SCALAR       => sub {$self->_quote($from)},
 813     SCALARREF    => sub {$$from},
 814     ARRAYREFREF  => sub {join ', ', @$from;},
 815   });
 816 }
 817
 818
 819 #======================================================================
 820 # UTILITY FUNCTIONS
 821 #======================================================================
 822
 823 sub _quote {
 824   my $self  = shift;
 825   my $label = shift;
 826
 827   $label or puke "can't quote an empty label";
 828
 829   # left and right quote characters
 830   my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
 831     SCALAR   => sub {($self->{quote_char}, $self->{quote_char})},
 832     ARRAYREF => sub {@{$self->{quote_char}}},
 833     UNDEF    => sub {()},
 834    });
 835   not @other
 836       or puke "quote_char must be an arrayref of 2 values";
 837
 838   # no quoting if no quoting chars
 839   $ql or return $label;
 840
 841   # no quoting for literal SQL
 842   return $$label if ref($label) eq 'SCALAR';
 843
 844   # separate table / column (if applicable)
 845   my $sep = $self->{name_sep} || '';
 846   my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
 847
 848   # do the quoting, except for "*" or for `table`.*
 849   my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
 850
 851   # reassemble and return.
 852   return join $sep, @quoted;
 853 }
 854
 855
 856 # Conversion, if applicable
 857 sub _convert ($) {
 858   my ($self, $arg) = @_;
 859
 860 # LDNOTE : modified the previous implementation below because
 861 # it was not consistent : the first "return" is always an array,
 862 # the second "return" is context-dependent. Anyway, _convert
 863 # seems always used with just a single argument, so make it a
 864 # scalar function.
 865 #     return @_ unless $self->{convert};
 866 #     my $conv = $self->_sqlcase($self->{convert});
 867 #     my @ret = map { $conv.'('.$_.')' } @_;
 868 #     return wantarray ? @ret : $ret[0];
 869   if ($self->{convert}) {
 870     my $conv = $self->_sqlcase($self->{convert});
 871     $arg = $conv.'('.$arg.')';
 872   }
 873   return $arg;
 874 }
 875
 876 # And bindtype
 877 sub _bindtype (@) {
 878   my $self = shift;
 879   my($col, @vals) = @_;
 880
 881   #LDNOTE : changed original implementation below because it did not make
 882   # sense when bindtype eq 'columns' and @vals > 1.
 883 #  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
 884
 885   return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
 886 }
 887
 888 # Dies if any element of @bind is not in [colname => value] format
 889 # if bindtype is 'columns'.
 890 sub _assert_bindval_matches_bindtype {
 891   my ($self, @bind) = @_;
 892
 893   if ($self->{bindtype} eq 'columns') {
 894     foreach my $val (@bind) {
 895       if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
 896         die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
 897       }
 898     }
 899   }
 900 }
 901
 902 sub _join_sql_clauses {
 903   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
 904
 905   if (@$clauses_aref > 1) {
 906     my $join  = " " . $self->_sqlcase($logic) . " ";
 907     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
 908     return ($sql, @$bind_aref);
 909   }
 910   elsif (@$clauses_aref) {
 911     return ($clauses_aref->[0], @$bind_aref); # no parentheses
 912   }
 913   else {
 914     return (); # if no SQL, ignore @$bind_aref
 915   }
 916 }
 917
 918
 919 # Fix SQL case, if so requested
 920 sub _sqlcase {
 921   my $self = shift;
 922
 923   # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
 924   # don't touch the argument ... crooked logic, but let's not change it!
 925   return $self->{case} ? $_[0] : uc($_[0]);
 926 }
 927
 928
 929 #======================================================================
 930 # DISPATCHING FROM REFKIND
 931 #======================================================================
 932
 933 sub _refkind {
 934   my ($self, $data) = @_;
 935   my $suffix = '';
 936   my $ref;
 937   my $n_steps = 0;
 938
 939   while (1) {
 940     # blessed objects are treated like scalars
 941     $ref = (blessed $data) ? '' : ref $data;
 942     $n_steps += 1 if $ref;
 943     last          if $ref ne 'REF';
 944     $data = $$data;
 945   }
 946
 947   my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
 948
 949   return $base . ('REF' x $n_steps);
 950 }
 951
 952
 953
 954 sub _try_refkind {
 955   my ($self, $data) = @_;
 956   my @try = ($self->_refkind($data));
 957   push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
 958   push @try, 'FALLBACK';
 959   return @try;
 960 }
 961
 962 sub _METHOD_FOR_refkind {
 963   my ($self, $meth_prefix, $data) = @_;
 964   my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
 965                               $self->_try_refkind($data)
 966     or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
 967   return $method;
 968 }
 969
 970
 971 sub _SWITCH_refkind {
 972   my ($self, $data, $dispatch_table) = @_;
 973
 974   my $coderef = first {$_} map {$dispatch_table->{$_}}
 975                                $self->_try_refkind($data)
 976     or puke "no dispatch entry for ".$self->_refkind($data);
 977   $coderef->();
 978 }
 979
 980
 981
 982
 983 #======================================================================
 984 # VALUES, GENERATE, AUTOLOAD
 985 #======================================================================
 986
 987 # LDNOTE: original code from nwiger, didn't touch code in that section
 988 # I feel the AUTOLOAD stuff should not be the default, it should
 989 # only be activated on explicit demand by user.
 990
 991 sub values {
 992     my $self = shift;
 993     my $data = shift || return;
 994     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
 995         unless ref $data eq 'HASH';
 996
 997     my @all_bind;
 998     foreach my $k ( sort keys %$data ) {
 999         my $v = $data->{$k};
1000         $self->_SWITCH_refkind($v, {
1001           ARRAYREF => sub {
1002             if ($self->{array_datatypes}) { # array datatype
1003               push @all_bind, $self->_bindtype($k, $v);
1004             }
1005             else {                          # literal SQL with bind
1006               my ($sql, @bind) = @$v;
1007               $self->_assert_bindval_matches_bindtype(@bind);
1008               push @all_bind, @bind;
1009             }
1010           },
1011           ARRAYREFREF => sub { # literal SQL with bind
1012             my ($sql, @bind) = @${$v};
1013             $self->_assert_bindval_matches_bindtype(@bind);
1014             push @all_bind, @bind;
1015           },
1016           SCALARREF => sub {  # literal SQL without bind
1017           },
1018           SCALAR_or_UNDEF => sub {
1019             push @all_bind, $self->_bindtype($k, $v);
1020           },
1021         });
1022     }
1023
1024     return @all_bind;
1025 }
1026
1027 sub generate {
1028     my $self  = shift;
1029
1030     my(@sql, @sqlq, @sqlv);
1031
1032     for (@_) {
1033         my $ref = ref $_;
1034         if ($ref eq 'HASH') {
1035             for my $k (sort keys %$_) {
1036                 my $v = $_->{$k};
1037                 my $r = ref $v;
1038                 my $label = $self->_quote($k);
1039                 if ($r eq 'ARRAY') {
1040                     # literal SQL with bind
1041                     my ($sql, @bind) = @$v;
1042                     $self->_assert_bindval_matches_bindtype(@bind);
1043                     push @sqlq, "$label = $sql";
1044                     push @sqlv, @bind;
1045                 } elsif ($r eq 'SCALAR') {
1046                     # literal SQL without bind
1047                     push @sqlq, "$label = $$v";
1048                 } else {
1049                     push @sqlq, "$label = ?";
1050                     push @sqlv, $self->_bindtype($k, $v);
1051                 }
1052             }
1053             push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1054         } elsif ($ref eq 'ARRAY') {
1055             # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1056             for my $v (@$_) {
1057                 my $r = ref $v;
1058                 if ($r eq 'ARRAY') {   # literal SQL with bind
1059                     my ($sql, @bind) = @$v;
1060                     $self->_assert_bindval_matches_bindtype(@bind);
1061                     push @sqlq, $sql;
1062                     push @sqlv, @bind;
1063                 } elsif ($r eq 'SCALAR') {  # literal SQL without bind
1064                     # embedded literal SQL
1065                     push @sqlq, $$v;
1066                 } else {
1067                     push @sqlq, '?';
1068                     push @sqlv, $v;
1069                 }
1070             }
1071             push @sql, '(' . join(', ', @sqlq) . ')';
1072         } elsif ($ref eq 'SCALAR') {
1073             # literal SQL
1074             push @sql, $$_;
1075         } else {
1076             # strings get case twiddled
1077             push @sql, $self->_sqlcase($_);
1078         }
1079     }
1080
1081     my $sql = join ' ', @sql;
1082
1083     # this is pretty tricky
1084     # if ask for an array, return ($stmt, @bind)
1085     # otherwise, s/?/shift @sqlv/ to put it inline
1086     if (wantarray) {
1087         return ($sql, @sqlv);
1088     } else {
1089         1 while $sql =~ s/\?/my $d = shift(@sqlv);
1090                              ref $d ? $d->[1] : $d/e;
1091         return $sql;
1092     }
1093 }
1094
1095
1096 sub DESTROY { 1 }
1097
1098 sub AUTOLOAD {
1099     # This allows us to check for a local, then _form, attr
1100     my $self = shift;
1101     my($name) = $AUTOLOAD =~ /.*::(.+)/;
1102     return $self->generate($name, @_);
1103 }
1104
1105 1;
1106
1107
1108
1109 __END__
1110
1111 =head1 NAME
1112
1113 SQL::Abstract - Generate SQL from Perl data structures
1114
1115 =head1 SYNOPSIS
1116
1117     use SQL::Abstract;
1118
1119     my $sql = SQL::Abstract->new;
1120
1121     my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1122
1123     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1124
1125     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1126
1127     my($stmt, @bind) = $sql->delete($table, \%where);
1128
1129     # Then, use these in your DBI statements
1130     my $sth = $dbh->prepare($stmt);
1131     $sth->execute(@bind);
1132
1133     # Just generate the WHERE clause
1134     my($stmt, @bind) = $sql->where(\%where, \@order);
1135
1136     # Return values in the same order, for hashed queries
1137     # See PERFORMANCE section for more details
1138     my @bind = $sql->values(\%fieldvals);
1139
1140 =head1 DESCRIPTION
1141
1142 This module was inspired by the excellent L<DBIx::Abstract>.
1143 However, in using that module I found that what I really wanted
1144 to do was generate SQL, but still retain complete control over my
1145 statement handles and use the DBI interface. So, I set out to
1146 create an abstract SQL generation module.
1147
1148 While based on the concepts used by L<DBIx::Abstract>, there are
1149 several important differences, especially when it comes to WHERE
1150 clauses. I have modified the concepts used to make the SQL easier
1151 to generate from Perl data structures and, IMO, more intuitive.
1152 The underlying idea is for this module to do what you mean, based
1153 on the data structures you provide it. The big advantage is that
1154 you don't have to modify your code every time your data changes,
1155 as this module figures it out.
1156
1157 To begin with, an SQL INSERT is as easy as just specifying a hash
1158 of C<key=value> pairs:
1159
1160     my %data = (
1161         name => 'Jimbo Bobson',
1162         phone => '123-456-7890',
1163         address => '42 Sister Lane',
1164         city => 'St. Louis',
1165         state => 'Louisiana',
1166     );
1167
1168 The SQL can then be generated with this:
1169
1170     my($stmt, @bind) = $sql->insert('people', \%data);
1171
1172 Which would give you something like this:
1173
1174     $stmt = "INSERT INTO people
1175                     (address, city, name, phone, state)
1176                     VALUES (?, ?, ?, ?, ?)";
1177     @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1178              '123-456-7890', 'Louisiana');
1179
1180 These are then used directly in your DBI code:
1181
1182     my $sth = $dbh->prepare($stmt);
1183     $sth->execute(@bind);
1184
1185 =head2 Inserting and Updating Arrays
1186
1187 If your database has array types (like for example Postgres),
1188 activate the special option C<< array_datatypes => 1 >>
1189 when creating the C<SQL::Abstract> object.
1190 Then you may use an arrayref to insert and update database array types:
1191
1192     my $sql = SQL::Abstract->new(array_datatypes => 1);
1193     my %data = (
1194         planets => [qw/Mercury Venus Earth Mars/]
1195     );
1196
1197     my($stmt, @bind) = $sql->insert('solar_system', \%data);
1198
1199 This results in:
1200
1201     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1202
1203     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1204
1205
1206 =head2 Inserting and Updating SQL
1207
1208 In order to apply SQL functions to elements of your C<%data> you may
1209 specify a reference to an arrayref for the given hash value. For example,
1210 if you need to execute the Oracle C<to_date> function on a value, you can
1211 say something like this:
1212
1213     my %data = (
1214         name => 'Bill',
1215         date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1216     );
1217
1218 The first value in the array is the actual SQL. Any other values are
1219 optional and would be included in the bind values array. This gives
1220 you:
1221
1222     my($stmt, @bind) = $sql->insert('people', \%data);
1223
1224     $stmt = "INSERT INTO people (name, date_entered)
1225                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1226     @bind = ('Bill', '03/02/2003');
1227
1228 An UPDATE is just as easy, all you change is the name of the function:
1229
1230     my($stmt, @bind) = $sql->update('people', \%data);
1231
1232 Notice that your C<%data> isn't touched; the module will generate
1233 the appropriately quirky SQL for you automatically. Usually you'll
1234 want to specify a WHERE clause for your UPDATE, though, which is
1235 where handling C<%where> hashes comes in handy...
1236
1237 =head2 Complex where statements
1238
1239 This module can generate pretty complicated WHERE statements
1240 easily. For example, simple C<key=value> pairs are taken to mean
1241 equality, and if you want to see if a field is within a set
1242 of values, you can use an arrayref. Let's say we wanted to
1243 SELECT some data based on this criteria:
1244
1245     my %where = (
1246        requestor => 'inna',
1247        worker => ['nwiger', 'rcwe', 'sfz'],
1248        status => { '!=', 'completed' }
1249     );
1250
1251     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1252
1253 The above would give you something like this:
1254
1255     $stmt = "SELECT * FROM tickets WHERE
1256                 ( requestor = ? ) AND ( status != ? )
1257                 AND ( worker = ? OR worker = ? OR worker = ? )";
1258     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1259
1260 Which you could then use in DBI code like so:
1261
1262     my $sth = $dbh->prepare($stmt);
1263     $sth->execute(@bind);
1264
1265 Easy, eh?
1266
1267 =head1 FUNCTIONS
1268
1269 The functions are simple. There's one for each major SQL operation,
1270 and a constructor you use first. The arguments are specified in a
1271 similar order to each function (table, then fields, then a where
1272 clause) to try and simplify things.
1273
1274
1275
1276
1277 =head2 new(option => 'value')
1278
1279 The C<new()> function takes a list of options and values, and returns
1280 a new B<SQL::Abstract> object which can then be used to generate SQL
1281 through the methods below. The options accepted are:
1282
1283 =over
1284
1285 =item case
1286
1287 If set to 'lower', then SQL will be generated in all lowercase. By
1288 default SQL is generated in "textbook" case meaning something like:
1289
1290     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1291
1292 Any setting other than 'lower' is ignored.
1293
1294 =item cmp
1295
1296 This determines what the default comparison operator is. By default
1297 it is C<=>, meaning that a hash like this:
1298
1299     %where = (name => 'nwiger', email => 'nate@wiger.org');
1300
1301 Will generate SQL like this:
1302
1303     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1304
1305 However, you may want loose comparisons by default, so if you set
1306 C<cmp> to C<like> you would get SQL such as:
1307
1308     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1309
1310 You can also override the comparsion on an individual basis - see
1311 the huge section on L</"WHERE CLAUSES"> at the bottom.
1312
1313 =item sqltrue, sqlfalse
1314
1315 Expressions for inserting boolean values within SQL statements.
1316 By default these are C<1=1> and C<1=0>.
1317
1318 =item logic
1319
1320 This determines the default logical operator for multiple WHERE
1321 statements in arrays. By default it is "or", meaning that a WHERE
1322 array of the form:
1323
1324     @where = (
1325         event_date => {'>=', '2/13/99'},
1326         event_date => {'<=', '4/24/03'},
1327     );
1328
1329 Will generate SQL like this:
1330
1331     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1332
1333 This is probably not what you want given this query, though (look
1334 at the dates). To change the "OR" to an "AND", simply specify:
1335
1336     my $sql = SQL::Abstract->new(logic => 'and');
1337
1338 Which will change the above C<WHERE> to:
1339
1340     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1341
1342 The logic can also be changed locally by inserting
1343 an extra first element in the array :
1344
1345     @where = (-and => event_date => {'>=', '2/13/99'},
1346                       event_date => {'<=', '4/24/03'} );
1347
1348 See the L</"WHERE CLAUSES"> section for explanations.
1349
1350 =item convert
1351
1352 This will automatically convert comparisons using the specified SQL
1353 function for both column and value. This is mostly used with an argument
1354 of C<upper> or C<lower>, so that the SQL will have the effect of
1355 case-insensitive "searches". For example, this:
1356
1357     $sql = SQL::Abstract->new(convert => 'upper');
1358     %where = (keywords => 'MaKe iT CAse inSeNSItive');
1359
1360 Will turn out the following SQL:
1361
1362     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1363
1364 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1365 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1366 not validate this option; it will just pass through what you specify verbatim).
1367
1368 =item bindtype
1369
1370 This is a kludge because many databases suck. For example, you can't
1371 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1372 Instead, you have to use C<bind_param()>:
1373
1374     $sth->bind_param(1, 'reg data');
1375     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1376
1377 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1378 which loses track of which field each slot refers to. Fear not.
1379
1380 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1381 Currently, you can specify either C<normal> (default) or C<columns>. If you
1382 specify C<columns>, you will get an array that looks like this:
1383
1384     my $sql = SQL::Abstract->new(bindtype => 'columns');
1385     my($stmt, @bind) = $sql->insert(...);
1386
1387     @bind = (
1388         [ 'column1', 'value1' ],
1389         [ 'column2', 'value2' ],
1390         [ 'column3', 'value3' ],
1391     );
1392
1393 You can then iterate through this manually, using DBI's C<bind_param()>.
1394
1395     $sth->prepare($stmt);
1396     my $i = 1;
1397     for (@bind) {
1398         my($col, $data) = @$_;
1399         if ($col eq 'details' || $col eq 'comments') {
1400             $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1401         } elsif ($col eq 'image') {
1402             $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1403         } else {
1404             $sth->bind_param($i, $data);
1405         }
1406         $i++;
1407     }
1408     $sth->execute;      # execute without @bind now
1409
1410 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1411 Basically, the advantage is still that you don't have to care which fields
1412 are or are not included. You could wrap that above C<for> loop in a simple
1413 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1414 get a layer of abstraction over manual SQL specification.
1415
1416 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1417 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1418 will expect the bind values in this format.
1419
1420 =item quote_char
1421
1422 This is the character that a table or column name will be quoted
1423 with.  By default this is an empty string, but you could set it to
1424 the character C<`>, to generate SQL like this:
1425
1426   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1427
1428 Alternatively, you can supply an array ref of two items, the first being the left
1429 hand quote character, and the second the right hand quote character. For
1430 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1431 that generates SQL like this:
1432
1433   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1434
1435 Quoting is useful if you have tables or columns names that are reserved
1436 words in your database's SQL dialect.
1437
1438 =item name_sep
1439
1440 This is the character that separates a table and column name.  It is
1441 necessary to specify this when the C<quote_char> option is selected,
1442 so that tables and column names can be individually quoted like this:
1443
1444   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1445
1446 =item array_datatypes
1447
1448 When this option is true, arrayrefs in INSERT or UPDATE are
1449 interpreted as array datatypes and are passed directly
1450 to the DBI layer.
1451 When this option is false, arrayrefs are interpreted
1452 as literal SQL, just like refs to arrayrefs
1453 (but this behavior is for backwards compatibility; when writing
1454 new queries, use the "reference to arrayref" syntax
1455 for literal SQL).
1456
1457
1458 =item special_ops
1459
1460 Takes a reference to a list of "special operators"
1461 to extend the syntax understood by L<SQL::Abstract>.
1462 See section L</"SPECIAL OPERATORS"> for details.
1463
1464
1465
1466 =back
1467
1468 =head2 insert($table, \@values || \%fieldvals)
1469
1470 This is the simplest function. You simply give it a table name
1471 and either an arrayref of values or hashref of field/value pairs.
1472 It returns an SQL INSERT statement and a list of bind values.
1473 See the sections on L</"Inserting and Updating Arrays"> and
1474 L</"Inserting and Updating SQL"> for information on how to insert
1475 with those data types.
1476
1477 =head2 update($table, \%fieldvals, \%where)
1478
1479 This takes a table, hashref of field/value pairs, and an optional
1480 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1481 of bind values.
1482 See the sections on L</"Inserting and Updating Arrays"> and
1483 L</"Inserting and Updating SQL"> for information on how to insert
1484 with those data types.
1485
1486 =head2 select($source, $fields, $where, $order)
1487
1488 This returns a SQL SELECT statement and associated list of bind values, as
1489 specified by the arguments  :
1490
1491 =over
1492
1493 =item $source
1494
1495 Specification of the 'FROM' part of the statement.
1496 The argument can be either a plain scalar (interpreted as a table
1497 name, will be quoted), or an arrayref (interpreted as a list
1498 of table names, joined by commas, quoted), or a scalarref
1499 (literal table name, not quoted), or a ref to an arrayref
1500 (list of literal table names, joined by commas, not quoted).
1501
1502 =item $fields
1503
1504 Specification of the list of fields to retrieve from
1505 the source.
1506 The argument can be either an arrayref (interpreted as a list
1507 of field names, will be joined by commas and quoted), or a
1508 plain scalar (literal SQL, not quoted).
1509 Please observe that this API is not as flexible as for
1510 the first argument C<$table>, for backwards compatibility reasons.
1511
1512 =item $where
1513
1514 Optional argument to specify the WHERE part of the query.
1515 The argument is most often a hashref, but can also be
1516 an arrayref or plain scalar --
1517 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1518
1519 =item $order
1520
1521 Optional argument to specify the ORDER BY part of the query.
1522 The argument can be a scalar, a hashref or an arrayref
1523 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1524 for details.
1525
1526 =back
1527
1528
1529 =head2 delete($table, \%where)
1530
1531 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1532 It returns an SQL DELETE statement and list of bind values.
1533
1534 =head2 where(\%where, \@order)
1535
1536 This is used to generate just the WHERE clause. For example,
1537 if you have an arbitrary data structure and know what the
1538 rest of your SQL is going to look like, but want an easy way
1539 to produce a WHERE clause, use this. It returns an SQL WHERE
1540 clause and list of bind values.
1541
1542
1543 =head2 values(\%data)
1544
1545 This just returns the values from the hash C<%data>, in the same
1546 order that would be returned from any of the other above queries.
1547 Using this allows you to markedly speed up your queries if you
1548 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1549
1550 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1551
1552 Warning: This is an experimental method and subject to change.
1553
1554 This returns arbitrarily generated SQL. It's a really basic shortcut.
1555 It will return two different things, depending on return context:
1556
1557     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1558     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1559
1560 These would return the following:
1561
1562     # First calling form
1563     $stmt = "CREATE TABLE test (?, ?)";
1564     @bind = (field1, field2);
1565
1566     # Second calling form
1567     $stmt_and_val = "CREATE TABLE test (field1, field2)";
1568
1569 Depending on what you're trying to do, it's up to you to choose the correct
1570 format. In this example, the second form is what you would want.
1571
1572 By the same token:
1573
1574     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1575
1576 Might give you:
1577
1578     ALTER SESSION SET nls_date_format = 'MM/YY'
1579
1580 You get the idea. Strings get their case twiddled, but everything
1581 else remains verbatim.
1582
1583
1584
1585
1586 =head1 WHERE CLAUSES
1587
1588 =head2 Introduction
1589
1590 This module uses a variation on the idea from L<DBIx::Abstract>. It
1591 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1592 module is that things in arrays are OR'ed, and things in hashes
1593 are AND'ed.>
1594
1595 The easiest way to explain is to show lots of examples. After
1596 each C<%where> hash shown, it is assumed you used:
1597
1598     my($stmt, @bind) = $sql->where(\%where);
1599
1600 However, note that the C<%where> hash can be used directly in any
1601 of the other functions as well, as described above.
1602
1603 =head2 Key-value pairs
1604
1605 So, let's get started. To begin, a simple hash:
1606
1607     my %where  = (
1608         user   => 'nwiger',
1609         status => 'completed'
1610     );
1611
1612 Is converted to SQL C<key = val> statements:
1613
1614     $stmt = "WHERE user = ? AND status = ?";
1615     @bind = ('nwiger', 'completed');
1616
1617 One common thing I end up doing is having a list of values that
1618 a field can be in. To do this, simply specify a list inside of
1619 an arrayref:
1620
1621     my %where  = (
1622         user   => 'nwiger',
1623         status => ['assigned', 'in-progress', 'pending'];
1624     );
1625
1626 This simple code will create the following:
1627
1628     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1629     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1630
1631 An empty arrayref will be considered a logical false and
1632 will generate 0=1.
1633
1634 =head2 Key-value pairs
1635
1636 If you want to specify a different type of operator for your comparison,
1637 you can use a hashref for a given column:
1638
1639     my %where  = (
1640         user   => 'nwiger',
1641         status => { '!=', 'completed' }
1642     );
1643
1644 Which would generate:
1645
1646     $stmt = "WHERE user = ? AND status != ?";
1647     @bind = ('nwiger', 'completed');
1648
1649 To test against multiple values, just enclose the values in an arrayref:
1650
1651     status => { '!=', ['assigned', 'in-progress', 'pending'] };
1652
1653 Which would give you:
1654
1655     "WHERE status != ? AND status != ? AND status != ?"
1656
1657 Notice that since the operator was recognized as being a 'negative'
1658 operator, the arrayref was interpreted with 'AND' logic (because
1659 of Morgan's laws). By contrast, the reverse
1660
1661     status => { '=', ['assigned', 'in-progress', 'pending'] };
1662
1663 would generate :
1664
1665     "WHERE status = ? OR status = ? OR status = ?"
1666
1667
1668 The hashref can also contain multiple pairs, in which case it is expanded
1669 into an C<AND> of its elements:
1670
1671     my %where  = (
1672         user   => 'nwiger',
1673         status => { '!=', 'completed', -not_like => 'pending%' }
1674     );
1675
1676     # Or more dynamically, like from a form
1677     $where{user} = 'nwiger';
1678     $where{status}{'!='} = 'completed';
1679     $where{status}{'-not_like'} = 'pending%';
1680
1681     # Both generate this
1682     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1683     @bind = ('nwiger', 'completed', 'pending%');
1684
1685
1686 To get an OR instead, you can combine it with the arrayref idea:
1687
1688     my %where => (
1689          user => 'nwiger',
1690          priority => [ {'=', 2}, {'!=', 1} ]
1691     );
1692
1693 Which would generate:
1694
1695     $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1696     @bind = ('nwiger', '2', '1');
1697
1698 If you want to include literal SQL (with or without bind values), just use a
1699 scalar reference or array reference as the value:
1700
1701     my %where  = (
1702         date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
1703         date_expires => { '<' => \"now()" }
1704     );
1705
1706 Which would generate:
1707
1708     $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
1709     @bind = ('11/26/2008');
1710
1711
1712 =head2 Logic and nesting operators
1713
1714 In the example above,
1715 there is a subtle trap if you want to say something like
1716 this (notice the C<AND>):
1717
1718     WHERE priority != ? AND priority != ?
1719
1720 Because, in Perl you I<can't> do this:
1721
1722     priority => { '!=', 2, '!=', 1 }
1723
1724 As the second C<!=> key will obliterate the first. The solution
1725 is to use the special C<-modifier> form inside an arrayref:
1726
1727     priority => [ -and => {'!=', 2},
1728                           {'!=', 1} ]
1729
1730
1731 Normally, these would be joined by C<OR>, but the modifier tells it
1732 to use C<AND> instead. (Hint: You can use this in conjunction with the
1733 C<logic> option to C<new()> in order to change the way your queries
1734 work by default.) B<Important:> Note that the C<-modifier> goes
1735 B<INSIDE> the arrayref, as an extra first element. This will
1736 B<NOT> do what you think it might:
1737
1738     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
1739
1740 Here is a quick list of equivalencies, since there is some overlap:
1741
1742     # Same
1743     status => {'!=', 'completed', 'not like', 'pending%' }
1744     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1745
1746     # Same
1747     status => {'=', ['assigned', 'in-progress']}
1748     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1749     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1750
1751 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1752 operator which adds an additional set of parens, to create a subquery.
1753 For example, to get something like this:
1754
1755     $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1756     @bind = ('nwiger', '20', 'ASIA');
1757
1758 You would do:
1759
1760     my %where = (
1761          user => 'nwiger',
1762         -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1763     );
1764
1765 If you need several nested subexpressions, you can number
1766 the C<-nest> branches :
1767
1768     my %where = (
1769          user => 'nwiger',
1770         -nest1 => ...,
1771         -nest2 => ...,
1772         ...
1773     );
1774
1775
1776 =head2 Special operators : IN, BETWEEN, etc.
1777
1778 You can also use the hashref format to compare a list of fields using the
1779 C<IN> comparison operator, by specifying the list as an arrayref:
1780
1781     my %where  = (
1782         status   => 'completed',
1783         reportid => { -in => [567, 2335, 2] }
1784     );
1785
1786 Which would generate:
1787
1788     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1789     @bind = ('completed', '567', '2335', '2');
1790
1791 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1792 the same way.
1793
1794 Another pair of operators is C<-between> and C<-not_between>,
1795 used with an arrayref of two values:
1796
1797     my %where  = (
1798         user   => 'nwiger',
1799         completion_date => {
1800            -not_between => ['2002-10-01', '2003-02-06']
1801         }
1802     );
1803
1804 Would give you:
1805
1806     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1807
1808 These are the two builtin "special operators"; but the
1809 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1810
1811 =head2 Nested conditions
1812
1813 So far, we've seen how multiple conditions are joined with a top-level
1814 C<AND>.  We can change this by putting the different conditions we want in
1815 hashes and then putting those hashes in an array. For example:
1816
1817     my @where = (
1818         {
1819             user   => 'nwiger',
1820             status => { -like => ['pending%', 'dispatched'] },
1821         },
1822         {
1823             user   => 'robot',
1824             status => 'unassigned',
1825         }
1826     );
1827
1828 This data structure would create the following:
1829
1830     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1831                 OR ( user = ? AND status = ? ) )";
1832     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1833
1834 This can be combined with the C<-nest> operator to properly group
1835 SQL statements:
1836
1837     my @where = (
1838          -and => [
1839             user => 'nwiger',
1840             -nest => [
1841                 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1842                 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1843             ],
1844         ],
1845     );
1846
1847 That would yield:
1848
1849     WHERE ( user = ? AND
1850           ( ( workhrs > ? AND geo = ? )
1851          OR ( workhrs < ? AND geo = ? ) ) )
1852
1853 =head2 Literal SQL
1854
1855 Finally, sometimes only literal SQL will do. If you want to include
1856 literal SQL verbatim, you can specify it as a scalar reference, namely:
1857
1858     my $inn = 'is Not Null';
1859     my %where = (
1860         priority => { '<', 2 },
1861         requestor => \$inn
1862     );
1863
1864 This would create:
1865
1866     $stmt = "WHERE priority < ? AND requestor is Not Null";
1867     @bind = ('2');
1868
1869 Note that in this example, you only get one bind parameter back, since
1870 the verbatim SQL is passed as part of the statement.
1871
1872 Of course, just to prove a point, the above can also be accomplished
1873 with this:
1874
1875     my %where = (
1876         priority  => { '<', 2 },
1877         requestor => { '!=', undef },
1878     );
1879
1880
1881 TMTOWTDI.
1882
1883 Conditions on boolean columns can be expressed in the
1884 same way, passing a reference to an empty string :
1885
1886     my %where = (
1887         priority  => { '<', 2 },
1888         is_ready  => \"";
1889     );
1890
1891 which yields
1892
1893     $stmt = "WHERE priority < ? AND is_ready";
1894     @bind = ('2');
1895
1896
1897 =head2 Literal SQL with placeholders and bind values (subqueries)
1898
1899 If the literal SQL to be inserted has placeholders and bind values,
1900 use a reference to an arrayref (yes this is a double reference --
1901 not so common, but perfectly legal Perl). For example, to find a date
1902 in Postgres you can use something like this:
1903
1904     my %where = (
1905        date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1906     )
1907
1908 This would create:
1909
1910     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1911     @bind = ('10');
1912
1913 Note that you must pass the bind values in the same format as they are returned
1914 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
1915 provide the bind values in the C<< [ column_meta => value ] >> format, where
1916 C<column_meta> is an opaque scalar value; most commonly the column name, but
1917 you can use any scalar value (including references and blessed references),
1918 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
1919 to C<columns> the above example will look like:
1920
1921     my %where = (
1922        date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
1923     )
1924
1925 Literal SQL is especially useful for nesting parenthesized clauses in the
1926 main SQL query. Here is a first example :
1927
1928   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1929                                100, "foo%");
1930   my %where = (
1931     foo => 1234,
1932     bar => \["IN ($sub_stmt)" => @sub_bind],
1933   );
1934
1935 This yields :
1936
1937   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1938                                              WHERE c2 < ? AND c3 LIKE ?))";
1939   @bind = (1234, 100, "foo%");
1940
1941 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1942 are expressed in the same way. Of course the C<$sub_stmt> and
1943 its associated bind values can be generated through a former call
1944 to C<select()> :
1945
1946   my ($sub_stmt, @sub_bind)
1947      = $sql->select("t1", "c1", {c2 => {"<" => 100},
1948                                  c3 => {-like => "foo%"}});
1949   my %where = (
1950     foo => 1234,
1951     bar => \["> ALL ($sub_stmt)" => @sub_bind],
1952   );
1953
1954 In the examples above, the subquery was used as an operator on a column;
1955 but the same principle also applies for a clause within the main C<%where>
1956 hash, like an EXISTS subquery :
1957
1958   my ($sub_stmt, @sub_bind)
1959      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1960   my %where = (
1961     foo   => 1234,
1962     -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1963   );
1964
1965 which yields
1966
1967   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1968                                         WHERE c1 = ? AND c2 > t0.c0))";
1969   @bind = (1234, 1);
1970
1971
1972 Observe that the condition on C<c2> in the subquery refers to
1973 column C<t0.c0> of the main query : this is I<not> a bind
1974 value, so we have to express it through a scalar ref.
1975 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1976 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1977 what we wanted here.
1978
1979 Another use of the subquery technique is when some SQL clauses need
1980 parentheses, as it often occurs with some proprietary SQL extensions
1981 like for example fulltext expressions, geospatial expressions,
1982 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1983
1984   my %where = (
1985     -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1986   );
1987
1988 Finally, here is an example where a subquery is used
1989 for expressing unary negation:
1990
1991   my ($sub_stmt, @sub_bind)
1992      = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1993   $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1994   my %where = (
1995         lname  => {like => '%son%'},
1996         -nest  => \["NOT ($sub_stmt)" => @sub_bind],
1997     );
1998
1999 This yields
2000
2001   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2002   @bind = ('%son%', 10, 20)
2003
2004
2005
2006 =head2 Conclusion
2007
2008 These pages could go on for a while, since the nesting of the data
2009 structures this module can handle are pretty much unlimited (the
2010 module implements the C<WHERE> expansion as a recursive function
2011 internally). Your best bet is to "play around" with the module a
2012 little to see how the data structures behave, and choose the best
2013 format for your data based on that.
2014
2015 And of course, all the values above will probably be replaced with
2016 variables gotten from forms or the command line. After all, if you
2017 knew everything ahead of time, you wouldn't have to worry about
2018 dynamically-generating SQL and could just hardwire it into your
2019 script.
2020
2021
2022
2023
2024 =head1 ORDER BY CLAUSES
2025
2026 Some functions take an order by clause. This can either be a scalar (just a
2027 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2028 or an array of either of the two previous forms. Examples:
2029
2030              Given             |    Will Generate
2031     ----------------------------------------------------------
2032     \'colA DESC'               | ORDER BY colA DESC
2033     'colA'                     | ORDER BY colA
2034     [qw/colA colB/]            | ORDER BY colA, colB
2035     {-asc  => 'colA'}          | ORDER BY colA ASC
2036     {-desc => 'colB'}          | ORDER BY colB DESC
2037     [                          |
2038       {-asc  => 'colA'},       | ORDER BY colA ASC, colB DESC
2039       {-desc => 'colB'}        |
2040     ]                          |
2041     [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
2042     ==========================================================
2043
2044
2045
2046 =head1 SPECIAL OPERATORS
2047
2048   my $sqlmaker = SQL::Abstract->new(special_ops => [
2049      {regex => qr/.../,
2050       handler => sub {
2051         my ($self, $field, $op, $arg) = @_;
2052         ...
2053         },
2054      },
2055    ]);
2056
2057 A "special operator" is a SQL syntactic clause that can be
2058 applied to a field, instead of a usual binary operator.
2059 For example :
2060
2061    WHERE field IN (?, ?, ?)
2062    WHERE field BETWEEN ? AND ?
2063    WHERE MATCH(field) AGAINST (?, ?)
2064
2065 Special operators IN and BETWEEN are fairly standard and therefore
2066 are builtin within C<SQL::Abstract>. For other operators,
2067 like the MATCH .. AGAINST example above which is
2068 specific to MySQL, you can write your own operator handlers :
2069 supply a C<special_ops> argument to the C<new> method.
2070 That argument takes an arrayref of operator definitions;
2071 each operator definition is a hashref with two entries
2072
2073 =over
2074
2075 =item regex
2076
2077 the regular expression to match the operator
2078
2079 =item handler
2080
2081 coderef that will be called when meeting that operator
2082 in the input tree. The coderef will be called with
2083 arguments  C<< ($self, $field, $op, $arg) >>, and
2084 should return a C<< ($sql, @bind) >> structure.
2085
2086 =back
2087
2088 For example, here is an implementation
2089 of the MATCH .. AGAINST syntax for MySQL
2090
2091   my $sqlmaker = SQL::Abstract->new(special_ops => [
2092
2093     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2094     {regex => qr/^match$/i,
2095      handler => sub {
2096        my ($self, $field, $op, $arg) = @_;
2097        $arg = [$arg] if not ref $arg;
2098        my $label         = $self->_quote($field);
2099        my ($placeholder) = $self->_convert('?');
2100        my $placeholders  = join ", ", (($placeholder) x @$arg);
2101        my $sql           = $self->_sqlcase('match') . " ($label) "
2102                          . $self->_sqlcase('against') . " ($placeholders) ";
2103        my @bind = $self->_bindtype($field, @$arg);
2104        return ($sql, @bind);
2105        }
2106      },
2107
2108   ]);
2109
2110
2111 =head1 PERFORMANCE
2112
2113 Thanks to some benchmarking by Mark Stosberg, it turns out that
2114 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2115 I must admit this wasn't an intentional design issue, but it's a
2116 byproduct of the fact that you get to control your C<DBI> handles
2117 yourself.
2118
2119 To maximize performance, use a code snippet like the following:
2120
2121     # prepare a statement handle using the first row
2122     # and then reuse it for the rest of the rows
2123     my($sth, $stmt);
2124     for my $href (@array_of_hashrefs) {
2125         $stmt ||= $sql->insert('table', $href);
2126         $sth  ||= $dbh->prepare($stmt);
2127         $sth->execute($sql->values($href));
2128     }
2129
2130 The reason this works is because the keys in your C<$href> are sorted
2131 internally by B<SQL::Abstract>. Thus, as long as your data retains
2132 the same structure, you only have to generate the SQL the first time
2133 around. On subsequent queries, simply use the C<values> function provided
2134 by this module to return your values in the correct order.
2135
2136
2137 =head1 FORMBUILDER
2138
2139 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2140 really like this part (I do, at least). Building up a complex query
2141 can be as simple as the following:
2142
2143     #!/usr/bin/perl
2144
2145     use CGI::FormBuilder;
2146     use SQL::Abstract;
2147
2148     my $form = CGI::FormBuilder->new(...);
2149     my $sql  = SQL::Abstract->new;
2150
2151     if ($form->submitted) {
2152         my $field = $form->field;
2153         my $id = delete $field->{id};
2154         my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2155     }
2156
2157 Of course, you would still have to connect using C<DBI> to run the
2158 query, but the point is that if you make your form look like your
2159 table, the actual query script can be extremely simplistic.
2160
2161 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2162 a fast interface to returning and formatting data. I frequently
2163 use these three modules together to write complex database query
2164 apps in under 50 lines.
2165
2166
2167 =head1 CHANGES
2168
2169 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2170 Great care has been taken to preserve the I<published> behavior
2171 documented in previous versions in the 1.* family; however,
2172 some features that were previously undocumented, or behaved
2173 differently from the documentation, had to be changed in order
2174 to clarify the semantics. Hence, client code that was relying
2175 on some dark areas of C<SQL::Abstract> v1.*
2176 B<might behave differently> in v1.50.
2177
2178 The main changes are :
2179
2180 =over
2181
2182 =item *
2183
2184 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2185
2186 =item *
2187
2188 support for the { operator => \"..." } construct (to embed literal SQL)
2189
2190 =item *
2191
2192 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2193
2194 =item *
2195
2196 added -nest1, -nest2 or -nest_1, -nest_2, ...
2197
2198 =item *
2199
2200 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2201
2202 =item *
2203
2204 defensive programming : check arguments
2205
2206 =item *
2207
2208 fixed bug with global logic, which was previously implemented
2209 through global variables yielding side-effects. Prior versons would
2210 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2211 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2212 Now this is interpreted
2213 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2214
2215 =item *
2216
2217 C<-and> / C<-or> operators are no longer accepted
2218 in the middle of an arrayref : they are
2219 only admitted if in first position.
2220
2221 =item *
2222
2223 changed logic for distributing an op over arrayrefs
2224
2225 =item *
2226
2227 fixed semantics of  _bindtype on array args
2228
2229 =item *
2230
2231 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2232 we just avoid shifting arrays within that tree.
2233
2234 =item *
2235
2236 dropped the C<_modlogic> function
2237
2238 =back
2239
2240
2241
2242 =head1 ACKNOWLEDGEMENTS
2243
2244 There are a number of individuals that have really helped out with
2245 this module. Unfortunately, most of them submitted bugs via CPAN
2246 so I have no idea who they are! But the people I do know are:
2247
2248     Ash Berlin (order_by hash term support)
2249     Matt Trout (DBIx::Class support)
2250     Mark Stosberg (benchmarking)
2251     Chas Owens (initial "IN" operator support)
2252     Philip Collins (per-field SQL functions)
2253     Eric Kolve (hashref "AND" support)
2254     Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2255     Dan Kubb (support for "quote_char" and "name_sep")
2256     Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2257     Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2258     Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2259
2260 Thanks!
2261
2262 =head1 SEE ALSO
2263
2264 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2265
2266 =head1 AUTHOR
2267
2268 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2269
2270 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2271
2272 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2273 While not an official support venue, C<DBIx::Class> makes heavy use of
2274 C<SQL::Abstract>, and as such list members there are very familiar with
2275 how to create queries.
2276
2277 This module is free software; you may copy this under the terms of
2278 the GNU General Public License, or the Artistic License, copies of
2279 which should have accompanied your Perl kit.
2280
2281 =cut
2282