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