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