File Coverage

blib/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
Criterion Covered Total %
statement 35 35 100.0
branch 6 8 75.0
condition 7 12 58.3
subroutine 9 9 100.0
pod 2 2 100.0
total 59 66 89.3


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