X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=d017b850112d0345510f19c1a6e4b90f89cdbe12;hb=23401b818b099397e04df91b43340ecd59e8f92b;hp=9e5bb5239e081905aec8663bce68e8a87e7c7d08;hpb=3d86e3b17c0fc37a393b6b91936da222128ded56;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 9e5bb52..d017b85 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -5,9 +5,9 @@ package SQL::Abstract; # see doc at end of file # 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 +15,7 @@ use Scalar::Util (); # GLOBALS #====================================================================== -our $VERSION = '1.72'; +our $VERSION = '1.74'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -27,6 +27,8 @@ 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'}, ); # unaryish operators - key maps to handler @@ -36,6 +38,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 $/ix, handler => '_where_op_VALUE' }, ); #====================================================================== @@ -50,12 +54,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: ", @_; } @@ -82,7 +86,7 @@ sub new { # default comparison is "=", but can be overridden $opt{cmp} ||= '='; - # try to recognize which are the 'equality' and 'unequality' ops + # try to recognize which are the 'equality' and 'inequality' 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; @@ -100,7 +104,7 @@ sub new { $opt{unary_ops} ||= []; push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS; - # rudimentary saniy-check for user supplied bits treated as functions/operators + # 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) @@ -668,6 +672,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) = @_; @@ -913,6 +961,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; @@ -923,8 +973,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) { @@ -946,7 +995,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; @@ -958,7 +1010,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, }, }); @@ -1003,7 +1055,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; @@ -1036,8 +1093,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)"; }, }); @@ -1462,7 +1523,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); @@ -1651,7 +1712,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 @@ -1890,8 +1951,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 @@ -1964,9 +2025,6 @@ Might give you: You get the idea. Strings get their case twiddled, but everything else remains verbatim. - - - =head1 WHERE CLAUSES =head2 Introduction @@ -2029,6 +2087,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, @@ -2179,7 +2244,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: @@ -2244,15 +2310,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 @@ -2299,7 +2369,7 @@ That would yield: 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 @@ -2329,64 +2399,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 + +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. -Finally, sometimes only literal SQL will do. If you want to include -literal SQL verbatim, you can specify it as a scalar reference, namely: +=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); -=head2 Literal SQL with placeholders and bind values (subqueries) +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 + + 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 -- @@ -2484,7 +2578,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 @@ -2501,9 +2635,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 @@ -2805,8 +2936,6 @@ dropped the C<_modlogic> function =back - - =head1 ACKNOWLEDGEMENTS There are a number of individuals that have really helped out with