lib/SQL/Abstract.pm

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