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