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