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