X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=c1ccbb225ea0bade753e1aadca85557dd9656624;hb=b54fd911aaeb8677cabf7afbf99d2bb70cda2876;hp=238d86930629fe2498cf713abe750652699a9cb7;hpb=e82e648a6dd74bc04c2424b7b4a183115ab3de10;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 238d869..c1ccbb2 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -1,13 +1,8 @@ package SQL::Abstract; # see doc at end of file -# LDNOTE : this code is heavy refactoring from original SQLA. -# Several design decisions will need discussion during -# the test / diffusion / acceptance phase; those are marked with flag -# 'LDNOTE' (note by laurent.dami AT free.fr) - -use Carp; use strict; use warnings; +use Carp (); use List::Util (); use Scalar::Util (); @@ -15,7 +10,7 @@ use Scalar::Util (); # GLOBALS #====================================================================== -our $VERSION = '1.71'; +our $VERSION = '1.78'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -27,6 +22,9 @@ our $AUTOLOAD; my @BUILTIN_SPECIAL_OPS = ( {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'}, {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'}, + {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'}, + {regex => qr/^ value $/ix, handler => '_where_op_VALUE'}, + {regex => qr/^ is (?: \s+ not )? $/ix, handler => '_where_field_IS'}, ); # unaryish operators - key maps to handler @@ -36,6 +34,8 @@ my @BUILTIN_UNARY_OPS = ( { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' }, { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' }, { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' }, + { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' }, + { regex => qr/^ value $/xi, handler => '_where_op_VALUE' }, ); #====================================================================== @@ -50,12 +50,12 @@ sub _debug { sub belch (@) { my($func) = (caller(1))[3]; - carp "[$func] Warning: ", @_; + Carp::carp "[$func] Warning: ", @_; } sub puke (@) { my($func) = (caller(1))[3]; - croak "[$func] Fatal: ", @_; + Carp::croak "[$func] Fatal: ", @_; } @@ -75,17 +75,18 @@ sub new { $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR'; # how to return bind vars - # LDNOTE: changed nwiger code : why this 'delete' ?? - # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal'; $opt{bindtype} ||= 'normal'; # default comparison is "=", but can be overridden $opt{cmp} ||= '='; - # try to recognize which are the 'equality' and 'unequality' ops - # (temporary quickfix, should go through a more seasoned API) - $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i; - $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i; + # try to recognize which are the 'equality' and 'inequality' ops + # (temporary quickfix (in 2007), should go through a more seasoned API) + $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix; + $opt{inequality_op} = qr/^( != | <> )$/ix; + + $opt{like_op} = qr/^ (is\s+)? r?like $/xi; + $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi; # SQL booleans $opt{sqltrue} ||= '1=1'; @@ -93,16 +94,40 @@ sub new { # special operators $opt{special_ops} ||= []; + # regexes are applied in order, thus push after user-defines push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS; # unary operators $opt{unary_ops} ||= []; push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS; + # rudimentary sanity-check for user supplied bits treated as functions/operators + # If a purported function matches this regular expression, an exception is thrown. + # Literal SQL is *NOT* subject to this check, only functions (and column names + # when quoting is not in effect) + + # FIXME + # need to guard against ()'s in column names too, but this will break tons of + # hacks... ideas anyone? + $opt{injection_guard} ||= qr/ + \; + | + ^ \s* go \s + /xmi; + return bless \%opt, $class; } +sub _assert_pass_injection_guard { + if ($_[1] =~ $_[0]->{injection_guard}) { + my $class = ref $_[0]; + puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the " + . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own " + . "{injection_guard} attribute to ${class}->new()" + } +} + #====================================================================== # INSERT methods @@ -429,11 +454,6 @@ sub _where_ARRAYREF { }, HASHREF => sub {$self->_recurse_where($el, 'and') if %$el}, - # LDNOTE : previous SQLA code for hashrefs was creating a dirty - # side-effect: the first hashref within an array would change - # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ] - # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)", - # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)". SCALARREF => sub { ($$el); }, @@ -532,7 +552,9 @@ sub _where_unary_op { } } - $self->debug("Generic unary OP: $op - recursing as function"); + $self->_debug("Generic unary OP: $op - recursing as function"); + + $self->_assert_pass_injection_guard($op); my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, { SCALAR => sub { @@ -572,15 +594,23 @@ sub _where_op_ANDOR { }, SCALARREF => sub { - puke "-$op => \\\$scalar not supported, use -nest => ..."; + puke "-$op => \\\$scalar makes little sense, use " . + ($op =~ /^or/i + ? '[ \$scalar, \%rest_of_conditions ] instead' + : '-and => [ \$scalar, \%rest_of_conditions ] instead' + ); }, ARRAYREFREF => sub { - puke "-$op => \\[..] not supported, use -nest => ..."; + puke "-$op => \\[...] makes little sense, use " . + ($op =~ /^or/i + ? '[ \[...], \%rest_of_conditions ] instead' + : '-and => [ \[...], \%rest_of_conditions ] instead' + ); }, SCALAR => sub { # permissively interpreted as SQL - puke "-$op => 'scalar' not supported, use -nest => \\'scalar'"; + puke "-$op => \$value makes little sense, use -bool => \$value instead"; }, UNDEF => sub { @@ -634,6 +664,50 @@ sub _where_op_BOOL { } +sub _where_op_IDENT { + my $self = shift; + my ($op, $rhs) = splice @_, -2; + if (ref $rhs) { + puke "-$op takes a single scalar argument (a quotable identifier)"; + } + + # in case we are called as a top level special op (no '=') + my $lhs = shift; + + $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs); + + return $lhs + ? "$lhs = $rhs" + : $rhs + ; +} + +sub _where_op_VALUE { + my $self = shift; + my ($op, $rhs) = splice @_, -2; + + # in case we are called as a top level special op (no '=') + my $lhs = shift; + + my @bind = + $self->_bindtype ( + ($lhs || $self->{_nested_func_lhs}), + $rhs, + ) + ; + + return $lhs + ? ( + $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'), + @bind + ) + : ( + $self->_convert('?'), + @bind, + ) + ; +} + sub _where_hashpair_ARRAYREF { my ($self, $k, $v) = @_; @@ -659,7 +733,6 @@ sub _where_hashpair_ARRAYREF { return $self->_recurse_where(\@distributed, $logic); } else { - # LDNOTE : not sure of this one. What does "distribute over nothing" mean? $self->_debug("empty ARRAY($k) means 0=1"); return ($self->{sqlfalse}); } @@ -684,6 +757,11 @@ sub _where_hashpair_HASHREF { $op =~ s/^\s+|\s+$//g;# remove leading/trailing space $op =~ s/\s+/ /g; # compress whitespace + $self->_assert_pass_injection_guard($op); + + # fixup is_not + $op =~ s/^is_not/IS NOT/i; + # so that -not_foo works correctly $op =~ s/^not_/NOT /i; @@ -726,9 +804,14 @@ sub _where_hashpair_HASHREF { }, UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL" - my $is = ($op =~ $self->{equality_op}) ? 'is' : - ($op =~ $self->{inequality_op}) ? 'is not' : - puke "unexpected operator '$orig_op' with undef operand"; + my $is = + $op =~ /^not$/i ? 'is not' # legacy + : $op =~ $self->{equality_op} ? 'is' + : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is' + : $op =~ $self->{inequality_op} ? 'is not' + : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not' + : puke "unexpected operator '$orig_op' with undef operand"; + $sql = $self->_quote($k) . $self->_sqlcase(" $is null"); }, @@ -753,7 +836,22 @@ sub _where_hashpair_HASHREF { return ($all_sql, @all_bind); } +sub _where_field_IS { + my ($self, $k, $op, $v) = @_; + my ($s) = $self->_SWITCH_refkind($v, { + UNDEF => sub { + join ' ', + $self->_convert($self->_quote($k)), + map { $self->_sqlcase($_)} ($op, 'null') + }, + FALLBACK => sub { + puke "$op can only take undef as argument"; + }, + }); + + $s; +} sub _where_field_op_ARRAYREF { my ($self, $k, $op, $vals) = @_; @@ -773,27 +871,35 @@ sub _where_field_op_ARRAYREF { shift @vals; } + # a long standing API wart - an attempt to change this behavior during + # the 1.50 series failed *spectacularly*. Warn instead and leave the + # behavior as is + if ( + @vals > 1 + and + (!$logic or $logic eq 'OR') + and + ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} ) + ) { + my $o = uc($op); + belch "A multi-element arrayref as an argument to the inequality op '$o' " + . 'is technically equivalent to an always-true 1=1 (you probably wanted ' + . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)" + ; + } + # distribute $op over each remaining member of @vals, append logic if exists return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic); - # LDNOTE : had planned to change the distribution logic when - # $op =~ $self->{inequality_op}, because of Morgan laws : - # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate - # WHERE field != 22 OR field != 33 : the user probably means - # WHERE field != 22 AND field != 33. - # To do this, replace the above to roughly : - # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR'; - # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic); - } else { # try to DWIM on equality operators - # LDNOTE : not 100% sure this is the correct thing to do ... - return ($self->{sqlfalse}) if $op =~ $self->{equality_op}; - return ($self->{sqltrue}) if $op =~ $self->{inequality_op}; - - # otherwise - puke "operator '$op' applied on an empty array (field '$k')"; + return + $op =~ $self->{equality_op} ? $self->{sqlfalse} + : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse} + : $op =~ $self->{inequality_op} ? $self->{sqltrue} + : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue} + : puke "operator '$op' applied on an empty array (field '$k')"; } } @@ -877,6 +983,8 @@ sub _where_field_BETWEEN { $placeholder = $self->_convert('?'); $op = $self->_sqlcase($op); + my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref"; + my ($clause, @bind) = $self->_SWITCH_refkind($vals, { ARRAYREFREF => sub { my ($s, @b) = @$$vals; @@ -887,8 +995,7 @@ sub _where_field_BETWEEN { return $$vals; }, ARRAYREF => sub { - puke "special op 'between' accepts an arrayref with exactly two values" - if @$vals != 2; + puke $invalid_args if @$vals != 2; my (@all_sql, @all_bind); foreach my $val (@$vals) { @@ -910,7 +1017,10 @@ sub _where_field_BETWEEN { if (@rest or $func !~ /^ \- (.+)/x); local $self->{_nested_func_lhs} = $k; $self->_where_unary_op ($1 => $arg); - } + }, + FALLBACK => sub { + puke $invalid_args, + }, }); push @all_sql, $sql; push @all_bind, @bind; @@ -922,7 +1032,7 @@ sub _where_field_BETWEEN { ); }, FALLBACK => sub { - puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref"; + puke $invalid_args, }, }); @@ -967,7 +1077,12 @@ sub _where_field_IN { $self->_where_unary_op ($1 => $arg); }, UNDEF => sub { - return $self->_sqlcase('null'); + puke( + 'SQL::Abstract before v1.75 used to generate incorrect SQL when the ' + . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE " + . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract ' + . 'will emit the logically correct SQL instead of raising this exception)' + ); }, }); push @all_sql, $sql; @@ -1000,8 +1115,12 @@ sub _where_field_IN { return ("$label $op ( $sql )", @bind); }, + UNDEF => sub { + puke "Argument passed to the '$op' operator can not be undefined"; + }, + FALLBACK => sub { - puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)"; + puke "special op $op requires an arrayref (or scalarref/arrayref-ref)"; }, }); @@ -1112,7 +1231,6 @@ sub _table { ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;}, SCALAR => sub {$self->_quote($from)}, SCALARREF => sub {$$from}, - ARRAYREFREF => sub {join ', ', @$from;}, }); } @@ -1128,7 +1246,10 @@ sub _quote { return '' unless defined $_[1]; return ${$_[1]} if ref($_[1]) eq 'SCALAR'; - return $_[1] unless $_[0]->{quote_char}; + unless ($_[0]->{quote_char}) { + $_[0]->_assert_pass_injection_guard($_[1]); + return $_[1]; + } my $qref = ref $_[0]->{quote_char}; my ($l, $r); @@ -1153,16 +1274,6 @@ sub _quote { # Conversion, if applicable sub _convert ($) { #my ($self, $arg) = @_; - -# LDNOTE : modified the previous implementation below because -# it was not consistent : the first "return" is always an array, -# the second "return" is context-dependent. Anyway, _convert -# seems always used with just a single argument, so make it a -# scalar function. -# return @_ unless $self->{convert}; -# my $conv = $self->_sqlcase($self->{convert}); -# my @ret = map { $conv.'('.$_.')' } @_; -# return wantarray ? @ret : $ret[0]; if ($_[0]->{convert}) { return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')'; } @@ -1172,11 +1283,6 @@ sub _convert ($) { # And bindtype sub _bindtype (@) { #my ($self, $col, @vals) = @_; - - #LDNOTE : changed original implementation below because it did not make - # sense when bindtype eq 'columns' and @vals > 1. -# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals; - # called often - tighten code return $_[0]->{bindtype} eq 'columns' ? map {[$_[1], $_]} @_[2 .. $#_] @@ -1424,7 +1530,7 @@ SQL::Abstract - Generate SQL from Perl data structures my $sql = SQL::Abstract->new; - my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order); + my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order); my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values); @@ -1613,7 +1719,7 @@ C to C you would get SQL such as: WHERE name like 'nwiger' AND email like 'nate@wiger.org' -You can also override the comparsion on an individual basis - see +You can also override the comparison on an individual basis - see the huge section on L at the bottom. =item sqltrue, sqlfalse @@ -1752,6 +1858,20 @@ so that tables and column names can be individually quoted like this: SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1 +=item injection_guard + +A regular expression C that is applied to any C<-function> and unquoted +column name specified in a query structure. This is a safety mechanism to avoid +injection attacks when mishandling user input e.g.: + + my %condition_as_column_value_pairs = get_values_from_user(); + $sqla->select( ... , \%condition_as_column_value_pairs ); + +If the expression matches an exception is thrown. Note that literal SQL +supplied via C<\'...'> or C<\['...']> is B checked in any way. + +Defaults to checking for C<;> and the C keyword (TransactSQL) + =item array_datatypes When this option is true, arrayrefs in INSERT or UPDATE are @@ -1838,8 +1958,8 @@ the source. The argument can be either an arrayref (interpreted as a list of field names, will be joined by commas and quoted), or a plain scalar (literal SQL, not quoted). -Please observe that this API is not as flexible as for -the first argument C<$table>, for backwards compatibility reasons. +Please observe that this API is not as flexible as that of +the first argument C<$source>, for backwards compatibility reasons. =item $where @@ -1912,9 +2032,6 @@ Might give you: You get the idea. Strings get their case twiddled, but everything else remains verbatim. - - - =head1 WHERE CLAUSES =head2 Introduction @@ -1977,6 +2094,13 @@ becomes: $stmt = "WHERE user = ? AND status IS NULL"; @bind = ('nwiger'); +To test if a column IS NOT NULL: + + my %where = ( + user => 'nwiger', + status => { '!=', undef }, + ); + =head2 Specific comparison operators If you want to specify a different type of operator for your comparison, @@ -2023,13 +2147,13 @@ To get an OR instead, you can combine it with the arrayref idea: my %where => ( user => 'nwiger', - priority => [ {'=', 2}, {'!=', 1} ] + priority => [ { '=', 2 }, { '>', 5 } ] ); Which would generate: - $stmt = "WHERE user = ? AND priority = ? OR priority != ?"; - @bind = ('nwiger', '2', '1'); + $stmt = "WHERE ( priority = ? OR priority > ? ) AND user = ?"; + @bind = ('2', '5', 'nwiger'); If you want to include literal SQL (with or without bind values), just use a scalar reference or array reference as the value: @@ -2127,7 +2251,8 @@ would generate: )"; @bind = ('2000'); - +Finally, if the argument to C<-in> is not a reference, it will be +treated as a single-element array. Another pair of operators is C<-between> and C<-not_between>, used with an arrayref of two values: @@ -2192,15 +2317,19 @@ then you should use the and/or operators:- my %where = ( -and => [ -bool => 'one', - -bool => 'two', - -bool => 'three', - -not_bool => 'four', + -not_bool => { two=> { -rlike => 'bar' } }, + -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] }, ], ); Would give you: - WHERE one AND two AND three AND NOT four + WHERE + one + AND + (NOT two RLIKE ?) + AND + (NOT ( three = ? OR three > ? )) =head2 Nested conditions, -and/-or prefixes @@ -2227,43 +2356,27 @@ This data structure would create the following: @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned'); -There is also a special C<-nest> -operator which adds an additional set of parens, to create a subquery. -For example, to get something like this: - - $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )"; - @bind = ('nwiger', '20', 'ASIA'); - -You would do: - - my %where = ( - user => 'nwiger', - -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ], - ); - - -Finally, clauses in hashrefs or arrayrefs can be -prefixed with an C<-and> or C<-or> to change the logic -inside : +Clauses in hashrefs or arrayrefs can be prefixed with an C<-and> or C<-or> +to change the logic inside : my @where = ( -and => [ user => 'nwiger', - -nest => [ - -and => [workhrs => {'>', 20}, geo => 'ASIA' ], - -and => [workhrs => {'<', 50}, geo => 'EURO' ] + [ + -and => [ workhrs => {'>', 20}, geo => 'ASIA' ], + -or => { workhrs => {'<', 50}, geo => 'EURO' }, ], ], ); That would yield: - WHERE ( user = ? AND - ( ( workhrs > ? AND geo = ? ) - OR ( workhrs < ? AND geo = ? ) ) ) - + WHERE ( user = ? AND ( + ( workhrs > ? AND geo = ? ) + OR ( workhrs < ? OR geo = ? ) + ) ) -=head2 Algebraic inconsistency, for historical reasons +=head3 Algebraic inconsistency, for historical reasons C: when connecting several conditions, the C<-and->|C<-or> operator goes C of the nested structure; whereas when connecting @@ -2293,64 +2406,88 @@ seem algebraically equivalent, but they are not # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) ) -=head2 Literal SQL +=head2 Literal SQL and value type operators -Finally, sometimes only literal SQL will do. If you want to include -literal SQL verbatim, you can specify it as a scalar reference, namely: +The basic premise of SQL::Abstract is that in WHERE specifications the "left +side" is a column name and the "right side" is a value (normally rendered as +a placeholder). This holds true for both hashrefs and arrayref pairs as you +see in the L examples above. Sometimes it is necessary to +alter this behavior. There are several ways of doing so. + +=head3 -ident + +This is a virtual operator that signals the string to its right side is an +identifier (a column name) and not a value. For example to compare two +columns you would write: - my $inn = 'is Not Null'; my %where = ( priority => { '<', 2 }, - requestor => \$inn + requestor => { -ident => 'submitter' }, ); -This would create: +which creates: - $stmt = "WHERE priority < ? AND requestor is Not Null"; + $stmt = "WHERE priority < ? AND requestor = submitter"; @bind = ('2'); -Note that in this example, you only get one bind parameter back, since -the verbatim SQL is passed as part of the statement. +If you are maintaining legacy code you may see a different construct as +described in L, please use C<-ident> in new +code. + +=head3 -value -Of course, just to prove a point, the above can also be accomplished -with this: +This is a virtual operator that signals that the construct to its right side +is a value to be passed to DBI. This is for example necessary when you want +to write a where clause against an array (for RDBMS that support such +datatypes). For example: my %where = ( - priority => { '<', 2 }, - requestor => { '!=', undef }, + array => { -value => [1, 2, 3] } ); +will result in: -TMTOWTDI + $stmt = 'WHERE array = ?'; + @bind = ([1, 2, 3]); -Conditions on boolean columns can be expressed in the same way, passing -a reference to an empty string, however using liternal SQL in this way -is deprecated - the preferred method is to use the boolean operators - -see L : +Note that if you were to simply say: my %where = ( - priority => { '<', 2 }, - is_ready => \""; + array => [1, 2, 3] ); -which yields +the result would probably not be what you wanted: - $stmt = "WHERE priority < ? AND is_ready"; - @bind = ('2'); + $stmt = 'WHERE array = ? OR array = ? OR array = ?'; + @bind = (1, 2, 3); -Literal SQL is also the only way to compare 2 columns to one another: +=head3 Literal SQL + +Finally, sometimes only literal SQL will do. To include a random snippet +of SQL verbatim, you specify it as a scalar reference. Consider this only +as a last resort. Usually there is a better way. For example: my %where = ( priority => { '<', 2 }, - requestor => \'= submittor' + requestor => { -in => \'(SELECT name FROM hitmen)' }, ); -which creates: +Would create: - $stmt = "WHERE priority < ? AND requestor = submitter"; - @bind = ('2'); + $stmt = "WHERE priority < ? AND requestor IN (SELECT name FROM hitmen)" + @bind = (2); + +Note that in this example, you only get one bind parameter back, since +the verbatim SQL is passed as part of the statement. + +=head4 CAVEAT -=head2 Literal SQL with placeholders and bind values (subqueries) + Never use untrusted input as a literal SQL argument - this is a massive + security risk (there is no way to check literal snippets for SQL + injections and other nastyness). If you need to deal with untrusted input + use literal SQL with placeholders as described next. + +=head3 Literal SQL with placeholders and bind values (subqueries) If the literal SQL to be inserted has placeholders and bind values, use a reference to an arrayref (yes this is a double reference -- @@ -2413,10 +2550,10 @@ hash, like an EXISTS subquery : my ($sub_stmt, @sub_bind) = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"}); - my %where = ( + my %where = ( -and => [ foo => 1234, - -nest => \["EXISTS ($sub_stmt)" => @sub_bind], - ); + \["EXISTS ($sub_stmt)" => @sub_bind], + ]); which yields @@ -2432,15 +2569,6 @@ Writing C<< c2 => {">" => "t0.c0"} >> would have generated C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly what we wanted here. -Another use of the subquery technique is when some SQL clauses need -parentheses, as it often occurs with some proprietary SQL extensions -like for example fulltext expressions, geospatial expressions, -NATIVE clauses, etc. Here is an example of a fulltext query in MySQL : - - my %where = ( - -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/] - ); - Finally, here is an example where a subquery is used for expressing unary negation: @@ -2449,7 +2577,7 @@ for expressing unary negation: $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause my %where = ( lname => {like => '%son%'}, - -nest => \["NOT ($sub_stmt)" => @sub_bind], + \["NOT ($sub_stmt)" => @sub_bind], ); This yields @@ -2457,7 +2585,47 @@ This yields $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )" @bind = ('%son%', 10, 20) +=head3 Deprecated usage of Literal SQL + +Below are some examples of archaic use of literal SQL. It is shown only as +reference for those who deal with legacy code. Each example has a much +better, cleaner and safer alternative that users should opt for in new code. + +=over + +=item * + + my %where = ( requestor => \'IS NOT NULL' ) + + $stmt = "WHERE requestor IS NOT NULL" + +This used to be the way of generating NULL comparisons, before the handling +of C got formalized. For new code please use the superior syntax as +described in L. + +=item * + my %where = ( requestor => \'= submitter' ) + + $stmt = "WHERE requestor = submitter" + +This used to be the only way to compare columns. Use the superior L +method for all new code. For example an identifier declared in such a way +will be properly quoted if L is properly set, while the legacy +form will remain as supplied. + +=item * + + my %where = ( is_ready => \"", completed => { '>', '2012-12-21' } ) + + $stmt = "WHERE completed > ? AND is_ready" + @bind = ('2012-12-21') + +Using an empty string literal used to be the only way to express a boolean. +For all new code please use the much more readable +L<-bool|/Unary operators: bool> operator. + +=back =head2 Conclusion @@ -2474,9 +2642,6 @@ knew everything ahead of time, you wouldn't have to worry about dynamically-generating SQL and could just hardwire it into your script. - - - =head1 ORDER BY CLAUSES Some functions take an order by clause. This can either be a scalar (just a @@ -2687,6 +2852,9 @@ can be as simple as the following: #!/usr/bin/perl + use warnings; + use strict; + use CGI::FormBuilder; use SQL::Abstract; @@ -2712,9 +2880,9 @@ apps in under 50 lines. =over -=item * gitweb: L +=item * gitweb: L -=item * git: L +=item * git: L =back @@ -2778,8 +2946,6 @@ dropped the C<_modlogic> function =back - - =head1 ACKNOWLEDGEMENTS There are a number of individuals that have really helped out with @@ -2795,7 +2961,7 @@ so I have no idea who they are! But the people I do know are: Mike Fragassi (enhancements to "BETWEEN" and "LIKE") Dan Kubb (support for "quote_char" and "name_sep") Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by) - Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL) + Laurent Dami (internal refactoring, extensible list of special operators, literal SQL) Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests) Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests) Oliver Charles (support for "RETURNING" after "INSERT")