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