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