X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FNoBindVars.pm;h=85810cc0470812a832166d076ccffdc45d00b713;hb=3dd506b8d3671add7886c056b15a2c8a88c985e3;hp=9f81caffce384be029e926eeb5b76da6837a1831;hpb=00c937a24ecd01b75997dd3e0211f2377fcd84ff;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm index 9f81caf..85810cc 100644 --- a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm @@ -4,8 +4,14 @@ use strict; use warnings; use base 'DBIx::Class::Storage::DBI'; +use mro 'c3'; -=head1 NAME +use DBIx::Class::SQLMaker::LimitDialects; +use List::Util qw/first/; + +use namespace::clean; + +=head1 NAME DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables @@ -39,51 +45,83 @@ Manually subs in the values for the usual C placeholders. sub _prep_for_execute { my $self = shift; - my ($op, $extra_bind, $ident) = @_; - my ($sql, $bind) = $self->next::method(@_); - # stringify args, quote via $dbh, and manually insert + # stringify bind args, quote via $dbh, and manually insert + #my ($op, $ident, $args) = @_; + my $ident = $_[1]; my @sql_part = split /\?/, $sql; my $new_sql; - foreach my $bound (@$bind) { - my $col = shift @$bound; - my $do_quote = $self->should_quote_data_type($col); - foreach my $data (@$bound) { - if(ref $data) { - $data = ''.$data; - } - $data = $self->_dbh->quote($data) if $do_quote; - $new_sql .= shift(@sql_part) . $data; - } + for (@$bind) { + my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify, array types are currently not supported + + my $datatype = $_->[0]{sqlt_datatype}; + + $data = $self->_prep_interpolated_value($datatype, $data) + if $datatype; + + $data = $self->_get_dbh->quote($data) + unless ($datatype and $self->interpolate_unquoted($datatype, $data) ); + + $new_sql .= shift(@sql_part) . $data; } + $new_sql .= join '', @sql_part; - return ($new_sql); + return ($new_sql, []); } -=head2 should_quote_data_type +=head2 interpolate_unquoted This method is called by L for every column in -order to determine if its value should be quoted or not. The sole -argument is the current column data type, and the return value is -interpreted as: true - do quote, false - do not quote. You should -override this in you Storage::DBI:: subclass, if your -RDBMS does not like quotes around certain datatypes (e.g. Sybase -and integer columns). The default method always returns true (do -quote). +order to determine if its value should be quoted or not. The arguments +are the current column data type and the actual bind value. The return +value is interpreted as: true - do not quote, false - do quote. You should +override this in you Storage::DBI:: subclass, if your RDBMS +does not like quotes around certain datatypes (e.g. Sybase and integer +columns). The default method returns false, except for integer datatypes +paired with values containing nothing but digits. + + WARNING!!! + + Always validate that the bind-value is valid for the current datatype. + Otherwise you may very well open the door to SQL injection attacks. =cut -sub should_quote_data_type { 1 } +sub interpolate_unquoted { + #my ($self, $datatype, $value) = @_; -=head1 AUTHORS + return 1 if ( + defined $_[2] + and + $_[1] + and + $_[2] !~ /\D/ + and + $_[1] =~ /int(?:eger)? | (?:tiny|small|medium|big)int/ix + ); + + return 0; +} + +=head2 _prep_interpolated_value + +Given a datatype and the value to be inserted directly into a SQL query, returns +the necessary string to represent that value (by e.g. adding a '$' sign) -Brandon Black +=cut + +sub _prep_interpolated_value { + #my ($self, $datatype, $value) = @_; + return $_[2]; +} + +=head1 AUTHORS -Trym Skaar +See L =head1 LICENSE