X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=3940881780655186d44386811ff3e5205b8fa939;hb=3cb8f017c8746fa9c688540f3e8bda09363bda09;hp=4802d4c770f2dd107c57acf1c5ed289e8d2c7e5a;hpb=48d9f5f846e7f9e8f51110ad418a3bb4b50c31f9;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 4802d4c..3940881 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.71'; +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: ", @_; } @@ -93,16 +97,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 saniy-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 @@ -532,7 +560,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 { @@ -573,7 +603,7 @@ sub _where_op_ANDOR { SCALARREF => sub { puke "-$op => \\\$scalar makes little sense, use " . - ($op =~ /^or/i + ($op =~ /^or/i ? '[ \$scalar, \%rest_of_conditions ] instead' : '-and => [ \$scalar, \%rest_of_conditions ] instead' ); @@ -581,7 +611,7 @@ sub _where_op_ANDOR { ARRAYREFREF => sub { puke "-$op => \\[...] makes little sense, use " . - ($op =~ /^or/i + ($op =~ /^or/i ? '[ \[...], \%rest_of_conditions ] instead' : '-and => [ \[...], \%rest_of_conditions ] instead' ); @@ -642,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) = @_; @@ -692,6 +766,8 @@ 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); + # so that -not_foo works correctly $op =~ s/^not_/NOT /i; @@ -1120,7 +1196,6 @@ sub _table { ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;}, SCALAR => sub {$self->_quote($from)}, SCALARREF => sub {$$from}, - ARRAYREFREF => sub {join ', ', @$from;}, }); } @@ -1136,7 +1211,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); @@ -1432,7 +1510,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); @@ -1760,6 +1838,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 @@ -1846,8 +1938,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 @@ -1920,9 +2012,6 @@ Might give you: You get the idea. Strings get their case twiddled, but everything else remains verbatim. - - - =head1 WHERE CLAUSES =head2 Introduction @@ -1985,6 +2074,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, @@ -2031,13 +2127,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: @@ -2255,7 +2351,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 @@ -2285,64 +2381,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. + +=head3 -ident -Finally, sometimes only literal SQL will do. If you want to include -literal SQL verbatim, you can specify it as a scalar reference, namely: +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 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); + +=head3 Literal SQL -Literal SQL is also the only way to compare 2 columns to one another: +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 -- @@ -2440,7 +2560,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 @@ -2457,9 +2617,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 @@ -2695,9 +2852,9 @@ apps in under 50 lines. =over -=item * gitweb: L +=item * gitweb: L -=item * git: L +=item * git: L =back @@ -2761,8 +2918,6 @@ dropped the C<_modlogic> function =back - - =head1 ACKNOWLEDGEMENTS There are a number of individuals that have really helped out with