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     UNDEF     => sub {},
 715     SCALARREF => sub {$$arg}, # literal SQL, no quoting
 716     HASHREF   => sub {$self->_order_by_hash($arg)},
 717
 718   });
 719
 720   # build SQL
 721   my $order = join ', ', @order;
 722   return $order ? $self->_sqlcase(' order by')." $order" : '';
 723 }
 724
 725
 726 sub _order_by_hash {
 727   my ($self, $hash) = @_;
 728
 729   # get first pair in hash
 730   my ($key, $val) = each %$hash;
 731
 732   # check if one pair was found and no other pair in hash
 733   $key && !(each %$hash)
 734     or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
 735
 736   my ($order) = ($key =~ /^-(desc|asc)/i)
 737     or puke "invalid key in _order_by hash : $key";
 738
 739   return $self->_quote($val) ." ". $self->_sqlcase($order);
 740 }
 741
 742
 743
 744 #======================================================================
 745 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
 746 #======================================================================
 747
 748 sub _table  {
 749   my $self = shift;
 750   my $from = shift;
 751   $self->_SWITCH_refkind($from, {
 752     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$from;},
 753     SCALAR       => sub {$self->_quote($from)},
 754     SCALARREF    => sub {$$from},
 755     ARRAYREFREF  => sub {join ', ', @$from;},
 756   });
 757 }
 758
 759
 760 #======================================================================
 761 # UTILITY FUNCTIONS
 762 #======================================================================
 763
 764 sub _quote {
 765   my $self  = shift;
 766   my $label = shift;
 767
 768   $label or puke "can't quote an empty label";
 769
 770   # left and right quote characters
 771   my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
 772     SCALAR   => sub {($self->{quote_char}, $self->{quote_char})},
 773     ARRAYREF => sub {@{$self->{quote_char}}},
 774     UNDEF    => sub {()},
 775    });
 776   not @other
 777       or puke "quote_char must be an arrayref of 2 values";
 778
 779   # no quoting if no quoting chars
 780   $ql or return $label;
 781
 782   # no quoting for literal SQL
 783   return $$label if ref($label) eq 'SCALAR';
 784
 785   # separate table / column (if applicable)
 786   my $sep = $self->{name_sep} || '';
 787   my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
 788
 789   # do the quoting, except for "*" or for `table`.*
 790   my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
 791
 792   # reassemble and return.
 793   return join $sep, @quoted;
 794 }
 795
 796
 797 # Conversion, if applicable
 798 sub _convert ($) {
 799   my ($self, $arg) = @_;
 800
 801 # LDNOTE : modified the previous implementation below because
 802 # it was not consistent : the first "return" is always an array,
 803 # the second "return" is context-dependent. Anyway, _convert
 804 # seems always used with just a single argument, so make it a
 805 # scalar function.
 806 #     return @_ unless $self->{convert};
 807 #     my $conv = $self->_sqlcase($self->{convert});
 808 #     my @ret = map { $conv.'('.$_.')' } @_;
 809 #     return wantarray ? @ret : $ret[0];
 810   if ($self->{convert}) {
 811     my $conv = $self->_sqlcase($self->{convert});
 812     $arg = $conv.'('.$arg.')';
 813   }
 814   return $arg;
 815 }
 816
 817 # And bindtype
 818 sub _bindtype (@) {
 819   my $self = shift;
 820   my($col, @vals) = @_;
 821
 822   #LDNOTE : changed original implementation below because it did not make
 823   # sense when bindtype eq 'columns' and @vals > 1.
 824 #  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
 825
 826   return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
 827 }
 828
 829 sub _join_sql_clauses {
 830   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
 831
 832   if (@$clauses_aref > 1) {
 833     my $join  = " " . $self->_sqlcase($logic) . " ";
 834     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
 835     return ($sql, @$bind_aref);
 836   }
 837   elsif (@$clauses_aref) {
 838     return ($clauses_aref->[0], @$bind_aref); # no parentheses
 839   }
 840   else {
 841     return (); # if no SQL, ignore @$bind_aref
 842   }
 843 }
 844
 845
 846 # Fix SQL case, if so requested
 847 sub _sqlcase {
 848   my $self = shift;
 849
 850   # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
 851   # don't touch the argument ... crooked logic, but let's not change it!
 852   return $self->{case} ? $_[0] : uc($_[0]);
 853 }
 854
 855
 856 #======================================================================
 857 # DISPATCHING FROM REFKIND
 858 #======================================================================
 859
 860 sub _refkind {
 861   my ($self, $data) = @_;
 862   my $suffix = '';
 863   my $ref;
 864
 865   # $suffix = 'REF' x (length of ref chain, i. e. \\[] is REFREFREF)
 866   while (1) {
 867     $suffix .= 'REF';
 868     $ref     = ref $data;
 869     last if $ref ne 'REF';
 870     $data = $$data;
 871   }
 872
 873   return $ref          ? $ref.$suffix   :
 874          defined $data ? 'SCALAR'       :
 875                          'UNDEF';
 876 }
 877
 878 sub _try_refkind {
 879   my ($self, $data) = @_;
 880   my @try = ($self->_refkind($data));
 881   push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
 882   push @try, 'FALLBACK';
 883   return @try;
 884 }
 885
 886 sub _METHOD_FOR_refkind {
 887   my ($self, $meth_prefix, $data) = @_;
 888   my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
 889                               $self->_try_refkind($data)
 890     or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
 891   return $method;
 892 }
 893
 894
 895 sub _SWITCH_refkind {
 896   my ($self, $data, $dispatch_table) = @_;
 897
 898   my $coderef = first {$_} map {$dispatch_table->{$_}}
 899                                $self->_try_refkind($data)
 900     or puke "no dispatch entry for ".$self->_refkind($data);
 901   $coderef->();
 902 }
 903
 904
 905
 906
 907 #======================================================================
 908 # VALUES, GENERATE, AUTOLOAD
 909 #======================================================================
 910
 911 # LDNOTE: original code from nwiger, didn't touch code in that section
 912 # I feel the AUTOLOAD stuff should not be the default, it should
 913 # only be activated on explicit demand by user.
 914
 915 sub values {
 916     my $self = shift;
 917     my $data = shift || return;
 918     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
 919         unless ref $data eq 'HASH';
 920     return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
 921 }
 922
 923 sub generate {
 924     my $self  = shift;
 925
 926     my(@sql, @sqlq, @sqlv);
 927
 928     for (@_) {
 929         my $ref = ref $_;
 930         if ($ref eq 'HASH') {
 931             for my $k (sort keys %$_) {
 932                 my $v = $_->{$k};
 933                 my $r = ref $v;
 934                 my $label = $self->_quote($k);
 935                 if ($r eq 'ARRAY') {
 936                     # SQL included for values
 937                     my @bind = @$v;
 938                     my $sql = shift @bind;
 939                     push @sqlq, "$label = $sql";
 940                     push @sqlv, $self->_bindtype($k, @bind);
 941                 } elsif ($r eq 'SCALAR') {
 942                     # embedded literal SQL
 943                     push @sqlq, "$label = $$v";
 944                 } else {
 945                     push @sqlq, "$label = ?";
 946                     push @sqlv, $self->_bindtype($k, $v);
 947                 }
 948             }
 949             push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
 950         } elsif ($ref eq 'ARRAY') {
 951             # unlike insert(), assume these are ONLY the column names, i.e. for SQL
 952             for my $v (@$_) {
 953                 my $r = ref $v;
 954                 if ($r eq 'ARRAY') {
 955                     my @val = @$v;
 956                     push @sqlq, shift @val;
 957                     push @sqlv, @val;
 958                 } elsif ($r eq 'SCALAR') {
 959                     # embedded literal SQL
 960                     push @sqlq, $$v;
 961                 } else {
 962                     push @sqlq, '?';
 963                     push @sqlv, $v;
 964                 }
 965             }
 966             push @sql, '(' . join(', ', @sqlq) . ')';
 967         } elsif ($ref eq 'SCALAR') {
 968             # literal SQL
 969             push @sql, $$_;
 970         } else {
 971             # strings get case twiddled
 972             push @sql, $self->_sqlcase($_);
 973         }
 974     }
 975
 976     my $sql = join ' ', @sql;
 977
 978     # this is pretty tricky
 979     # if ask for an array, return ($stmt, @bind)
 980     # otherwise, s/?/shift @sqlv/ to put it inline
 981     if (wantarray) {
 982         return ($sql, @sqlv);
 983     } else {
 984         1 while $sql =~ s/\?/my $d = shift(@sqlv);
 985                              ref $d ? $d->[1] : $d/e;
 986         return $sql;
 987     }
 988 }
 989
 990
 991 sub DESTROY { 1 }
 992
 993 sub AUTOLOAD {
 994     # This allows us to check for a local, then _form, attr
 995     my $self = shift;
 996     my($name) = $AUTOLOAD =~ /.*::(.+)/;
 997     return $self->generate($name, @_);
 998 }
 999
1000 1;
1001
1002
1003
1004 __END__
1005
1006 =head1 NAME
1007
1008 SQL::Abstract - Generate SQL from Perl data structures
1009
1010 =head1 SYNOPSIS
1011
1012     use SQL::Abstract;
1013
1014     my $sql = SQL::Abstract->new;
1015
1016     my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1017
1018     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1019
1020     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1021
1022     my($stmt, @bind) = $sql->delete($table, \%where);
1023
1024     # Then, use these in your DBI statements
1025     my $sth = $dbh->prepare($stmt);
1026     $sth->execute(@bind);
1027
1028     # Just generate the WHERE clause
1029     my($stmt, @bind) = $sql->where(\%where, \@order);
1030
1031     # Return values in the same order, for hashed queries
1032     # See PERFORMANCE section for more details
1033     my @bind = $sql->values(\%fieldvals);
1034
1035 =head1 DESCRIPTION
1036
1037 This module was inspired by the excellent L<DBIx::Abstract>.
1038 However, in using that module I found that what I really wanted
1039 to do was generate SQL, but still retain complete control over my
1040 statement handles and use the DBI interface. So, I set out to
1041 create an abstract SQL generation module.
1042
1043 While based on the concepts used by L<DBIx::Abstract>, there are
1044 several important differences, especially when it comes to WHERE
1045 clauses. I have modified the concepts used to make the SQL easier
1046 to generate from Perl data structures and, IMO, more intuitive.
1047 The underlying idea is for this module to do what you mean, based
1048 on the data structures you provide it. The big advantage is that
1049 you don't have to modify your code every time your data changes,
1050 as this module figures it out.
1051
1052 To begin with, an SQL INSERT is as easy as just specifying a hash
1053 of C<key=value> pairs:
1054
1055     my %data = (
1056         name => 'Jimbo Bobson',
1057         phone => '123-456-7890',
1058         address => '42 Sister Lane',
1059         city => 'St. Louis',
1060         state => 'Louisiana',
1061     );
1062
1063 The SQL can then be generated with this:
1064
1065     my($stmt, @bind) = $sql->insert('people', \%data);
1066
1067 Which would give you something like this:
1068
1069     $stmt = "INSERT INTO people
1070                     (address, city, name, phone, state)
1071                     VALUES (?, ?, ?, ?, ?)";
1072     @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1073              '123-456-7890', 'Louisiana');
1074
1075 These are then used directly in your DBI code:
1076
1077     my $sth = $dbh->prepare($stmt);
1078     $sth->execute(@bind);
1079
1080 =head2 Inserting and Updating Arrays
1081
1082 If your database has array types (like for example Postgres),
1083 activate the special option C<< array_datatypes => 1 >>
1084 when creating the C<SQL::Abstract> object.
1085 Then you may use an arrayref to insert and update database array types:
1086
1087     my $sql = SQL::Abstract->new(array_datatypes => 1);
1088     my %data = (
1089         planets => [qw/Mercury Venus Earth Mars/]
1090     );
1091
1092     my($stmt, @bind) = $sql->insert('solar_system', \%data);
1093
1094 This results in:
1095
1096     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1097
1098     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1099
1100
1101 =head2 Inserting and Updating SQL
1102
1103 In order to apply SQL functions to elements of your C<%data> you may
1104 specify a reference to an arrayref for the given hash value. For example,
1105 if you need to execute the Oracle C<to_date> function on a value, you can
1106 say something like this:
1107
1108     my %data = (
1109         name => 'Bill',
1110         date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1111     );
1112
1113 The first value in the array is the actual SQL. Any other values are
1114 optional and would be included in the bind values array. This gives
1115 you:
1116
1117     my($stmt, @bind) = $sql->insert('people', \%data);
1118
1119     $stmt = "INSERT INTO people (name, date_entered)
1120                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1121     @bind = ('Bill', '03/02/2003');
1122
1123 An UPDATE is just as easy, all you change is the name of the function:
1124
1125     my($stmt, @bind) = $sql->update('people', \%data);
1126
1127 Notice that your C<%data> isn't touched; the module will generate
1128 the appropriately quirky SQL for you automatically. Usually you'll
1129 want to specify a WHERE clause for your UPDATE, though, which is
1130 where handling C<%where> hashes comes in handy...
1131
1132 =head2 Complex where statements
1133
1134 This module can generate pretty complicated WHERE statements
1135 easily. For example, simple C<key=value> pairs are taken to mean
1136 equality, and if you want to see if a field is within a set
1137 of values, you can use an arrayref. Let's say we wanted to
1138 SELECT some data based on this criteria:
1139
1140     my %where = (
1141        requestor => 'inna',
1142        worker => ['nwiger', 'rcwe', 'sfz'],
1143        status => { '!=', 'completed' }
1144     );
1145
1146     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1147
1148 The above would give you something like this:
1149
1150     $stmt = "SELECT * FROM tickets WHERE
1151                 ( requestor = ? ) AND ( status != ? )
1152                 AND ( worker = ? OR worker = ? OR worker = ? )";
1153     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1154
1155 Which you could then use in DBI code like so:
1156
1157     my $sth = $dbh->prepare($stmt);
1158     $sth->execute(@bind);
1159
1160 Easy, eh?
1161
1162 =head1 FUNCTIONS
1163
1164 The functions are simple. There's one for each major SQL operation,
1165 and a constructor you use first. The arguments are specified in a
1166 similar order to each function (table, then fields, then a where
1167 clause) to try and simplify things.
1168
1169
1170
1171
1172 =head2 new(option => 'value')
1173
1174 The C<new()> function takes a list of options and values, and returns
1175 a new B<SQL::Abstract> object which can then be used to generate SQL
1176 through the methods below. The options accepted are:
1177
1178 =over
1179
1180 =item case
1181
1182 If set to 'lower', then SQL will be generated in all lowercase. By
1183 default SQL is generated in "textbook" case meaning something like:
1184
1185     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1186
1187 Any setting other than 'lower' is ignored.
1188
1189 =item cmp
1190
1191 This determines what the default comparison operator is. By default
1192 it is C<=>, meaning that a hash like this:
1193
1194     %where = (name => 'nwiger', email => 'nate@wiger.org');
1195
1196 Will generate SQL like this:
1197
1198     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1199
1200 However, you may want loose comparisons by default, so if you set
1201 C<cmp> to C<like> you would get SQL such as:
1202
1203     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1204
1205 You can also override the comparsion on an individual basis - see
1206 the huge section on L</"WHERE CLAUSES"> at the bottom.
1207
1208 =item sqltrue, sqlfalse
1209
1210 Expressions for inserting boolean values within SQL statements.
1211 By default these are C<1=1> and C<1=0>.
1212
1213 =item logic
1214
1215 This determines the default logical operator for multiple WHERE
1216 statements in arrays. By default it is "or", meaning that a WHERE
1217 array of the form:
1218
1219     @where = (
1220         event_date => {'>=', '2/13/99'},
1221         event_date => {'<=', '4/24/03'},
1222     );
1223
1224 Will generate SQL like this:
1225
1226     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1227
1228 This is probably not what you want given this query, though (look
1229 at the dates). To change the "OR" to an "AND", simply specify:
1230
1231     my $sql = SQL::Abstract->new(logic => 'and');
1232
1233 Which will change the above C<WHERE> to:
1234
1235     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1236
1237 The logic can also be changed locally by inserting
1238 an extra first element in the array :
1239
1240     @where = (-and => event_date => {'>=', '2/13/99'},
1241                       event_date => {'<=', '4/24/03'} );
1242
1243 See the L</"WHERE CLAUSES"> section for explanations.
1244
1245 =item convert
1246
1247 This will automatically convert comparisons using the specified SQL
1248 function for both column and value. This is mostly used with an argument
1249 of C<upper> or C<lower>, so that the SQL will have the effect of
1250 case-insensitive "searches". For example, this:
1251
1252     $sql = SQL::Abstract->new(convert => 'upper');
1253     %where = (keywords => 'MaKe iT CAse inSeNSItive');
1254
1255 Will turn out the following SQL:
1256
1257     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1258
1259 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1260 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1261 not validate this option; it will just pass through what you specify verbatim).
1262
1263 =item bindtype
1264
1265 This is a kludge because many databases suck. For example, you can't
1266 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1267 Instead, you have to use C<bind_param()>:
1268
1269     $sth->bind_param(1, 'reg data');
1270     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1271
1272 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1273 which loses track of which field each slot refers to. Fear not.
1274
1275 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1276 Currently, you can specify either C<normal> (default) or C<columns>. If you
1277 specify C<columns>, you will get an array that looks like this:
1278
1279     my $sql = SQL::Abstract->new(bindtype => 'columns');
1280     my($stmt, @bind) = $sql->insert(...);
1281
1282     @bind = (
1283         [ 'column1', 'value1' ],
1284         [ 'column2', 'value2' ],
1285         [ 'column3', 'value3' ],
1286     );
1287
1288 You can then iterate through this manually, using DBI's C<bind_param()>.
1289
1290     $sth->prepare($stmt);
1291     my $i = 1;
1292     for (@bind) {
1293         my($col, $data) = @$_;
1294         if ($col eq 'details' || $col eq 'comments') {
1295             $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1296         } elsif ($col eq 'image') {
1297             $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1298         } else {
1299             $sth->bind_param($i, $data);
1300         }
1301         $i++;
1302     }
1303     $sth->execute;      # execute without @bind now
1304
1305 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1306 Basically, the advantage is still that you don't have to care which fields
1307 are or are not included. You could wrap that above C<for> loop in a simple
1308 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1309 get a layer of abstraction over manual SQL specification.
1310
1311 =item quote_char
1312
1313 This is the character that a table or column name will be quoted
1314 with.  By default this is an empty string, but you could set it to
1315 the character C<`>, to generate SQL like this:
1316
1317   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1318
1319 Alternatively, you can supply an array ref of two items, the first being the left
1320 hand quote character, and the second the right hand quote character. For
1321 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1322 that generates SQL like this:
1323
1324   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1325
1326 Quoting is useful if you have tables or columns names that are reserved
1327 words in your database's SQL dialect.
1328
1329 =item name_sep
1330
1331 This is the character that separates a table and column name.  It is
1332 necessary to specify this when the C<quote_char> option is selected,
1333 so that tables and column names can be individually quoted like this:
1334
1335   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1336
1337 =item array_datatypes
1338
1339 When this option is true, arrayrefs in INSERT or UPDATE are
1340 interpreted as array datatypes and are passed directly
1341 to the DBI layer.
1342 When this option is false, arrayrefs are interpreted
1343 as literal SQL, just like refs to arrayrefs
1344 (but this behavior is for backwards compatibility; when writing
1345 new queries, use the "reference to arrayref" syntax
1346 for literal SQL).
1347
1348
1349 =item special_ops
1350
1351 Takes a reference to a list of "special operators"
1352 to extend the syntax understood by L<SQL::Abstract>.
1353 See section L</"SPECIAL OPERATORS"> for details.
1354
1355
1356
1357 =back
1358
1359 =head2 insert($table, \@values || \%fieldvals)
1360
1361 This is the simplest function. You simply give it a table name
1362 and either an arrayref of values or hashref of field/value pairs.
1363 It returns an SQL INSERT statement and a list of bind values.
1364 See the sections on L</"Inserting and Updating Arrays"> and
1365 L</"Inserting and Updating SQL"> for information on how to insert
1366 with those data types.
1367
1368 =head2 update($table, \%fieldvals, \%where)
1369
1370 This takes a table, hashref of field/value pairs, and an optional
1371 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1372 of bind values.
1373 See the sections on L</"Inserting and Updating Arrays"> and
1374 L</"Inserting and Updating SQL"> for information on how to insert
1375 with those data types.
1376
1377 =head2 select($source, $fields, $where, $order)
1378
1379 This returns a SQL SELECT statement and associated list of bind values, as
1380 specified by the arguments  :
1381
1382 =over
1383
1384 =item $source
1385
1386 Specification of the 'FROM' part of the statement.
1387 The argument can be either a plain scalar (interpreted as a table
1388 name, will be quoted), or an arrayref (interpreted as a list
1389 of table names, joined by commas, quoted), or a scalarref
1390 (literal table name, not quoted), or a ref to an arrayref
1391 (list of literal table names, joined by commas, not quoted).
1392
1393 =item $fields
1394
1395 Specification of the list of fields to retrieve from
1396 the source.
1397 The argument can be either an arrayref (interpreted as a list
1398 of field names, will be joined by commas and quoted), or a
1399 plain scalar (literal SQL, not quoted).
1400 Please observe that this API is not as flexible as for
1401 the first argument C<$table>, for backwards compatibility reasons.
1402
1403 =item $where
1404
1405 Optional argument to specify the WHERE part of the query.
1406 The argument is most often a hashref, but can also be
1407 an arrayref or plain scalar --
1408 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
1409
1410 =item $order
1411
1412 Optional argument to specify the ORDER BY part of the query.
1413 The argument can be a scalar, a hashref or an arrayref
1414 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
1415 for details.
1416
1417 =back
1418
1419
1420 =head2 delete($table, \%where)
1421
1422 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
1423 It returns an SQL DELETE statement and list of bind values.
1424
1425 =head2 where(\%where, \@order)
1426
1427 This is used to generate just the WHERE clause. For example,
1428 if you have an arbitrary data structure and know what the
1429 rest of your SQL is going to look like, but want an easy way
1430 to produce a WHERE clause, use this. It returns an SQL WHERE
1431 clause and list of bind values.
1432
1433
1434 =head2 values(\%data)
1435
1436 This just returns the values from the hash C<%data>, in the same
1437 order that would be returned from any of the other above queries.
1438 Using this allows you to markedly speed up your queries if you
1439 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
1440
1441 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
1442
1443 Warning: This is an experimental method and subject to change.
1444
1445 This returns arbitrarily generated SQL. It's a really basic shortcut.
1446 It will return two different things, depending on return context:
1447
1448     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
1449     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
1450
1451 These would return the following:
1452
1453     # First calling form
1454     $stmt = "CREATE TABLE test (?, ?)";
1455     @bind = (field1, field2);
1456
1457     # Second calling form
1458     $stmt_and_val = "CREATE TABLE test (field1, field2)";
1459
1460 Depending on what you're trying to do, it's up to you to choose the correct
1461 format. In this example, the second form is what you would want.
1462
1463 By the same token:
1464
1465     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
1466
1467 Might give you:
1468
1469     ALTER SESSION SET nls_date_format = 'MM/YY'
1470
1471 You get the idea. Strings get their case twiddled, but everything
1472 else remains verbatim.
1473
1474
1475
1476
1477 =head1 WHERE CLAUSES
1478
1479 =head2 Introduction
1480
1481 This module uses a variation on the idea from L<DBIx::Abstract>. It
1482 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
1483 module is that things in arrays are OR'ed, and things in hashes
1484 are AND'ed.>
1485
1486 The easiest way to explain is to show lots of examples. After
1487 each C<%where> hash shown, it is assumed you used:
1488
1489     my($stmt, @bind) = $sql->where(\%where);
1490
1491 However, note that the C<%where> hash can be used directly in any
1492 of the other functions as well, as described above.
1493
1494 =head2 Key-value pairs
1495
1496 So, let's get started. To begin, a simple hash:
1497
1498     my %where  = (
1499         user   => 'nwiger',
1500         status => 'completed'
1501     );
1502
1503 Is converted to SQL C<key = val> statements:
1504
1505     $stmt = "WHERE user = ? AND status = ?";
1506     @bind = ('nwiger', 'completed');
1507
1508 One common thing I end up doing is having a list of values that
1509 a field can be in. To do this, simply specify a list inside of
1510 an arrayref:
1511
1512     my %where  = (
1513         user   => 'nwiger',
1514         status => ['assigned', 'in-progress', 'pending'];
1515     );
1516
1517 This simple code will create the following:
1518
1519     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
1520     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
1521
1522 An empty arrayref will be considered a logical false and
1523 will generate 0=1.
1524
1525 =head2 Key-value pairs
1526
1527 If you want to specify a different type of operator for your comparison,
1528 you can use a hashref for a given column:
1529
1530     my %where  = (
1531         user   => 'nwiger',
1532         status => { '!=', 'completed' }
1533     );
1534
1535 Which would generate:
1536
1537     $stmt = "WHERE user = ? AND status != ?";
1538     @bind = ('nwiger', 'completed');
1539
1540 To test against multiple values, just enclose the values in an arrayref:
1541
1542     status => { '!=', ['assigned', 'in-progress', 'pending'] };
1543
1544 Which would give you:
1545
1546     "WHERE status != ? AND status != ? AND status != ?"
1547
1548 Notice that since the operator was recognized as being a 'negative'
1549 operator, the arrayref was interpreted with 'AND' logic (because
1550 of Morgan's laws). By contrast, the reverse
1551
1552     status => { '=', ['assigned', 'in-progress', 'pending'] };
1553
1554 would generate :
1555
1556     "WHERE status = ? OR status = ? OR status = ?"
1557
1558
1559 The hashref can also contain multiple pairs, in which case it is expanded
1560 into an C<AND> of its elements:
1561
1562     my %where  = (
1563         user   => 'nwiger',
1564         status => { '!=', 'completed', -not_like => 'pending%' }
1565     );
1566
1567     # Or more dynamically, like from a form
1568     $where{user} = 'nwiger';
1569     $where{status}{'!='} = 'completed';
1570     $where{status}{'-not_like'} = 'pending%';
1571
1572     # Both generate this
1573     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
1574     @bind = ('nwiger', 'completed', 'pending%');
1575
1576
1577 To get an OR instead, you can combine it with the arrayref idea:
1578
1579     my %where => (
1580          user => 'nwiger',
1581          priority => [ {'=', 2}, {'!=', 1} ]
1582     );
1583
1584 Which would generate:
1585
1586     $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
1587     @bind = ('nwiger', '2', '1');
1588
1589
1590 =head2 Logic and nesting operators
1591
1592 In the example above,
1593 there is a subtle trap if you want to say something like
1594 this (notice the C<AND>):
1595
1596     WHERE priority != ? AND priority != ?
1597
1598 Because, in Perl you I<can't> do this:
1599
1600     priority => { '!=', 2, '!=', 1 }
1601
1602 As the second C<!=> key will obliterate the first. The solution
1603 is to use the special C<-modifier> form inside an arrayref:
1604
1605     priority => [ -and => {'!=', 2},
1606                           {'!=', 1} ]
1607
1608
1609 Normally, these would be joined by C<OR>, but the modifier tells it
1610 to use C<AND> instead. (Hint: You can use this in conjunction with the
1611 C<logic> option to C<new()> in order to change the way your queries
1612 work by default.) B<Important:> Note that the C<-modifier> goes
1613 B<INSIDE> the arrayref, as an extra first element. This will
1614 B<NOT> do what you think it might:
1615
1616     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
1617
1618 Here is a quick list of equivalencies, since there is some overlap:
1619
1620     # Same
1621     status => {'!=', 'completed', 'not like', 'pending%' }
1622     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1623
1624     # Same
1625     status => {'=', ['assigned', 'in-progress']}
1626     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1627     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1628
1629 In addition to C<-and> and C<-or>, there is also a special C<-nest>
1630 operator which adds an additional set of parens, to create a subquery.
1631 For example, to get something like this:
1632
1633     $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
1634     @bind = ('nwiger', '20', 'ASIA');
1635
1636 You would do:
1637
1638     my %where = (
1639          user => 'nwiger',
1640         -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1641     );
1642
1643 If you need several nested subexpressions, you can number
1644 the C<-nest> branches :
1645
1646     my %where = (
1647          user => 'nwiger',
1648         -nest1 => ...,
1649         -nest2 => ...,
1650         ...
1651     );
1652
1653
1654 =head2 Special operators : IN, BETWEEN, etc.
1655
1656 You can also use the hashref format to compare a list of fields using the
1657 C<IN> comparison operator, by specifying the list as an arrayref:
1658
1659     my %where  = (
1660         status   => 'completed',
1661         reportid => { -in => [567, 2335, 2] }
1662     );
1663
1664 Which would generate:
1665
1666     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1667     @bind = ('completed', '567', '2335', '2');
1668
1669 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
1670 the same way.
1671
1672 Another pair of operators is C<-between> and C<-not_between>,
1673 used with an arrayref of two values:
1674
1675     my %where  = (
1676         user   => 'nwiger',
1677         completion_date => {
1678            -not_between => ['2002-10-01', '2003-02-06']
1679         }
1680     );
1681
1682 Would give you:
1683
1684     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1685
1686 These are the two builtin "special operators"; but the
1687 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
1688
1689 =head2 Nested conditions
1690
1691 So far, we've seen how multiple conditions are joined with a top-level
1692 C<AND>.  We can change this by putting the different conditions we want in
1693 hashes and then putting those hashes in an array. For example:
1694
1695     my @where = (
1696         {
1697             user   => 'nwiger',
1698             status => { -like => ['pending%', 'dispatched'] },
1699         },
1700         {
1701             user   => 'robot',
1702             status => 'unassigned',
1703         }
1704     );
1705
1706 This data structure would create the following:
1707
1708     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1709                 OR ( user = ? AND status = ? ) )";
1710     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1711
1712 This can be combined with the C<-nest> operator to properly group
1713 SQL statements:
1714
1715     my @where = (
1716          -and => [
1717             user => 'nwiger',
1718             -nest => [
1719                 ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
1720                 ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
1721             ],
1722         ],
1723     );
1724
1725 That would yield:
1726
1727     WHERE ( user = ? AND
1728           ( ( workhrs > ? AND geo = ? )
1729          OR ( workhrs < ? AND geo = ? ) ) )
1730
1731 =head2 Literal SQL
1732
1733 Finally, sometimes only literal SQL will do. If you want to include
1734 literal SQL verbatim, you can specify it as a scalar reference, namely:
1735
1736     my $inn = 'is Not Null';
1737     my %where = (
1738         priority => { '<', 2 },
1739         requestor => \$inn
1740     );
1741
1742 This would create:
1743
1744     $stmt = "WHERE priority < ? AND requestor is Not Null";
1745     @bind = ('2');
1746
1747 Note that in this example, you only get one bind parameter back, since
1748 the verbatim SQL is passed as part of the statement.
1749
1750 Of course, just to prove a point, the above can also be accomplished
1751 with this:
1752
1753     my %where = (
1754         priority  => { '<', 2 },
1755         requestor => { '!=', undef },
1756     );
1757
1758
1759 TMTOWTDI.
1760
1761 Conditions on boolean columns can be expressed in the
1762 same way, passing a reference to an empty string :
1763
1764     my %where = (
1765         priority  => { '<', 2 },
1766         is_ready  => \"";
1767     );
1768
1769 which yields
1770
1771     $stmt = "WHERE priority < ? AND is_ready";
1772     @bind = ('2');
1773
1774
1775 =head2 Literal SQL with placeholders and bind values (subqueries)
1776
1777 If the literal SQL to be inserted has placeholders and bind values,
1778 use a reference to an arrayref (yes this is a double reference --
1779 not so common, but perfectly legal Perl). For example, to find a date
1780 in Postgres you can use something like this:
1781
1782     my %where = (
1783        date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
1784     )
1785
1786 This would create:
1787
1788     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
1789     @bind = ('10');
1790
1791
1792 Literal SQL is especially useful for nesting parenthesized clauses in the
1793 main SQL query. Here is a first example :
1794
1795   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
1796                                100, "foo%");
1797   my %where = (
1798     foo => 1234,
1799     bar => \["IN ($sub_stmt)" => @sub_bind],
1800   );
1801
1802 This yields :
1803
1804   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
1805                                              WHERE c2 < ? AND c3 LIKE ?))";
1806   @bind = (1234, 100, "foo%");
1807
1808 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
1809 are expressed in the same way. Of course the C<$sub_stmt> and
1810 its associated bind values can be generated through a former call
1811 to C<select()> :
1812
1813   my ($sub_stmt, @sub_bind)
1814      = $sql->select("t1", "c1", {c2 => {"<" => 100},
1815                                  c3 => {-like => "foo%"}});
1816   my %where = (
1817     foo => 1234,
1818     bar => \["> ALL ($sub_stmt)" => @sub_bind],
1819   );
1820
1821 In the examples above, the subquery was used as an operator on a column;
1822 but the same principle also applies for a clause within the main C<%where>
1823 hash, like an EXISTS subquery :
1824
1825   my ($sub_stmt, @sub_bind)
1826      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
1827   my %where = (
1828     foo   => 1234,
1829     -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
1830   );
1831
1832 which yields
1833
1834   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
1835                                         WHERE c1 = ? AND c2 > t0.c0))";
1836   @bind = (1234, 1);
1837
1838
1839 Observe that the condition on C<c2> in the subquery refers to
1840 column C<t0.c0> of the main query : this is I<not> a bind
1841 value, so we have to express it through a scalar ref.
1842 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
1843 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
1844 what we wanted here.
1845
1846 Another use of the subquery technique is when some SQL clauses need
1847 parentheses, as it often occurs with some proprietary SQL extensions
1848 like for example fulltext expressions, geospatial expressions,
1849 NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
1850
1851   my %where = (
1852     -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
1853   );
1854
1855 Finally, here is an example where a subquery is used
1856 for expressing unary negation:
1857
1858   my ($sub_stmt, @sub_bind)
1859      = $sql->where({age => [{"<" => 10}, {">" => 20}]});
1860   $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
1861   my %where = (
1862         lname  => {like => '%son%'},
1863         -nest  => \["NOT ($sub_stmt)" => @sub_bind],
1864     );
1865
1866 This yields
1867
1868   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
1869   @bind = ('%son%', 10, 20)
1870
1871
1872
1873 =head2 Conclusion
1874
1875 These pages could go on for a while, since the nesting of the data
1876 structures this module can handle are pretty much unlimited (the
1877 module implements the C<WHERE> expansion as a recursive function
1878 internally). Your best bet is to "play around" with the module a
1879 little to see how the data structures behave, and choose the best
1880 format for your data based on that.
1881
1882 And of course, all the values above will probably be replaced with
1883 variables gotten from forms or the command line. After all, if you
1884 knew everything ahead of time, you wouldn't have to worry about
1885 dynamically-generating SQL and could just hardwire it into your
1886 script.
1887
1888
1889
1890
1891 =head1 ORDER BY CLAUSES
1892
1893 Some functions take an order by clause. This can either be a scalar (just a
1894 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
1895 or an array of either of the two previous forms. Examples:
1896
1897              Given             |    Will Generate
1898     ----------------------------------------------------------
1899     \'colA DESC'               | ORDER BY colA DESC
1900     'colA'                     | ORDER BY colA
1901     [qw/colA colB/]            | ORDER BY colA, colB
1902     {-asc  => 'colA'}          | ORDER BY colA ASC
1903     {-desc => 'colB'}          | ORDER BY colB DESC
1904     [                          |
1905       {-asc  => 'colA'},       | ORDER BY colA ASC, colB DESC
1906       {-desc => 'colB'}        |
1907     ]                          |
1908     [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
1909     ==========================================================
1910
1911
1912
1913 =head1 SPECIAL OPERATORS
1914
1915   my $sqlmaker = SQL::Abstract->new(special_ops => [
1916      {regex => qr/.../,
1917       handler => sub {
1918         my ($self, $field, $op, $arg) = @_;
1919         ...
1920         },
1921      },
1922    ]);
1923
1924 A "special operator" is a SQL syntactic clause that can be
1925 applied to a field, instead of a usual binary operator.
1926 For example :
1927
1928    WHERE field IN (?, ?, ?)
1929    WHERE field BETWEEN ? AND ?
1930    WHERE MATCH(field) AGAINST (?, ?)
1931
1932 Special operators IN and BETWEEN are fairly standard and therefore
1933 are builtin within C<SQL::Abstract>. For other operators,
1934 like the MATCH .. AGAINST example above which is
1935 specific to MySQL, you can write your own operator handlers :
1936 supply a C<special_ops> argument to the C<new> method.
1937 That argument takes an arrayref of operator definitions;
1938 each operator definition is a hashref with two entries
1939
1940 =over
1941
1942 =item regex
1943
1944 the regular expression to match the operator
1945
1946 =item handler
1947
1948 coderef that will be called when meeting that operator
1949 in the input tree. The coderef will be called with
1950 arguments  C<< ($self, $field, $op, $arg) >>, and
1951 should return a C<< ($sql, @bind) >> structure.
1952
1953 =back
1954
1955 For example, here is an implementation
1956 of the MATCH .. AGAINST syntax for MySQL
1957
1958   my $sqlmaker = SQL::Abstract->new(special_ops => [
1959
1960     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
1961     {regex => qr/^match$/i,
1962      handler => sub {
1963        my ($self, $field, $op, $arg) = @_;
1964        $arg = [$arg] if not ref $arg;
1965        my $label         = $self->_quote($field);
1966        my ($placeholder) = $self->_convert('?');
1967        my $placeholders  = join ", ", (($placeholder) x @$arg);
1968        my $sql           = $self->_sqlcase('match') . " ($label) "
1969                          . $self->_sqlcase('against') . " ($placeholders) ";
1970        my @bind = $self->_bindtype($field, @$arg);
1971        return ($sql, @bind);
1972        }
1973      },
1974
1975   ]);
1976
1977
1978 =head1 PERFORMANCE
1979
1980 Thanks to some benchmarking by Mark Stosberg, it turns out that
1981 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
1982 I must admit this wasn't an intentional design issue, but it's a
1983 byproduct of the fact that you get to control your C<DBI> handles
1984 yourself.
1985
1986 To maximize performance, use a code snippet like the following:
1987
1988     # prepare a statement handle using the first row
1989     # and then reuse it for the rest of the rows
1990     my($sth, $stmt);
1991     for my $href (@array_of_hashrefs) {
1992         $stmt ||= $sql->insert('table', $href);
1993         $sth  ||= $dbh->prepare($stmt);
1994         $sth->execute($sql->values($href));
1995     }
1996
1997 The reason this works is because the keys in your C<$href> are sorted
1998 internally by B<SQL::Abstract>. Thus, as long as your data retains
1999 the same structure, you only have to generate the SQL the first time
2000 around. On subsequent queries, simply use the C<values> function provided
2001 by this module to return your values in the correct order.
2002
2003
2004 =head1 FORMBUILDER
2005
2006 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2007 really like this part (I do, at least). Building up a complex query
2008 can be as simple as the following:
2009
2010     #!/usr/bin/perl
2011
2012     use CGI::FormBuilder;
2013     use SQL::Abstract;
2014
2015     my $form = CGI::FormBuilder->new(...);
2016     my $sql  = SQL::Abstract->new;
2017
2018     if ($form->submitted) {
2019         my $field = $form->field;
2020         my $id = delete $field->{id};
2021         my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2022     }
2023
2024 Of course, you would still have to connect using C<DBI> to run the
2025 query, but the point is that if you make your form look like your
2026 table, the actual query script can be extremely simplistic.
2027
2028 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2029 a fast interface to returning and formatting data. I frequently
2030 use these three modules together to write complex database query
2031 apps in under 50 lines.
2032
2033
2034 =head1 CHANGES
2035
2036 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2037 Great care has been taken to preserve the I<published> behavior
2038 documented in previous versions in the 1.* family; however,
2039 some features that were previously undocumented, or behaved
2040 differently from the documentation, had to be changed in order
2041 to clarify the semantics. Hence, client code that was relying
2042 on some dark areas of C<SQL::Abstract> v1.*
2043 B<might behave differently> in v1.50.
2044
2045 The main changes are :
2046
2047 =over
2048
2049 =item *
2050
2051 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2052
2053 =item *
2054
2055 added -nest1, -nest2 or -nest_1, -nest_2, ...
2056
2057 =item *
2058
2059 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2060
2061 =item *
2062
2063 defensive programming : check arguments
2064
2065 =item *
2066
2067 fixed bug with global logic, which was previously implemented
2068 through global variables yielding side-effects. Prior versons would
2069 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2070 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2071 Now this is interpreted
2072 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2073
2074 =item *
2075
2076 C<-and> / C<-or> operators are no longer accepted
2077 in the middle of an arrayref : they are
2078 only admitted if in first position.
2079
2080 =item *
2081
2082 changed logic for distributing an op over arrayrefs
2083
2084 =item *
2085
2086 fixed semantics of  _bindtype on array args
2087
2088 =item *
2089
2090 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2091 we just avoid shifting arrays within that tree.
2092
2093 =item *
2094
2095 dropped the C<_modlogic> function
2096
2097 =back
2098
2099
2100
2101 =head1 ACKNOWLEDGEMENTS
2102
2103 There are a number of individuals that have really helped out with
2104 this module. Unfortunately, most of them submitted bugs via CPAN
2105 so I have no idea who they are! But the people I do know are:
2106
2107     Ash Berlin (order_by hash term support)
2108     Matt Trout (DBIx::Class support)
2109     Mark Stosberg (benchmarking)
2110     Chas Owens (initial "IN" operator support)
2111     Philip Collins (per-field SQL functions)
2112     Eric Kolve (hashref "AND" support)
2113     Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2114     Dan Kubb (support for "quote_char" and "name_sep")
2115     Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2116     Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
2117
2118 Thanks!
2119
2120 =head1 SEE ALSO
2121
2122 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2123
2124 =head1 AUTHOR
2125
2126 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2127
2128 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2129
2130 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2131 While not an official support venue, C<DBIx::Class> makes heavy use of
2132 C<SQL::Abstract>, and as such list members there are very familiar with
2133 how to create queries.
2134
2135 This module is free software; you may copy this under the terms of
2136 the GNU General Public License, or the Artistic License, copies of
2137 which should have accompanied your Perl kit.
2138
2139 =cut
2140