Commit | Line | Data |
d047d650 |
1 | package DBIx::Class::Storage::DBI::AutoCast; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base qw/DBIx::Class::Storage::DBI/; |
7 | use mro 'c3'; |
8 | |
9 | __PACKAGE__->mk_group_accessors('simple' => 'auto_cast' ); |
10 | |
11 | =head1 NAME |
12 | |
d7d812cf |
13 | DBIx::Class::Storage::DBI::AutoCast - Storage component for RDBMS requiring explicit placeholder typing |
d047d650 |
14 | |
15 | =head1 SYNOPSIS |
16 | |
17 | $schema->storage->auto_cast(1); |
18 | |
19 | =head1 DESCRIPTION |
20 | |
ce012195 |
21 | In some combinations of RDBMS and DBD drivers (e.g. FreeTDS and Sybase) |
22 | statements with values bound to columns or conditions that are not strings will |
23 | throw implicit type conversion errors. |
d047d650 |
24 | |
25 | As long as a column L<data_type|DBIx::Class::ResultSource/add_columns> is |
48580715 |
26 | defined and resolves to a base RDBMS native type via L</_native_data_type> as |
ce012195 |
27 | defined in your Storage driver, the placeholder for this column will be |
28 | converted to: |
d047d650 |
29 | |
ce012195 |
30 | CAST(? as $mapped_type) |
d047d650 |
31 | |
8384a713 |
32 | This option can also be enabled in |
33 | L<connect_info|DBIx::Class::Storage::DBI/connect_info> as: |
d867eeda |
34 | |
35 | on_connect_call => ['set_auto_cast'] |
36 | |
d047d650 |
37 | =cut |
38 | |
39 | sub _prep_for_execute { |
40 | my $self = shift; |
41 | my ($op, $extra_bind, $ident, $args) = @_; |
42 | |
43 | my ($sql, $bind) = $self->next::method (@_); |
44 | |
45 | # If we're using ::NoBindVars, there are no binds by this point so this code |
46 | # gets skippeed. |
47 | if ($self->auto_cast && @$bind) { |
48 | my $new_sql; |
49 | my @sql_part = split /\?/, $sql; |
50 | my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]); |
51 | |
52 | foreach my $bound (@$bind) { |
53 | my $col = $bound->[0]; |
0bd2c1cd |
54 | my $type = $self->_native_data_type($col_info->{$col}{data_type}); |
d047d650 |
55 | |
a7741335 |
56 | foreach my $data (@{$bound}[1..$#$bound]) { |
d047d650 |
57 | $new_sql .= shift(@sql_part) . |
ce012195 |
58 | ($type ? "CAST(? AS $type)" : '?'); |
d047d650 |
59 | } |
60 | } |
61 | $new_sql .= join '', @sql_part; |
62 | $sql = $new_sql; |
63 | } |
64 | |
65 | return ($sql, $bind); |
66 | } |
67 | |
d867eeda |
68 | =head2 connect_call_set_auto_cast |
69 | |
70 | Executes: |
71 | |
72 | $schema->storage->auto_cast(1); |
73 | |
74 | on connection. |
75 | |
76 | Used as: |
77 | |
78 | on_connect_call => ['set_auto_cast'] |
79 | |
8384a713 |
80 | in L<connect_info|DBIx::Class::Storage::DBI/connect_info>. |
d867eeda |
81 | |
82 | =cut |
83 | |
84 | sub connect_call_set_auto_cast { |
85 | my $self = shift; |
86 | $self->auto_cast(1); |
87 | } |
d047d650 |
88 | |
07a5866e |
89 | =head1 AUTHOR |
d047d650 |
90 | |
91 | See L<DBIx::Class/CONTRIBUTORS> |
92 | |
93 | =head1 LICENSE |
94 | |
95 | You may distribute this code under the same terms as Perl itself. |
96 | |
97 | =cut |
98 | |
99 | 1; |