lib/SQL/Abstract.pm

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