lib/SQL/Abstract.pm

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