lib/SQL/Abstract.pm

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