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