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