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