File Coverage

blib/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
Criterion Covered Total %
statement 41 41 100.0
branch 6 8 75.0
condition 7 12 58.3
subroutine 11 11 100.0
pod 2 2 100.0
total 67 74 90.5


line stmt bran cond sub pod time code
1             package DBIx::Class::Storage::DBI::NoBindVars;
2              
3 3     3   1686 use strict;
  3         3  
  3         72  
4 3     3   10 use warnings;
  3         4  
  3         62  
5              
6 3     3   9 use base 'DBIx::Class::Storage::DBI';
  3         3  
  3         690  
7 3     3   13 use mro 'c3';
  3         8  
  3         14  
8              
9 3     3   551 use DBIx::Class::SQLMaker::LimitDialects;
  3         4  
  3         102  
10 3     3   14 use List::Util qw/first/;
  3         4  
  3         138  
11              
12 3     3   13 use namespace::clean;
  3         5  
  3         16  
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
23              
24             =head1 METHODS
25              
26             =head2 connect_info
27              
28             We can't cache very effectively without bind variables, so force the C setting to be turned on when the connect info is set.
29              
30             =cut
31              
32             sub connect_info {
33 1     1 1 2 my $self = shift;
34 1         4 my $retval = $self->next::method(@_);
35 1         7 $self->disable_sth_caching(1);
36 1         93 $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 9     9   10 my $self = shift;
47              
48 9         25 my ($sql, $bind) = $self->next::method(@_);
49              
50             # stringify bind args, quote via $dbh, and manually insert
51             #my ($op, $ident, $args) = @_;
52 9         14 my $ident = $_[1];
53              
54 9         23 my @sql_part = split /\?/, $sql;
55 9         9 my $new_sql;
56              
57 9         14 for (@$bind) {
58 9 50       17 my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify, array types are currently not supported
59              
60 9         9 my $datatype = $_->[0]{sqlt_datatype};
61              
62 9 50       30 $data = $self->_prep_interpolated_value($datatype, $data)
63             if $datatype;
64              
65 9 100 66     29 $data = $self->_get_dbh->quote($data)
66             unless ($datatype and $self->interpolate_unquoted($datatype, $data) );
67              
68 9         91 $new_sql .= shift(@sql_part) . $data;
69             }
70              
71 9         19 $new_sql .= join '', @sql_part;
72              
73 9         33 return ($new_sql, []);
74             }
75              
76             =head2 interpolate_unquoted
77              
78             This method is called by L 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:: 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 9 100 33 9 1 72 return 1 if (
      66        
      66        
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 7         36 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 9     9   12 return $_[2];
120             }
121              
122             =head1 FURTHER QUESTIONS?
123              
124             Check the list of L.
125              
126             =head1 COPYRIGHT AND LICENSE
127              
128             This module is free software L
129             by the L. You can
130             redistribute it and/or modify it under the same terms as the
131             L.
132              
133             =cut
134              
135             1;