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