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