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