lib/SQL/Abstract.pm

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