lib/SQL/Abstract.pm

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