lib/SQL/Abstract.pm

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