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