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