X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=6a3fa8e9b2f39e1cfe1a765e9c37b5ce6532d6d7;hb=2266ca5c0bf34c24ba7fbf6448ad1c34a082f240;hp=2041fa61cc2f85694d217f19f47f491f67bd5e77;hpb=a0d6d3230359880681d5d328d6b1775c0fbe5983;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 2041fa6..6a3fa8e 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.73'; # 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: ", @_; } @@ -556,7 +560,7 @@ 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); @@ -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) = @_; @@ -1102,16 +1150,24 @@ sub _order_by_chunks { SCALARREF => sub {$$arg}, # literal SQL, no quoting HASHREF => sub { - # get first pair in hash - my ($key, $val, @rest) = %$arg; - - return () unless $key; - - if ( @rest or not $key =~ /^-(desc|asc)/i ) { - puke "hash passed to _order_by must have exactly one key (-desc or -asc)"; + return () unless %$arg; + + my ($direction, $nulls, $val); + foreach my $key (keys %$arg) { + if ( $key =~ /^-(desc|asc)/i ) { + puke "hash passed to _order_by must have exactly one of -desc or -asc" + if defined $direction; + $direction = $1; + $val = $arg->{$key}; + } elsif ($key =~ /^-nulls$/i) { + $nulls = $arg->{$key}; + puke "invalid value for -nulls" unless $nulls =~ /^(?:first|last)$/; + } else { + puke "invalid key in hash passed to _order_by"; + } } - - my $direction = $1; + puke "hash passed to _order_by must have exactly one of -desc or -asc" + unless defined $direction; my @ret; for my $c ($self->_order_by_chunks ($val)) { @@ -1126,7 +1182,9 @@ sub _order_by_chunks { }, }); - $sql = $sql . ' ' . $self->_sqlcase($direction); + $sql .= ' ' . $self->_sqlcase($direction); + $sql .= ' ' . $self->_sqlcase("nulls $nulls") + if defined $nulls; push @ret, [ $sql, @bind]; } @@ -1964,9 +2022,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 +2084,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, @@ -2075,13 +2137,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: @@ -2299,7 +2361,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 +2391,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. -Of course, just to prove a point, the above can also be accomplished -with this: +=head3 -value + +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 porbably be not 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. -=head2 Literal SQL with placeholders and bind values (subqueries) +=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 +2570,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,13 +2627,11 @@ 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 column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>, +optionally with C<< -nulls => 'first' >> or C<< -nulls => 'last' >>, or an array of either of the two previous forms. Examples: Given | Will Generate @@ -2523,10 +2647,20 @@ or an array of either of the two previous forms. Examples: | {-desc => 'colB'} | ORDER BY colB DESC | + { | + -asc => 'colA', | ORDER BY colA ASC NULLS LAST + -nulls => 'last', | + } | + | ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC | { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC | + { | + -asc => [qw/colA colB/] | ORDER BY colA ASC NULLS FIRST, + -nulls => 'first' | colB ASC NULLS FIRST + } | + | [ | { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC, { -desc => [qw/colB/], | colC ASC, colD ASC @@ -2739,9 +2873,9 @@ apps in under 50 lines. =over -=item * gitweb: L +=item * gitweb: L -=item * git: L +=item * git: L =back @@ -2805,8 +2939,6 @@ dropped the C<_modlogic> function =back - - =head1 ACKNOWLEDGEMENTS There are a number of individuals that have really helped out with