lib/SQL/Abstract.pm

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