lib/SQL/Abstract.pm

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