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=b6a469f7;hp=1ccc12e579e0a8ff769f851d5c8f1bd18510b1b9;hpb=7c63f828e43fbae10a28a9894483b735c88bc0d3;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm index 1ccc12e..85810cc 100644 --- a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm @@ -6,7 +6,12 @@ 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 @@ -43,69 +48,80 @@ sub _prep_for_execute { my ($sql, $bind) = $self->next::method(@_); # stringify bind args, quote via $dbh, and manually insert - #my ($op, $extra_bind, $ident, $args) = @_; - my $ident = $_[2]; + #my ($op, $ident, $args) = @_; + my $ident = $_[1]; my @sql_part = split /\?/, $sql; my $new_sql; - my $col_info = $self->_resolve_column_info($ident, [ map $_->[0], @$bind ]); - - foreach my $bound (@$bind) { - my $col = shift @$bound; + for (@$bind) { + my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify, array types are currently not supported - my $datatype = $col_info->{$col}{data_type}; + my $datatype = $_->[0]{sqlt_datatype}; - foreach my $data (@$bound) { - $data = ''.$data if ref $data; + $data = $self->_prep_interpolated_value($datatype, $data) + if $datatype; - $data = $self->transform_unbound_value($datatype, $data) - if $datatype; + $data = $self->_get_dbh->quote($data) + unless ($datatype and $self->interpolate_unquoted($datatype, $data) ); - $data = $self->_dbh->quote($data) - if (!$datatype || $self->should_quote_value($datatype, $data)); - - $new_sql .= shift(@sql_part) . $data; - } + $new_sql .= shift(@sql_part) . $data; } + $new_sql .= join '', @sql_part; return ($new_sql, []); } -=head2 should_quote_value +=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 arguments are the current column data type and the actual bind value. The return -value is interpreted as: true - do quote, false - do not quote. You should +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 always returns true (do quote). +columns). The default method returns false, except for integer datatypes +paired with values containing nothing but digits. - WARNING!!! + 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 +=cut -sub should_quote_value { 1 } +sub interpolate_unquoted { + #my ($self, $datatype, $value) = @_; -=head2 transform_unbound_value + 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 SQL fragment to represent that value. +the necessary string to represent that value (by e.g. adding a '$' sign) =cut -sub transform_unbound_value { $_[2] } +sub _prep_interpolated_value { + #my ($self, $datatype, $value) = @_; + return $_[2]; +} =head1 AUTHORS -Brandon Black - -Trym Skaar +See L =head1 LICENSE