lib/DBIx/Class/Storage/DBI/NoBindVars.pm

   1 package DBIx::Class::Storage::DBI::NoBindVars;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'DBIx::Class::Storage::DBI';
   7 use mro 'c3';
   8
   9 use DBIx::Class::SQLMaker::LimitDialects;
  10 use List::Util qw/first/;
  11
  12 use namespace::clean;
  13
  14 =head1 NAME
  15
  16 DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
  17
  18 =head1 DESCRIPTION
  19
  20 This class allows queries to work when the DBD or underlying library does not
  21 support the usual C<?> placeholders, or at least doesn't support them very
  22 well, as is the case with L<DBD::Sybase>
  23
  24 =head1 METHODS
  25
  26 =head2 connect_info
  27
  28 We can't cache very effectively without bind variables, so force the C<disable_sth_caching> setting to be turned on when the connect info is set.
  29
  30 =cut
  31
  32 sub connect_info {
  33     my $self = shift;
  34     my $retval = $self->next::method(@_);
  35     $self->disable_sth_caching(1);
  36     $retval;
  37 }
  38
  39 =head2 _prep_for_execute
  40
  41 Manually subs in the values for the usual C<?> placeholders.
  42
  43 =cut
  44
  45 sub _prep_for_execute {
  46   my $self = shift;
  47
  48   my ($sql, $bind) = $self->next::method(@_);
  49
  50   # stringify bind args, quote via $dbh, and manually insert
  51   #my ($op, $ident, $args) = @_;
  52   my $ident = $_[1];
  53
  54   my @sql_part = split /\?/, $sql;
  55   my $new_sql;
  56
  57   for (@$bind) {
  58     my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify, array types are currently not supported
  59
  60     my $datatype = $_->[0]{sqlt_datatype};
  61
  62     $data = $self->_prep_interpolated_value($datatype, $data)
  63       if $datatype;
  64
  65     $data = $self->_get_dbh->quote($data)
  66       unless ($datatype and $self->interpolate_unquoted($datatype, $data) );
  67
  68     $new_sql .= shift(@sql_part) . $data;
  69   }
  70
  71   $new_sql .= join '', @sql_part;
  72
  73   return ($new_sql, []);
  74 }
  75
  76 =head2 interpolate_unquoted
  77
  78 This method is called by L</_prep_for_execute> for every column in
  79 order to determine if its value should be quoted or not. The arguments
  80 are the current column data type and the actual bind value. The return
  81 value is interpreted as: true - do not quote, false - do quote. You should
  82 override this in you Storage::DBI::<database> subclass, if your RDBMS
  83 does not like quotes around certain datatypes (e.g. Sybase and integer
  84 columns). The default method returns false, except for integer datatypes
  85 paired with values containing nothing but digits.
  86
  87  WARNING!!!
  88
  89  Always validate that the bind-value is valid for the current datatype.
  90  Otherwise you may very well open the door to SQL injection attacks.
  91
  92 =cut
  93
  94 sub interpolate_unquoted {
  95   #my ($self, $datatype, $value) = @_;
  96
  97   return 1 if (
  98     defined $_[2]
  99       and
 100     $_[1]
 101       and
 102     $_[2] !~ /\D/
 103       and
 104     $_[1] =~ /int(?:eger)? | (?:tiny|small|medium|big)int/ix
 105   );
 106
 107   return 0;
 108 }
 109
 110 =head2 _prep_interpolated_value
 111
 112 Given a datatype and the value to be inserted directly into a SQL query, returns
 113 the necessary string to represent that value (by e.g. adding a '$' sign)
 114
 115 =cut
 116
 117 sub _prep_interpolated_value {
 118   #my ($self, $datatype, $value) = @_;
 119   return $_[2];
 120 }
 121
 122 =head1 AUTHORS
 123
 124 See L<DBIx::Class/CONTRIBUTORS>
 125
 126 =head1 LICENSE
 127
 128 You may distribute this code under the same terms as Perl itself.
 129
 130 =cut
 131
 132 1;