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 Scalar::Util ();
   8 use Carp::Clan qw/^DBIx::Class/;
   9
  10 =head1 NAME
  11
  12 DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
  13
  14 =head1 DESCRIPTION
  15
  16 This class allows queries to work when the DBD or underlying library does not
  17 support the usual C<?> placeholders, or at least doesn't support them very
  18 well, as is the case with L<DBD::Sybase>
  19
  20 =head1 METHODS
  21
  22 =head2 connect_info
  23
  24 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.
  25
  26 =cut
  27
  28 sub connect_info {
  29     my $self = shift;
  30     my $retval = $self->next::method(@_);
  31     $self->disable_sth_caching(1);
  32     $retval;
  33 }
  34
  35 =head2 _prep_for_execute
  36
  37 Manually subs in the values for the usual C<?> placeholders.
  38
  39 =cut
  40
  41 sub _prep_for_execute {
  42   my $self = shift;
  43
  44   my ($op, $extra_bind, $ident, $args) = @_;
  45
  46   my ($sql, $bind) = $self->next::method(@_);
  47
  48   # stringify args, quote via $dbh, and manually insert
  49
  50   my @sql_part = split /\?/, $sql;
  51   my $new_sql;
  52
  53   my $alias2src = $self->_resolve_ident_sources($ident);
  54
  55   foreach my $bound (@$bind) {
  56     my $col = shift @$bound;
  57
  58     my $name_sep   = $self->_sql_maker_opts->{name_sep} || '.';
  59     my $quote_char = $self->_sql_maker_opts->{quote_char} || '';
  60     $quote_char    = join '', @$quote_char if ref $quote_char eq 'ARRAY';
  61
  62     $col =~ s/[\Q${quote_char}\E]//g if $quote_char;
  63     $col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
  64     my $alias = $1 || 'me';
  65
  66     my $rsrc = $alias2src->{$alias};
  67
  68     my $datatype = $rsrc && $rsrc->column_info($col)->{data_type};
  69
  70     foreach my $data (@$bound) {
  71         $data = ''.$data if ref $data;
  72
  73         $data = $self->_dbh->quote($data) if $self->should_quote($datatype, $data);
  74
  75         $new_sql .= shift(@sql_part) . $data;
  76     }
  77   }
  78   $new_sql .= join '', @sql_part;
  79
  80   return ($new_sql, []);
  81 }
  82
  83 =head2 should_quote
  84
  85 This method is called by L</_prep_for_execute> for every column in
  86 order to determine if its value should be quoted or not. The arguments
  87 are the current column data type and the actual bind value. The return
  88 value is interpreted as: true - do quote, false - do not quote. You should
  89 override this in you Storage::DBI::<database> subclass, if your RDBMS
  90 does not like quotes around certain datatypes (e.g. Sybase and integer
  91 columns). The default method always returns true (do quote).
  92
  93  WARNING!!!
  94
  95  Always validate that the bind-value is valid for the current datatype.
  96  Otherwise you may very well open the door to SQL injection attacks.
  97
  98 =cut
  99
 100 sub should_quote { 1 }
 101
 102 =head1 AUTHORS
 103
 104 Brandon Black <blblack@gmail.com>
 105
 106 Trym Skaar <trym@tryms.no>
 107
 108 =head1 LICENSE
 109
 110 You may distribute this code under the same terms as Perl itself.
 111
 112 =cut
 113
 114 1;