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