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          my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
1014          $self->$method('', $val);
1015        }
1016     });
1017     push @all_sql, $sql;
1018     push @all_bind, @bind;
1019   }
1020
1021   my ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
1022
1023   my $sql = $k ? "( $label = $clause )" : "( $clause )";
1024   return ($sql, @bind)
1025 }
1026
1027 sub _where_op_OP {
1028   my ($self) = @_;
1029
1030   my ($k, $vals);
1031
1032   if (@_ == 3) {
1033      # $_[1] gets set to "op"
1034      $vals = $_[2];
1035      $k = '';
1036   } elsif (@_ == 4) {
1037      $k = $_[1];
1038      # $_[2] gets set to "op"
1039      $vals = $_[3];
1040   }
1041
1042   my $label       = $self->_convert($self->_quote($k));
1043   my $placeholder = $self->_convert('?');
1044
1045   puke 'argument to -op must be an arrayref' unless ref $vals eq 'ARRAY';
1046   puke 'first arg for -op must be a scalar' unless !ref $vals->[0];
1047
1048   my ($op, @rest_of_vals) = @$vals;
1049
1050   $self->_assert_pass_injection_guard($op);
1051
1052   my (@all_sql, @all_bind);
1053   foreach my $val (@rest_of_vals) {
1054     my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1055        SCALAR => sub {
1056          return ($placeholder, $self->_bindtype($k, $val) );
1057        },
1058        SCALARREF => sub {
1059          return $$val;
1060        },
1061        ARRAYREFREF => sub {
1062          my ($sql, @bind) = @$$val;
1063          $self->_assert_bindval_matches_bindtype(@bind);
1064          return ($sql, @bind);
1065        },
1066        HASHREF => sub {
1067          my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
1068          $self->$method('', $val);
1069        }
1070     });
1071     push @all_sql, $sql;
1072     push @all_bind, @bind;
1073   }
1074
1075   my ($clause, @bind) = ((join " $op ", @all_sql), @all_bind);
1076
1077   my $sql = $k ? "( $label = $clause )" : "( $clause )";
1078   return ($sql, @bind)
1079 }
1080
1081 sub _where_field_IN {
1082   my ($self, $k, $op, $vals) = @_;
1083
1084   # backwards compatibility : if scalar, force into an arrayref
1085   $vals = [$vals] if defined $vals && ! ref $vals;
1086
1087   my ($label)       = $self->_convert($self->_quote($k));
1088   my ($placeholder) = $self->_convert('?');
1089   $op               = $self->_sqlcase($op);
1090
1091   my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1092     ARRAYREF => sub {     # list of choices
1093       if (@$vals) { # nonempty list
1094         my (@all_sql, @all_bind);
1095
1096         for my $val (@$vals) {
1097           my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1098             SCALAR => sub {
1099               return ($placeholder, $val);
1100             },
1101             SCALARREF => sub {
1102               return $$val;
1103             },
1104             ARRAYREFREF => sub {
1105               my ($sql, @bind) = @$$val;
1106               $self->_assert_bindval_matches_bindtype(@bind);
1107               return ($sql, @bind);
1108             },
1109             HASHREF => sub {
1110               my ($func, $arg, @rest) = %$val;
1111               puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1112                 if (@rest or $func !~ /^ \- (.+)/x);
1113               local $self->{_nested_func_lhs} = $k;
1114               $self->_where_unary_op ($1 => $arg);
1115             },
1116             UNDEF => sub {
1117               return $self->_sqlcase('null');
1118             },
1119           });
1120           push @all_sql, $sql;
1121           push @all_bind, @bind;
1122         }
1123
1124         return (
1125           sprintf ('%s %s ( %s )',
1126             $label,
1127             $op,
1128             join (', ', @all_sql)
1129           ),
1130           $self->_bindtype($k, @all_bind),
1131         );
1132       }
1133       else { # empty list : some databases won't understand "IN ()", so DWIM
1134         my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1135         return ($sql);
1136       }
1137     },
1138
1139     SCALARREF => sub {  # literal SQL
1140       my $sql = $self->_open_outer_paren ($$vals);
1141       return ("$label $op ( $sql )");
1142     },
1143     ARRAYREFREF => sub {  # literal SQL with bind
1144       my ($sql, @bind) = @$$vals;
1145       $self->_assert_bindval_matches_bindtype(@bind);
1146       $sql = $self->_open_outer_paren ($sql);
1147       return ("$label $op ( $sql )", @bind);
1148     },
1149
1150     FALLBACK => sub {
1151       puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)";
1152     },
1153   });
1154
1155   return ($sql, @bind);
1156 }
1157
1158 # Some databases (SQLite) treat col IN (1, 2) different from
1159 # col IN ( (1, 2) ). Use this to strip all outer parens while
1160 # adding them back in the corresponding method
1161 sub _open_outer_paren {
1162   my ($self, $sql) = @_;
1163   $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
1164   return $sql;
1165 }
1166
1167
1168 #======================================================================
1169 # ORDER BY
1170 #======================================================================
1171
1172 sub _order_by {
1173   my ($self, $arg) = @_;
1174
1175   my (@sql, @bind);
1176   for my $c ($self->_order_by_chunks ($arg) ) {
1177     $self->_SWITCH_refkind ($c, {
1178       SCALAR => sub { push @sql, $c },
1179       ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1180     });
1181   }
1182
1183   my $sql = @sql
1184     ? sprintf ('%s %s',
1185         $self->_sqlcase(' order by'),
1186         join (', ', @sql)
1187       )
1188     : ''
1189   ;
1190
1191   return wantarray ? ($sql, @bind) : $sql;
1192 }
1193
1194 sub _order_by_chunks {
1195   my ($self, $arg) = @_;
1196
1197   return $self->_SWITCH_refkind($arg, {
1198
1199     ARRAYREF => sub {
1200       map { $self->_order_by_chunks ($_ ) } @$arg;
1201     },
1202
1203     ARRAYREFREF => sub {
1204       my ($s, @b) = @$$arg;
1205       $self->_assert_bindval_matches_bindtype(@b);
1206       [ $s, @b ];
1207     },
1208
1209     SCALAR    => sub {$self->_quote($arg)},
1210
1211     UNDEF     => sub {return () },
1212
1213     SCALARREF => sub {$$arg}, # literal SQL, no quoting
1214
1215     HASHREF   => sub {
1216       # get first pair in hash
1217       my ($key, $val, @rest) = %$arg;
1218
1219       return () unless $key;
1220
1221       if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1222         puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1223       }
1224
1225       my $direction = $1;
1226
1227       my @ret;
1228       for my $c ($self->_order_by_chunks ($val)) {
1229         my ($sql, @bind);
1230
1231         $self->_SWITCH_refkind ($c, {
1232           SCALAR => sub {
1233             $sql = $c;
1234           },
1235           ARRAYREF => sub {
1236             ($sql, @bind) = @$c;
1237           },
1238         });
1239
1240         $sql = $sql . ' ' . $self->_sqlcase($direction);
1241
1242         push @ret, [ $sql, @bind];
1243       }
1244
1245       return @ret;
1246     },
1247   });
1248 }
1249
1250
1251 #======================================================================
1252 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1253 #======================================================================
1254
1255 sub _table  {
1256   my $self = shift;
1257   my $from = shift;
1258   $self->_SWITCH_refkind($from, {
1259     ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$from;},
1260     SCALAR       => sub {$self->_quote($from)},
1261     SCALARREF    => sub {$$from},
1262     ARRAYREFREF  => sub {join ', ', @$from;},
1263   });
1264 }
1265
1266
1267 #======================================================================
1268 # UTILITY FUNCTIONS
1269 #======================================================================
1270
1271 # highly optimized, as it's called way too often
1272 sub _quote {
1273   # my ($self, $label) = @_;
1274
1275   return '' unless defined $_[1];
1276   return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1277
1278   unless ($_[0]->{quote_char}) {
1279     $_[0]->_assert_pass_injection_guard($_[1]);
1280     return $_[1];
1281   }
1282
1283   my $qref = ref $_[0]->{quote_char};
1284   my ($l, $r);
1285   if (!$qref) {
1286     ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1287   }
1288   elsif ($qref eq 'ARRAY') {
1289     ($l, $r) = @{$_[0]->{quote_char}};
1290   }
1291   else {
1292     puke "Unsupported quote_char format: $_[0]->{quote_char}";
1293   }
1294
1295   # parts containing * are naturally unquoted
1296   return join( $_[0]->{name_sep}||'', map
1297     { $_ eq '*' ? $_ : $l . $_ . $r }
1298     ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1299   );
1300 }
1301
1302
1303 # Conversion, if applicable
1304 sub _convert ($) {
1305   #my ($self, $arg) = @_;
1306
1307 # LDNOTE : modified the previous implementation below because
1308 # it was not consistent : the first "return" is always an array,
1309 # the second "return" is context-dependent. Anyway, _convert
1310 # seems always used with just a single argument, so make it a
1311 # scalar function.
1312 #     return @_ unless $self->{convert};
1313 #     my $conv = $self->_sqlcase($self->{convert});
1314 #     my @ret = map { $conv.'('.$_.')' } @_;
1315 #     return wantarray ? @ret : $ret[0];
1316   if ($_[0]->{convert}) {
1317     return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1318   }
1319   return $_[1];
1320 }
1321
1322 # And bindtype
1323 sub _bindtype (@) {
1324   #my ($self, $col, @vals) = @_;
1325
1326   #LDNOTE : changed original implementation below because it did not make
1327   # sense when bindtype eq 'columns' and @vals > 1.
1328 #  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
1329
1330   # called often - tighten code
1331   return $_[0]->{bindtype} eq 'columns'
1332     ? map {[$_[1], $_]} @_[2 .. $#_]
1333     : @_[2 .. $#_]
1334   ;
1335 }
1336
1337 # Dies if any element of @bind is not in [colname => value] format
1338 # if bindtype is 'columns'.
1339 sub _assert_bindval_matches_bindtype {
1340 #  my ($self, @bind) = @_;
1341   my $self = shift;
1342   if ($self->{bindtype} eq 'columns') {
1343     for (@_) {
1344       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1345         puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1346       }
1347     }
1348   }
1349 }
1350
1351 sub _join_sql_clauses {
1352   my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1353
1354   if (@$clauses_aref > 1) {
1355     my $join  = " " . $self->_sqlcase($logic) . " ";
1356     my $sql = '( ' . join($join, @$clauses_aref) . ' )';
1357     return ($sql, @$bind_aref);
1358   }
1359   elsif (@$clauses_aref) {
1360     return ($clauses_aref->[0], @$bind_aref); # no parentheses
1361   }
1362   else {
1363     return (); # if no SQL, ignore @$bind_aref
1364   }
1365 }
1366
1367
1368 # Fix SQL case, if so requested
1369 sub _sqlcase {
1370   # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1371   # don't touch the argument ... crooked logic, but let's not change it!
1372   return $_[0]->{case} ? $_[1] : uc($_[1]);
1373 }
1374
1375
1376 #======================================================================
1377 # DISPATCHING FROM REFKIND
1378 #======================================================================
1379
1380 sub _refkind {
1381   my ($self, $data) = @_;
1382
1383   return 'UNDEF' unless defined $data;
1384
1385   # blessed objects are treated like scalars
1386   my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1387
1388   return 'SCALAR' unless $ref;
1389
1390   my $n_steps = 1;
1391   while ($ref eq 'REF') {
1392     $data = $$data;
1393     $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1394     $n_steps++ if $ref;
1395   }
1396
1397   return ($ref||'SCALAR') . ('REF' x $n_steps);
1398 }
1399
1400 sub _try_refkind {
1401   my ($self, $data) = @_;
1402   my @try = ($self->_refkind($data));
1403   push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
1404   push @try, 'FALLBACK';
1405   return \@try;
1406 }
1407
1408 sub _METHOD_FOR_refkind {
1409   my ($self, $meth_prefix, $data) = @_;
1410
1411   my $method;
1412   for (@{$self->_try_refkind($data)}) {
1413     $method = $self->can($meth_prefix."_".$_)
1414       and last;
1415   }
1416
1417   return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1418 }
1419
1420
1421 sub _SWITCH_refkind {
1422   my ($self, $data, $dispatch_table) = @_;
1423
1424   my $coderef;
1425   for (@{$self->_try_refkind($data)}) {
1426     $coderef = $dispatch_table->{$_}
1427       and last;
1428   }
1429
1430   puke "no dispatch entry for ".$self->_refkind($data)
1431     unless $coderef;
1432
1433   $coderef->();
1434 }
1435
1436
1437
1438
1439 #======================================================================
1440 # VALUES, GENERATE, AUTOLOAD
1441 #======================================================================
1442
1443 # LDNOTE: original code from nwiger, didn't touch code in that section
1444 # I feel the AUTOLOAD stuff should not be the default, it should
1445 # only be activated on explicit demand by user.
1446
1447 sub values {
1448     my $self = shift;
1449     my $data = shift || return;
1450     puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1451         unless ref $data eq 'HASH';
1452
1453     my @all_bind;
1454     foreach my $k ( sort keys %$data ) {
1455         my $v = $data->{$k};
1456         $self->_SWITCH_refkind($v, {
1457           ARRAYREF => sub {
1458             if ($self->{array_datatypes}) { # array datatype
1459               push @all_bind, $self->_bindtype($k, $v);
1460             }
1461             else {                          # literal SQL with bind
1462               my ($sql, @bind) = @$v;
1463               $self->_assert_bindval_matches_bindtype(@bind);
1464               push @all_bind, @bind;
1465             }
1466           },
1467           ARRAYREFREF => sub { # literal SQL with bind
1468             my ($sql, @bind) = @${$v};
1469             $self->_assert_bindval_matches_bindtype(@bind);
1470             push @all_bind, @bind;
1471           },
1472           SCALARREF => sub {  # literal SQL without bind
1473           },
1474           SCALAR_or_UNDEF => sub {
1475             push @all_bind, $self->_bindtype($k, $v);
1476           },
1477         });
1478     }
1479
1480     return @all_bind;
1481 }
1482
1483 sub generate {
1484     my $self  = shift;
1485
1486     my(@sql, @sqlq, @sqlv);
1487
1488     for (@_) {
1489         my $ref = ref $_;
1490         if ($ref eq 'HASH') {
1491             for my $k (sort keys %$_) {
1492                 my $v = $_->{$k};
1493                 my $r = ref $v;
1494                 my $label = $self->_quote($k);
1495                 if ($r eq 'ARRAY') {
1496                     # literal SQL with bind
1497                     my ($sql, @bind) = @$v;
1498                     $self->_assert_bindval_matches_bindtype(@bind);
1499                     push @sqlq, "$label = $sql";
1500                     push @sqlv, @bind;
1501                 } elsif ($r eq 'SCALAR') {
1502                     # literal SQL without bind
1503                     push @sqlq, "$label = $$v";
1504                 } else {
1505                     push @sqlq, "$label = ?";
1506                     push @sqlv, $self->_bindtype($k, $v);
1507                 }
1508             }
1509             push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1510         } elsif ($ref eq 'ARRAY') {
1511             # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1512             for my $v (@$_) {
1513                 my $r = ref $v;
1514                 if ($r eq 'ARRAY') {   # literal SQL with bind
1515                     my ($sql, @bind) = @$v;
1516                     $self->_assert_bindval_matches_bindtype(@bind);
1517                     push @sqlq, $sql;
1518                     push @sqlv, @bind;
1519                 } elsif ($r eq 'SCALAR') {  # literal SQL without bind
1520                     # embedded literal SQL
1521                     push @sqlq, $$v;
1522                 } else {
1523                     push @sqlq, '?';
1524                     push @sqlv, $v;
1525                 }
1526             }
1527             push @sql, '(' . join(', ', @sqlq) . ')';
1528         } elsif ($ref eq 'SCALAR') {
1529             # literal SQL
1530             push @sql, $$_;
1531         } else {
1532             # strings get case twiddled
1533             push @sql, $self->_sqlcase($_);
1534         }
1535     }
1536
1537     my $sql = join ' ', @sql;
1538
1539     # this is pretty tricky
1540     # if ask for an array, return ($stmt, @bind)
1541     # otherwise, s/?/shift @sqlv/ to put it inline
1542     if (wantarray) {
1543         return ($sql, @sqlv);
1544     } else {
1545         1 while $sql =~ s/\?/my $d = shift(@sqlv);
1546                              ref $d ? $d->[1] : $d/e;
1547         return $sql;
1548     }
1549 }
1550
1551
1552 sub DESTROY { 1 }
1553
1554 sub AUTOLOAD {
1555     # This allows us to check for a local, then _form, attr
1556     my $self = shift;
1557     my($name) = $AUTOLOAD =~ /.*::(.+)/;
1558     return $self->generate($name, @_);
1559 }
1560
1561 1;
1562
1563
1564
1565 __END__
1566
1567 =head1 NAME
1568
1569 SQL::Abstract - Generate SQL from Perl data structures
1570
1571 =head1 SYNOPSIS
1572
1573     use SQL::Abstract;
1574
1575     my $sql = SQL::Abstract->new;
1576
1577     my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
1578
1579     my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
1580
1581     my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
1582
1583     my($stmt, @bind) = $sql->delete($table, \%where);
1584
1585     # Then, use these in your DBI statements
1586     my $sth = $dbh->prepare($stmt);
1587     $sth->execute(@bind);
1588
1589     # Just generate the WHERE clause
1590     my($stmt, @bind) = $sql->where(\%where, \@order);
1591
1592     # Return values in the same order, for hashed queries
1593     # See PERFORMANCE section for more details
1594     my @bind = $sql->values(\%fieldvals);
1595
1596 =head1 DESCRIPTION
1597
1598 This module was inspired by the excellent L<DBIx::Abstract>.
1599 However, in using that module I found that what I really wanted
1600 to do was generate SQL, but still retain complete control over my
1601 statement handles and use the DBI interface. So, I set out to
1602 create an abstract SQL generation module.
1603
1604 While based on the concepts used by L<DBIx::Abstract>, there are
1605 several important differences, especially when it comes to WHERE
1606 clauses. I have modified the concepts used to make the SQL easier
1607 to generate from Perl data structures and, IMO, more intuitive.
1608 The underlying idea is for this module to do what you mean, based
1609 on the data structures you provide it. The big advantage is that
1610 you don't have to modify your code every time your data changes,
1611 as this module figures it out.
1612
1613 To begin with, an SQL INSERT is as easy as just specifying a hash
1614 of C<key=value> pairs:
1615
1616     my %data = (
1617         name => 'Jimbo Bobson',
1618         phone => '123-456-7890',
1619         address => '42 Sister Lane',
1620         city => 'St. Louis',
1621         state => 'Louisiana',
1622     );
1623
1624 The SQL can then be generated with this:
1625
1626     my($stmt, @bind) = $sql->insert('people', \%data);
1627
1628 Which would give you something like this:
1629
1630     $stmt = "INSERT INTO people
1631                     (address, city, name, phone, state)
1632                     VALUES (?, ?, ?, ?, ?)";
1633     @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
1634              '123-456-7890', 'Louisiana');
1635
1636 These are then used directly in your DBI code:
1637
1638     my $sth = $dbh->prepare($stmt);
1639     $sth->execute(@bind);
1640
1641 =head2 Inserting and Updating Arrays
1642
1643 If your database has array types (like for example Postgres),
1644 activate the special option C<< array_datatypes => 1 >>
1645 when creating the C<SQL::Abstract> object.
1646 Then you may use an arrayref to insert and update database array types:
1647
1648     my $sql = SQL::Abstract->new(array_datatypes => 1);
1649     my %data = (
1650         planets => [qw/Mercury Venus Earth Mars/]
1651     );
1652
1653     my($stmt, @bind) = $sql->insert('solar_system', \%data);
1654
1655 This results in:
1656
1657     $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
1658
1659     @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
1660
1661
1662 =head2 Inserting and Updating SQL
1663
1664 In order to apply SQL functions to elements of your C<%data> you may
1665 specify a reference to an arrayref for the given hash value. For example,
1666 if you need to execute the Oracle C<to_date> function on a value, you can
1667 say something like this:
1668
1669     my %data = (
1670         name => 'Bill',
1671         date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
1672     );
1673
1674 The first value in the array is the actual SQL. Any other values are
1675 optional and would be included in the bind values array. This gives
1676 you:
1677
1678     my($stmt, @bind) = $sql->insert('people', \%data);
1679
1680     $stmt = "INSERT INTO people (name, date_entered)
1681                 VALUES (?, to_date(?,'MM/DD/YYYY'))";
1682     @bind = ('Bill', '03/02/2003');
1683
1684 An UPDATE is just as easy, all you change is the name of the function:
1685
1686     my($stmt, @bind) = $sql->update('people', \%data);
1687
1688 Notice that your C<%data> isn't touched; the module will generate
1689 the appropriately quirky SQL for you automatically. Usually you'll
1690 want to specify a WHERE clause for your UPDATE, though, which is
1691 where handling C<%where> hashes comes in handy...
1692
1693 =head2 Complex where statements
1694
1695 This module can generate pretty complicated WHERE statements
1696 easily. For example, simple C<key=value> pairs are taken to mean
1697 equality, and if you want to see if a field is within a set
1698 of values, you can use an arrayref. Let's say we wanted to
1699 SELECT some data based on this criteria:
1700
1701     my %where = (
1702        requestor => 'inna',
1703        worker => ['nwiger', 'rcwe', 'sfz'],
1704        status => { '!=', 'completed' }
1705     );
1706
1707     my($stmt, @bind) = $sql->select('tickets', '*', \%where);
1708
1709 The above would give you something like this:
1710
1711     $stmt = "SELECT * FROM tickets WHERE
1712                 ( requestor = ? ) AND ( status != ? )
1713                 AND ( worker = ? OR worker = ? OR worker = ? )";
1714     @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
1715
1716 Which you could then use in DBI code like so:
1717
1718     my $sth = $dbh->prepare($stmt);
1719     $sth->execute(@bind);
1720
1721 Easy, eh?
1722
1723 =head1 FUNCTIONS
1724
1725 The functions are simple. There's one for each major SQL operation,
1726 and a constructor you use first. The arguments are specified in a
1727 similar order to each function (table, then fields, then a where
1728 clause) to try and simplify things.
1729
1730
1731
1732
1733 =head2 new(option => 'value')
1734
1735 The C<new()> function takes a list of options and values, and returns
1736 a new B<SQL::Abstract> object which can then be used to generate SQL
1737 through the methods below. The options accepted are:
1738
1739 =over
1740
1741 =item case
1742
1743 If set to 'lower', then SQL will be generated in all lowercase. By
1744 default SQL is generated in "textbook" case meaning something like:
1745
1746     SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
1747
1748 Any setting other than 'lower' is ignored.
1749
1750 =item cmp
1751
1752 This determines what the default comparison operator is. By default
1753 it is C<=>, meaning that a hash like this:
1754
1755     %where = (name => 'nwiger', email => 'nate@wiger.org');
1756
1757 Will generate SQL like this:
1758
1759     WHERE name = 'nwiger' AND email = 'nate@wiger.org'
1760
1761 However, you may want loose comparisons by default, so if you set
1762 C<cmp> to C<like> you would get SQL such as:
1763
1764     WHERE name like 'nwiger' AND email like 'nate@wiger.org'
1765
1766 You can also override the comparsion on an individual basis - see
1767 the huge section on L</"WHERE CLAUSES"> at the bottom.
1768
1769 =item sqltrue, sqlfalse
1770
1771 Expressions for inserting boolean values within SQL statements.
1772 By default these are C<1=1> and C<1=0>. They are used
1773 by the special operators C<-in> and C<-not_in> for generating
1774 correct SQL even when the argument is an empty array (see below).
1775
1776 =item logic
1777
1778 This determines the default logical operator for multiple WHERE
1779 statements in arrays or hashes. If absent, the default logic is "or"
1780 for arrays, and "and" for hashes. This means that a WHERE
1781 array of the form:
1782
1783     @where = (
1784         event_date => {'>=', '2/13/99'},
1785         event_date => {'<=', '4/24/03'},
1786     );
1787
1788 will generate SQL like this:
1789
1790     WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
1791
1792 This is probably not what you want given this query, though (look
1793 at the dates). To change the "OR" to an "AND", simply specify:
1794
1795     my $sql = SQL::Abstract->new(logic => 'and');
1796
1797 Which will change the above C<WHERE> to:
1798
1799     WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
1800
1801 The logic can also be changed locally by inserting
1802 a modifier in front of an arrayref :
1803
1804     @where = (-and => [event_date => {'>=', '2/13/99'},
1805                        event_date => {'<=', '4/24/03'} ]);
1806
1807 See the L</"WHERE CLAUSES"> section for explanations.
1808
1809 =item convert
1810
1811 This will automatically convert comparisons using the specified SQL
1812 function for both column and value. This is mostly used with an argument
1813 of C<upper> or C<lower>, so that the SQL will have the effect of
1814 case-insensitive "searches". For example, this:
1815
1816     $sql = SQL::Abstract->new(convert => 'upper');
1817     %where = (keywords => 'MaKe iT CAse inSeNSItive');
1818
1819 Will turn out the following SQL:
1820
1821     WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
1822
1823 The conversion can be C<upper()>, C<lower()>, or any other SQL function
1824 that can be applied symmetrically to fields (actually B<SQL::Abstract> does
1825 not validate this option; it will just pass through what you specify verbatim).
1826
1827 =item bindtype
1828
1829 This is a kludge because many databases suck. For example, you can't
1830 just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
1831 Instead, you have to use C<bind_param()>:
1832
1833     $sth->bind_param(1, 'reg data');
1834     $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
1835
1836 The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
1837 which loses track of which field each slot refers to. Fear not.
1838
1839 If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
1840 Currently, you can specify either C<normal> (default) or C<columns>. If you
1841 specify C<columns>, you will get an array that looks like this:
1842
1843     my $sql = SQL::Abstract->new(bindtype => 'columns');
1844     my($stmt, @bind) = $sql->insert(...);
1845
1846     @bind = (
1847         [ 'column1', 'value1' ],
1848         [ 'column2', 'value2' ],
1849         [ 'column3', 'value3' ],
1850     );
1851
1852 You can then iterate through this manually, using DBI's C<bind_param()>.
1853
1854     $sth->prepare($stmt);
1855     my $i = 1;
1856     for (@bind) {
1857         my($col, $data) = @$_;
1858         if ($col eq 'details' || $col eq 'comments') {
1859             $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
1860         } elsif ($col eq 'image') {
1861             $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
1862         } else {
1863             $sth->bind_param($i, $data);
1864         }
1865         $i++;
1866     }
1867     $sth->execute;      # execute without @bind now
1868
1869 Now, why would you still use B<SQL::Abstract> if you have to do this crap?
1870 Basically, the advantage is still that you don't have to care which fields
1871 are or are not included. You could wrap that above C<for> loop in a simple
1872 sub called C<bind_fields()> or something and reuse it repeatedly. You still
1873 get a layer of abstraction over manual SQL specification.
1874
1875 Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
1876 construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
1877 will expect the bind values in this format.
1878
1879 =item quote_char
1880
1881 This is the character that a table or column name will be quoted
1882 with.  By default this is an empty string, but you could set it to
1883 the character C<`>, to generate SQL like this:
1884
1885   SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
1886
1887 Alternatively, you can supply an array ref of two items, the first being the left
1888 hand quote character, and the second the right hand quote character. For
1889 example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
1890 that generates SQL like this:
1891
1892   SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
1893
1894 Quoting is useful if you have tables or columns names that are reserved
1895 words in your database's SQL dialect.
1896
1897 =item name_sep
1898
1899 This is the character that separates a table and column name.  It is
1900 necessary to specify this when the C<quote_char> option is selected,
1901 so that tables and column names can be individually quoted like this:
1902
1903   SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
1904
1905 =item injection_guard
1906
1907 A regular expression C<qr/.../> that is applied to any C<-function> and unquoted
1908 column name specified in a query structure. This is a safety mechanism to avoid
1909 injection attacks when mishandling user input e.g.:
1910
1911   my %condition_as_column_value_pairs = get_values_from_user();
1912   $sqla->select( ... , \%condition_as_column_value_pairs );
1913
1914 If the expression matches an exception is thrown. Note that literal SQL
1915 supplied via C<\'...'> or C<\['...']> is B<not> checked in any way.
1916
1917 Defaults to checking for C<;> and the C<GO> keyword (TransactSQL)
1918
1919 =item array_datatypes
1920
1921 When this option is true, arrayrefs in INSERT or UPDATE are
1922 interpreted as array datatypes and are passed directly
1923 to the DBI layer.
1924 When this option is false, arrayrefs are interpreted
1925 as literal SQL, just like refs to arrayrefs
1926 (but this behavior is for backwards compatibility; when writing
1927 new queries, use the "reference to arrayref" syntax
1928 for literal SQL).
1929
1930
1931 =item special_ops
1932
1933 Takes a reference to a list of "special operators"
1934 to extend the syntax understood by L<SQL::Abstract>.
1935 See section L</"SPECIAL OPERATORS"> for details.
1936
1937 =item unary_ops
1938
1939 Takes a reference to a list of "unary operators"
1940 to extend the syntax understood by L<SQL::Abstract>.
1941 See section L</"UNARY OPERATORS"> for details.
1942
1943
1944
1945 =back
1946
1947 =head2 insert($table, \@values || \%fieldvals, \%options)
1948
1949 This is the simplest function. You simply give it a table name
1950 and either an arrayref of values or hashref of field/value pairs.
1951 It returns an SQL INSERT statement and a list of bind values.
1952 See the sections on L</"Inserting and Updating Arrays"> and
1953 L</"Inserting and Updating SQL"> for information on how to insert
1954 with those data types.
1955
1956 The optional C<\%options> hash reference may contain additional
1957 options to generate the insert SQL. Currently supported options
1958 are:
1959
1960 =over 4
1961
1962 =item returning
1963
1964 Takes either a scalar of raw SQL fields, or an array reference of
1965 field names, and adds on an SQL C<RETURNING> statement at the end.
1966 This allows you to return data generated by the insert statement
1967 (such as row IDs) without performing another C<SELECT> statement.
1968 Note, however, this is not part of the SQL standard and may not
1969 be supported by all database engines.
1970
1971 =back
1972
1973 =head2 update($table, \%fieldvals, \%where)
1974
1975 This takes a table, hashref of field/value pairs, and an optional
1976 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
1977 of bind values.
1978 See the sections on L</"Inserting and Updating Arrays"> and
1979 L</"Inserting and Updating SQL"> for information on how to insert
1980 with those data types.
1981
1982 =head2 select($source, $fields, $where, $order)
1983
1984 This returns a SQL SELECT statement and associated list of bind values, as
1985 specified by the arguments  :
1986
1987 =over
1988
1989 =item $source
1990
1991 Specification of the 'FROM' part of the statement.
1992 The argument can be either a plain scalar (interpreted as a table
1993 name, will be quoted), or an arrayref (interpreted as a list
1994 of table names, joined by commas, quoted), or a scalarref
1995 (literal table name, not quoted), or a ref to an arrayref
1996 (list of literal table names, joined by commas, not quoted).
1997
1998 =item $fields
1999
2000 Specification of the list of fields to retrieve from
2001 the source.
2002 The argument can be either an arrayref (interpreted as a list
2003 of field names, will be joined by commas and quoted), or a
2004 plain scalar (literal SQL, not quoted).
2005 Please observe that this API is not as flexible as for
2006 the first argument C<$table>, for backwards compatibility reasons.
2007
2008 =item $where
2009
2010 Optional argument to specify the WHERE part of the query.
2011 The argument is most often a hashref, but can also be
2012 an arrayref or plain scalar --
2013 see section L<WHERE clause|/"WHERE CLAUSES"> for details.
2014
2015 =item $order
2016
2017 Optional argument to specify the ORDER BY part of the query.
2018 The argument can be a scalar, a hashref or an arrayref
2019 -- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
2020 for details.
2021
2022 =back
2023
2024
2025 =head2 delete($table, \%where)
2026
2027 This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
2028 It returns an SQL DELETE statement and list of bind values.
2029
2030 =head2 where(\%where, \@order)
2031
2032 This is used to generate just the WHERE clause. For example,
2033 if you have an arbitrary data structure and know what the
2034 rest of your SQL is going to look like, but want an easy way
2035 to produce a WHERE clause, use this. It returns an SQL WHERE
2036 clause and list of bind values.
2037
2038
2039 =head2 values(\%data)
2040
2041 This just returns the values from the hash C<%data>, in the same
2042 order that would be returned from any of the other above queries.
2043 Using this allows you to markedly speed up your queries if you
2044 are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
2045
2046 =head2 generate($any, 'number', $of, \@data, $struct, \%types)
2047
2048 Warning: This is an experimental method and subject to change.
2049
2050 This returns arbitrarily generated SQL. It's a really basic shortcut.
2051 It will return two different things, depending on return context:
2052
2053     my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
2054     my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
2055
2056 These would return the following:
2057
2058     # First calling form
2059     $stmt = "CREATE TABLE test (?, ?)";
2060     @bind = (field1, field2);
2061
2062     # Second calling form
2063     $stmt_and_val = "CREATE TABLE test (field1, field2)";
2064
2065 Depending on what you're trying to do, it's up to you to choose the correct
2066 format. In this example, the second form is what you would want.
2067
2068 By the same token:
2069
2070     $sql->generate('alter session', { nls_date_format => 'MM/YY' });
2071
2072 Might give you:
2073
2074     ALTER SESSION SET nls_date_format = 'MM/YY'
2075
2076 You get the idea. Strings get their case twiddled, but everything
2077 else remains verbatim.
2078
2079
2080
2081
2082 =head1 WHERE CLAUSES
2083
2084 =head2 Introduction
2085
2086 This module uses a variation on the idea from L<DBIx::Abstract>. It
2087 is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
2088 module is that things in arrays are OR'ed, and things in hashes
2089 are AND'ed.>
2090
2091 The easiest way to explain is to show lots of examples. After
2092 each C<%where> hash shown, it is assumed you used:
2093
2094     my($stmt, @bind) = $sql->where(\%where);
2095
2096 However, note that the C<%where> hash can be used directly in any
2097 of the other functions as well, as described above.
2098
2099 =head2 Key-value pairs
2100
2101 So, let's get started. To begin, a simple hash:
2102
2103     my %where  = (
2104         user   => 'nwiger',
2105         status => 'completed'
2106     );
2107
2108 Is converted to SQL C<key = val> statements:
2109
2110     $stmt = "WHERE user = ? AND status = ?";
2111     @bind = ('nwiger', 'completed');
2112
2113 One common thing I end up doing is having a list of values that
2114 a field can be in. To do this, simply specify a list inside of
2115 an arrayref:
2116
2117     my %where  = (
2118         user   => 'nwiger',
2119         status => ['assigned', 'in-progress', 'pending'];
2120     );
2121
2122 This simple code will create the following:
2123
2124     $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
2125     @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
2126
2127 A field associated to an empty arrayref will be considered a
2128 logical false and will generate 0=1.
2129
2130 =head2 Tests for NULL values
2131
2132 If the value part is C<undef> then this is converted to SQL <IS NULL>
2133
2134     my %where  = (
2135         user   => 'nwiger',
2136         status => undef,
2137     );
2138
2139 becomes:
2140
2141     $stmt = "WHERE user = ? AND status IS NULL";
2142     @bind = ('nwiger');
2143
2144 =head2 Specific comparison operators
2145
2146 If you want to specify a different type of operator for your comparison,
2147 you can use a hashref for a given column:
2148
2149     my %where  = (
2150         user   => 'nwiger',
2151         status => { '!=', 'completed' }
2152     );
2153
2154 Which would generate:
2155
2156     $stmt = "WHERE user = ? AND status != ?";
2157     @bind = ('nwiger', 'completed');
2158
2159 To test against multiple values, just enclose the values in an arrayref:
2160
2161     status => { '=', ['assigned', 'in-progress', 'pending'] };
2162
2163 Which would give you:
2164
2165     "WHERE status = ? OR status = ? OR status = ?"
2166
2167
2168 The hashref can also contain multiple pairs, in which case it is expanded
2169 into an C<AND> of its elements:
2170
2171     my %where  = (
2172         user   => 'nwiger',
2173         status => { '!=', 'completed', -not_like => 'pending%' }
2174     );
2175
2176     # Or more dynamically, like from a form
2177     $where{user} = 'nwiger';
2178     $where{status}{'!='} = 'completed';
2179     $where{status}{'-not_like'} = 'pending%';
2180
2181     # Both generate this
2182     $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
2183     @bind = ('nwiger', 'completed', 'pending%');
2184
2185
2186 To get an OR instead, you can combine it with the arrayref idea:
2187
2188     my %where => (
2189          user => 'nwiger',
2190          priority => [ {'=', 2}, {'!=', 1} ]
2191     );
2192
2193 Which would generate:
2194
2195     $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
2196     @bind = ('nwiger', '2', '1');
2197
2198 If you want to include literal SQL (with or without bind values), just use a
2199 scalar reference or array reference as the value:
2200
2201     my %where  = (
2202         date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
2203         date_expires => { '<' => \"now()" }
2204     );
2205
2206 Which would generate:
2207
2208     $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
2209     @bind = ('11/26/2008');
2210
2211
2212 =head2 Logic and nesting operators
2213
2214 In the example above,
2215 there is a subtle trap if you want to say something like
2216 this (notice the C<AND>):
2217
2218     WHERE priority != ? AND priority != ?
2219
2220 Because, in Perl you I<can't> do this:
2221
2222     priority => { '!=', 2, '!=', 1 }
2223
2224 As the second C<!=> key will obliterate the first. The solution
2225 is to use the special C<-modifier> form inside an arrayref:
2226
2227     priority => [ -and => {'!=', 2},
2228                           {'!=', 1} ]
2229
2230
2231 Normally, these would be joined by C<OR>, but the modifier tells it
2232 to use C<AND> instead. (Hint: You can use this in conjunction with the
2233 C<logic> option to C<new()> in order to change the way your queries
2234 work by default.) B<Important:> Note that the C<-modifier> goes
2235 B<INSIDE> the arrayref, as an extra first element. This will
2236 B<NOT> do what you think it might:
2237
2238     priority => -and => [{'!=', 2}, {'!=', 1}]   # WRONG!
2239
2240 Here is a quick list of equivalencies, since there is some overlap:
2241
2242     # Same
2243     status => {'!=', 'completed', 'not like', 'pending%' }
2244     status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
2245
2246     # Same
2247     status => {'=', ['assigned', 'in-progress']}
2248     status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
2249     status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
2250
2251
2252
2253 =head2 Special operators : IN, BETWEEN, etc.
2254
2255 You can also use the hashref format to compare a list of fields using the
2256 C<IN> comparison operator, by specifying the list as an arrayref:
2257
2258     my %where  = (
2259         status   => 'completed',
2260         reportid => { -in => [567, 2335, 2] }
2261     );
2262
2263 Which would generate:
2264
2265     $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
2266     @bind = ('completed', '567', '2335', '2');
2267
2268 The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
2269 the same way.
2270
2271 If the argument to C<-in> is an empty array, 'sqlfalse' is generated
2272 (by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
2273 'sqltrue' (by default : C<1=1>).
2274
2275 In addition to the array you can supply a chunk of literal sql or
2276 literal sql with bind:
2277
2278     my %where = {
2279       customer => { -in => \[
2280         'SELECT cust_id FROM cust WHERE balance > ?',
2281         2000,
2282       ],
2283       status => { -in => \'SELECT status_codes FROM states' },
2284     };
2285
2286 would generate:
2287
2288     $stmt = "WHERE (
2289           customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
2290       AND status IN ( SELECT status_codes FROM states )
2291     )";
2292     @bind = ('2000');
2293
2294
2295
2296 Another pair of operators is C<-between> and C<-not_between>,
2297 used with an arrayref of two values:
2298
2299     my %where  = (
2300         user   => 'nwiger',
2301         completion_date => {
2302            -not_between => ['2002-10-01', '2003-02-06']
2303         }
2304     );
2305
2306 Would give you:
2307
2308     WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
2309
2310 Just like with C<-in> all plausible combinations of literal SQL
2311 are possible:
2312
2313     my %where = {
2314       start0 => { -between => [ 1, 2 ] },
2315       start1 => { -between => \["? AND ?", 1, 2] },
2316       start2 => { -between => \"lower(x) AND upper(y)" },
2317       start3 => { -between => [
2318         \"lower(x)",
2319         \["upper(?)", 'stuff' ],
2320       ] },
2321     };
2322
2323 Would give you:
2324
2325     $stmt = "WHERE (
2326           ( start0 BETWEEN ? AND ?                )
2327       AND ( start1 BETWEEN ? AND ?                )
2328       AND ( start2 BETWEEN lower(x) AND upper(y)  )
2329       AND ( start3 BETWEEN lower(x) AND upper(?)  )
2330     )";
2331     @bind = (1, 2, 1, 2, 'stuff');
2332
2333
2334 These are the two builtin "special operators"; but the
2335 list can be expanded : see section L</"SPECIAL OPERATORS"> below.
2336
2337 Another operator is C<-func> that allows you to call SQL functions with
2338 arguments. It receives an array reference containing the function name
2339 as the 0th argument and the other arguments being its parameters. For example:
2340
2341     my %where = {
2342       -func => ['substr', 'Hello', 50, 5],
2343     };
2344
2345 Would give you:
2346
2347    $stmt = "WHERE (substr(?,?,?))";
2348    @bind = ("Hello", 50, 5);
2349
2350 Yet another operator is C<-op> that allows you to use SQL operators. It
2351 receives an array reference containing the operator 0th argument and the other
2352 arguments being its operands. For example:
2353
2354     my %where = {
2355       foo => { -op => ['+', \'bar', 50, 5] },
2356     };
2357
2358 Would give you:
2359
2360    $stmt = "WHERE (foo = bar + ? + ?)";
2361    @bind = (50, 5);
2362
2363 =head2 Unary operators: bool
2364
2365 If you wish to test against boolean columns or functions within your
2366 database you can use the C<-bool> and C<-not_bool> operators. For
2367 example to test the column C<is_user> being true and the column
2368 C<is_enabled> being false you would use:-
2369
2370     my %where  = (
2371         -bool       => 'is_user',
2372         -not_bool   => 'is_enabled',
2373     );
2374
2375 Would give you:
2376
2377     WHERE is_user AND NOT is_enabled
2378
2379 If a more complex combination is required, testing more conditions,
2380 then you should use the and/or operators:-
2381
2382     my %where  = (
2383         -and           => [
2384             -bool      => 'one',
2385             -bool      => 'two',
2386             -bool      => 'three',
2387             -not_bool  => 'four',
2388         ],
2389     );
2390
2391 Would give you:
2392
2393     WHERE one AND two AND three AND NOT four
2394
2395
2396 =head2 Nested conditions, -and/-or prefixes
2397
2398 So far, we've seen how multiple conditions are joined with a top-level
2399 C<AND>.  We can change this by putting the different conditions we want in
2400 hashes and then putting those hashes in an array. For example:
2401
2402     my @where = (
2403         {
2404             user   => 'nwiger',
2405             status => { -like => ['pending%', 'dispatched'] },
2406         },
2407         {
2408             user   => 'robot',
2409             status => 'unassigned',
2410         }
2411     );
2412
2413 This data structure would create the following:
2414
2415     $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
2416                 OR ( user = ? AND status = ? ) )";
2417     @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
2418
2419
2420 Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or>
2421 to change the logic inside :
2422
2423     my @where = (
2424          -and => [
2425             user => 'nwiger',
2426             [
2427                 -and => [ workhrs => {'>', 20}, geo => 'ASIA' ],
2428                 -or => { workhrs => {'<', 50}, geo => 'EURO' },
2429             ],
2430         ],
2431     );
2432
2433 That would yield:
2434
2435     WHERE ( user = ? AND (
2436                ( workhrs > ? AND geo = ? )
2437             OR ( workhrs < ? OR geo = ? )
2438           ) )
2439
2440 =head2 Algebraic inconsistency, for historical reasons
2441
2442 C<Important note>: when connecting several conditions, the C<-and->|C<-or>
2443 operator goes C<outside> of the nested structure; whereas when connecting
2444 several constraints on one column, the C<-and> operator goes
2445 C<inside> the arrayref. Here is an example combining both features :
2446
2447    my @where = (
2448      -and => [a => 1, b => 2],
2449      -or  => [c => 3, d => 4],
2450       e   => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
2451    )
2452
2453 yielding
2454
2455   WHERE ( (    ( a = ? AND b = ? )
2456             OR ( c = ? OR d = ? )
2457             OR ( e LIKE ? AND e LIKE ? ) ) )
2458
2459 This difference in syntax is unfortunate but must be preserved for
2460 historical reasons. So be careful : the two examples below would
2461 seem algebraically equivalent, but they are not
2462
2463   {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
2464   # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
2465
2466   [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
2467   # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
2468
2469
2470 =head2 Literal SQL
2471
2472 Finally, sometimes only literal SQL will do. If you want to include
2473 literal SQL verbatim, you can specify it as a scalar reference, namely:
2474
2475     my $inn = 'is Not Null';
2476     my %where = (
2477         priority => { '<', 2 },
2478         requestor => \$inn
2479     );
2480
2481 This would create:
2482
2483     $stmt = "WHERE priority < ? AND requestor is Not Null";
2484     @bind = ('2');
2485
2486 Note that in this example, you only get one bind parameter back, since
2487 the verbatim SQL is passed as part of the statement.
2488
2489 Of course, just to prove a point, the above can also be accomplished
2490 with this:
2491
2492     my %where = (
2493         priority  => { '<', 2 },
2494         requestor => { '!=', undef },
2495     );
2496
2497
2498 TMTOWTDI
2499
2500 Conditions on boolean columns can be expressed in the same way, passing
2501 a reference to an empty string, however using liternal SQL in this way
2502 is deprecated - the preferred method is to use the boolean operators -
2503 see L</"Unary operators: bool"> :
2504
2505     my %where = (
2506         priority  => { '<', 2 },
2507         is_ready  => \"";
2508     );
2509
2510 which yields
2511
2512     $stmt = "WHERE priority < ? AND is_ready";
2513     @bind = ('2');
2514
2515 Literal SQL is also the only way to compare 2 columns to one another:
2516
2517     my %where = (
2518         priority => { '<', 2 },
2519         requestor => \'= submittor'
2520     );
2521
2522 which creates:
2523
2524     $stmt = "WHERE priority < ? AND requestor = submitter";
2525     @bind = ('2');
2526
2527 =head2 Literal SQL with placeholders and bind values (subqueries)
2528
2529 If the literal SQL to be inserted has placeholders and bind values,
2530 use a reference to an arrayref (yes this is a double reference --
2531 not so common, but perfectly legal Perl). For example, to find a date
2532 in Postgres you can use something like this:
2533
2534     my %where = (
2535        date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
2536     )
2537
2538 This would create:
2539
2540     $stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
2541     @bind = ('10');
2542
2543 Note that you must pass the bind values in the same format as they are returned
2544 by L</where>. That means that if you set L</bindtype> to C<columns>, you must
2545 provide the bind values in the C<< [ column_meta => value ] >> format, where
2546 C<column_meta> is an opaque scalar value; most commonly the column name, but
2547 you can use any scalar value (including references and blessed references),
2548 L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
2549 to C<columns> the above example will look like:
2550
2551     my %where = (
2552        date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
2553     )
2554
2555 Literal SQL is especially useful for nesting parenthesized clauses in the
2556 main SQL query. Here is a first example :
2557
2558   my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
2559                                100, "foo%");
2560   my %where = (
2561     foo => 1234,
2562     bar => \["IN ($sub_stmt)" => @sub_bind],
2563   );
2564
2565 This yields :
2566
2567   $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
2568                                              WHERE c2 < ? AND c3 LIKE ?))";
2569   @bind = (1234, 100, "foo%");
2570
2571 Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
2572 are expressed in the same way. Of course the C<$sub_stmt> and
2573 its associated bind values can be generated through a former call
2574 to C<select()> :
2575
2576   my ($sub_stmt, @sub_bind)
2577      = $sql->select("t1", "c1", {c2 => {"<" => 100},
2578                                  c3 => {-like => "foo%"}});
2579   my %where = (
2580     foo => 1234,
2581     bar => \["> ALL ($sub_stmt)" => @sub_bind],
2582   );
2583
2584 In the examples above, the subquery was used as an operator on a column;
2585 but the same principle also applies for a clause within the main C<%where>
2586 hash, like an EXISTS subquery :
2587
2588   my ($sub_stmt, @sub_bind)
2589      = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
2590   my %where = ( -and => [
2591     foo   => 1234,
2592     \["EXISTS ($sub_stmt)" => @sub_bind],
2593   ]);
2594
2595 which yields
2596
2597   $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
2598                                         WHERE c1 = ? AND c2 > t0.c0))";
2599   @bind = (1234, 1);
2600
2601
2602 Observe that the condition on C<c2> in the subquery refers to
2603 column C<t0.c0> of the main query : this is I<not> a bind
2604 value, so we have to express it through a scalar ref.
2605 Writing C<< c2 => {">" => "t0.c0"} >> would have generated
2606 C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
2607 what we wanted here.
2608
2609 Finally, here is an example where a subquery is used
2610 for expressing unary negation:
2611
2612   my ($sub_stmt, @sub_bind)
2613      = $sql->where({age => [{"<" => 10}, {">" => 20}]});
2614   $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
2615   my %where = (
2616         lname  => {like => '%son%'},
2617         \["NOT ($sub_stmt)" => @sub_bind],
2618     );
2619
2620 This yields
2621
2622   $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
2623   @bind = ('%son%', 10, 20)
2624
2625
2626
2627 =head2 Conclusion
2628
2629 These pages could go on for a while, since the nesting of the data
2630 structures this module can handle are pretty much unlimited (the
2631 module implements the C<WHERE> expansion as a recursive function
2632 internally). Your best bet is to "play around" with the module a
2633 little to see how the data structures behave, and choose the best
2634 format for your data based on that.
2635
2636 And of course, all the values above will probably be replaced with
2637 variables gotten from forms or the command line. After all, if you
2638 knew everything ahead of time, you wouldn't have to worry about
2639 dynamically-generating SQL and could just hardwire it into your
2640 script.
2641
2642
2643
2644
2645 =head1 ORDER BY CLAUSES
2646
2647 Some functions take an order by clause. This can either be a scalar (just a
2648 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
2649 or an array of either of the two previous forms. Examples:
2650
2651                Given            |         Will Generate
2652     ----------------------------------------------------------
2653                                 |
2654     \'colA DESC'                | ORDER BY colA DESC
2655                                 |
2656     'colA'                      | ORDER BY colA
2657                                 |
2658     [qw/colA colB/]             | ORDER BY colA, colB
2659                                 |
2660     {-asc  => 'colA'}           | ORDER BY colA ASC
2661                                 |
2662     {-desc => 'colB'}           | ORDER BY colB DESC
2663                                 |
2664     ['colA', {-asc => 'colB'}]  | ORDER BY colA, colB ASC
2665                                 |
2666     { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC
2667                                 |
2668     [                           |
2669       { -asc => 'colA' },       | ORDER BY colA ASC, colB DESC,
2670       { -desc => [qw/colB/],    |          colC ASC, colD ASC
2671       { -asc => [qw/colC colD/],|
2672     ]                           |
2673     ===========================================================
2674
2675
2676
2677 =head1 SPECIAL OPERATORS
2678
2679   my $sqlmaker = SQL::Abstract->new(special_ops => [
2680      {
2681       regex => qr/.../,
2682       handler => sub {
2683         my ($self, $field, $op, $arg) = @_;
2684         ...
2685       },
2686      },
2687      {
2688       regex => qr/.../,
2689       handler => 'method_name',
2690      },
2691    ]);
2692
2693 A "special operator" is a SQL syntactic clause that can be
2694 applied to a field, instead of a usual binary operator.
2695 For example :
2696
2697    WHERE field IN (?, ?, ?)
2698    WHERE field BETWEEN ? AND ?
2699    WHERE MATCH(field) AGAINST (?, ?)
2700
2701 Special operators IN and BETWEEN are fairly standard and therefore
2702 are builtin within C<SQL::Abstract> (as the overridable methods
2703 C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
2704 like the MATCH .. AGAINST example above which is specific to MySQL,
2705 you can write your own operator handlers - supply a C<special_ops>
2706 argument to the C<new> method. That argument takes an arrayref of
2707 operator definitions; each operator definition is a hashref with two
2708 entries:
2709
2710 =over
2711
2712 =item regex
2713
2714 the regular expression to match the operator
2715
2716 =item handler
2717
2718 Either a coderef or a plain scalar method name. In both cases
2719 the expected return is C<< ($sql, @bind) >>.
2720
2721 When supplied with a method name, it is simply called on the
2722 L<SQL::Abstract/> object as:
2723
2724  $self->$method_name ($field, $op, $arg)
2725
2726  Where:
2727
2728   $op is the part that matched the handler regex
2729   $field is the LHS of the operator
2730   $arg is the RHS
2731
2732 When supplied with a coderef, it is called as:
2733
2734  $coderef->($self, $field, $op, $arg)
2735
2736
2737 =back
2738
2739 For example, here is an implementation
2740 of the MATCH .. AGAINST syntax for MySQL
2741
2742   my $sqlmaker = SQL::Abstract->new(special_ops => [
2743
2744     # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
2745     {regex => qr/^match$/i,
2746      handler => sub {
2747        my ($self, $field, $op, $arg) = @_;
2748        $arg = [$arg] if not ref $arg;
2749        my $label         = $self->_quote($field);
2750        my ($placeholder) = $self->_convert('?');
2751        my $placeholders  = join ", ", (($placeholder) x @$arg);
2752        my $sql           = $self->_sqlcase('match') . " ($label) "
2753                          . $self->_sqlcase('against') . " ($placeholders) ";
2754        my @bind = $self->_bindtype($field, @$arg);
2755        return ($sql, @bind);
2756        }
2757      },
2758
2759   ]);
2760
2761
2762 =head1 UNARY OPERATORS
2763
2764   my $sqlmaker = SQL::Abstract->new(unary_ops => [
2765      {
2766       regex => qr/.../,
2767       handler => sub {
2768         my ($self, $op, $arg) = @_;
2769         ...
2770       },
2771      },
2772      {
2773       regex => qr/.../,
2774       handler => 'method_name',
2775      },
2776    ]);
2777
2778 A "unary operator" is a SQL syntactic clause that can be
2779 applied to a field - the operator goes before the field
2780
2781 You can write your own operator handlers - supply a C<unary_ops>
2782 argument to the C<new> method. That argument takes an arrayref of
2783 operator definitions; each operator definition is a hashref with two
2784 entries:
2785
2786 =over
2787
2788 =item regex
2789
2790 the regular expression to match the operator
2791
2792 =item handler
2793
2794 Either a coderef or a plain scalar method name. In both cases
2795 the expected return is C<< $sql >>.
2796
2797 When supplied with a method name, it is simply called on the
2798 L<SQL::Abstract/> object as:
2799
2800  $self->$method_name ($op, $arg)
2801
2802  Where:
2803
2804   $op is the part that matched the handler regex
2805   $arg is the RHS or argument of the operator
2806
2807 When supplied with a coderef, it is called as:
2808
2809  $coderef->($self, $op, $arg)
2810
2811
2812 =back
2813
2814
2815 =head1 PERFORMANCE
2816
2817 Thanks to some benchmarking by Mark Stosberg, it turns out that
2818 this module is many orders of magnitude faster than using C<DBIx::Abstract>.
2819 I must admit this wasn't an intentional design issue, but it's a
2820 byproduct of the fact that you get to control your C<DBI> handles
2821 yourself.
2822
2823 To maximize performance, use a code snippet like the following:
2824
2825     # prepare a statement handle using the first row
2826     # and then reuse it for the rest of the rows
2827     my($sth, $stmt);
2828     for my $href (@array_of_hashrefs) {
2829         $stmt ||= $sql->insert('table', $href);
2830         $sth  ||= $dbh->prepare($stmt);
2831         $sth->execute($sql->values($href));
2832     }
2833
2834 The reason this works is because the keys in your C<$href> are sorted
2835 internally by B<SQL::Abstract>. Thus, as long as your data retains
2836 the same structure, you only have to generate the SQL the first time
2837 around. On subsequent queries, simply use the C<values> function provided
2838 by this module to return your values in the correct order.
2839
2840 However this depends on the values having the same type - if, for
2841 example, the values of a where clause may either have values
2842 (resulting in sql of the form C<column = ?> with a single bind
2843 value), or alternatively the values might be C<undef> (resulting in
2844 sql of the form C<column IS NULL> with no bind value) then the
2845 caching technique suggested will not work.
2846
2847 =head1 FORMBUILDER
2848
2849 If you use my C<CGI::FormBuilder> module at all, you'll hopefully
2850 really like this part (I do, at least). Building up a complex query
2851 can be as simple as the following:
2852
2853     #!/usr/bin/perl
2854
2855     use CGI::FormBuilder;
2856     use SQL::Abstract;
2857
2858     my $form = CGI::FormBuilder->new(...);
2859     my $sql  = SQL::Abstract->new;
2860
2861     if ($form->submitted) {
2862         my $field = $form->field;
2863         my $id = delete $field->{id};
2864         my($stmt, @bind) = $sql->update('table', $field, {id => $id});
2865     }
2866
2867 Of course, you would still have to connect using C<DBI> to run the
2868 query, but the point is that if you make your form look like your
2869 table, the actual query script can be extremely simplistic.
2870
2871 If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
2872 a fast interface to returning and formatting data. I frequently
2873 use these three modules together to write complex database query
2874 apps in under 50 lines.
2875
2876 =head1 REPO
2877
2878 =over
2879
2880 =item * gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class.git>
2881
2882 =item * git: L<git://git.shadowcat.co.uk/dbsrgits/DBIx-Class.git>
2883
2884 =back
2885
2886 =head1 CHANGES
2887
2888 Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
2889 Great care has been taken to preserve the I<published> behavior
2890 documented in previous versions in the 1.* family; however,
2891 some features that were previously undocumented, or behaved
2892 differently from the documentation, had to be changed in order
2893 to clarify the semantics. Hence, client code that was relying
2894 on some dark areas of C<SQL::Abstract> v1.*
2895 B<might behave differently> in v1.50.
2896
2897 The main changes are :
2898
2899 =over
2900
2901 =item *
2902
2903 support for literal SQL through the C<< \ [$sql, bind] >> syntax.
2904
2905 =item *
2906
2907 support for the { operator => \"..." } construct (to embed literal SQL)
2908
2909 =item *
2910
2911 support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
2912
2913 =item *
2914
2915 optional support for L<array datatypes|/"Inserting and Updating Arrays">
2916
2917 =item *
2918
2919 defensive programming : check arguments
2920
2921 =item *
2922
2923 fixed bug with global logic, which was previously implemented
2924 through global variables yielding side-effects. Prior versions would
2925 interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
2926 as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
2927 Now this is interpreted
2928 as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
2929
2930
2931 =item *
2932
2933 fixed semantics of  _bindtype on array args
2934
2935 =item *
2936
2937 dropped the C<_anoncopy> of the %where tree. No longer necessary,
2938 we just avoid shifting arrays within that tree.
2939
2940 =item *
2941
2942 dropped the C<_modlogic> function
2943
2944 =back
2945
2946
2947
2948 =head1 ACKNOWLEDGEMENTS
2949
2950 There are a number of individuals that have really helped out with
2951 this module. Unfortunately, most of them submitted bugs via CPAN
2952 so I have no idea who they are! But the people I do know are:
2953
2954     Ash Berlin (order_by hash term support)
2955     Matt Trout (DBIx::Class support)
2956     Mark Stosberg (benchmarking)
2957     Chas Owens (initial "IN" operator support)
2958     Philip Collins (per-field SQL functions)
2959     Eric Kolve (hashref "AND" support)
2960     Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
2961     Dan Kubb (support for "quote_char" and "name_sep")
2962     Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
2963     Laurent Dami (internal refactoring, extensible list of special operators, literal SQL)
2964     Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
2965     Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
2966     Oliver Charles (support for "RETURNING" after "INSERT")
2967
2968 Thanks!
2969
2970 =head1 SEE ALSO
2971
2972 L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
2973
2974 =head1 AUTHOR
2975
2976 Copyright (c) 2001-2007 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
2977
2978 This module is actively maintained by Matt Trout <mst@shadowcatsystems.co.uk>
2979
2980 For support, your best bet is to try the C<DBIx::Class> users mailing list.
2981 While not an official support venue, C<DBIx::Class> makes heavy use of
2982 C<SQL::Abstract>, and as such list members there are very familiar with
2983 how to create queries.
2984
2985 =head1 LICENSE
2986
2987 This module is free software; you may copy this under the same
2988 terms as perl itself (either the GNU General Public License or
2989 the Artistic License)
2990
2991 =cut
2992