minor changes
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / AutoCast.pm
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
13 DBIx::Class::Storage::DBI::AutoCast
14
15 =head1 SYNOPSIS
16
17   $schema->storage->auto_cast(1);
18
19 =head1 DESCRIPTION
20
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.
24
25 As long as a column L<data_type|DBIx::Class::ResultSource/add_columns> is
26 defined, and it resolves to a base RDBMS native type via L</_native_data_type> as
27 defined in your Storage driver, the placeholder for this column will be
28 converted to:
29
30   CAST(? as $mapped_type)
31
32 This option can also be enabled in L<DBIx::Class::Storage::DBI/connect_info> as:
33
34   on_connect_call => ['set_auto_cast']
35
36 =cut
37
38 sub _prep_for_execute {
39   my $self = shift;
40   my ($op, $extra_bind, $ident, $args) = @_;
41
42   my ($sql, $bind) = $self->next::method (@_);
43
44 # If we're using ::NoBindVars, there are no binds by this point so this code
45 # gets skippeed.
46   if ($self->auto_cast && @$bind) {
47     my $new_sql;
48     my @sql_part = split /\?/, $sql;
49     my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
50
51     foreach my $bound (@$bind) {
52       my $col = $bound->[0];
53       my $type = $self->_native_data_type($col_info->{$col}{data_type});
54
55       foreach my $data (@{$bound}[1..$#$bound]) {
56         $new_sql .= shift(@sql_part) .
57           ($type ? "CAST(? AS $type)" : '?');
58       }
59     }
60     $new_sql .= join '', @sql_part;
61     $sql = $new_sql;
62   }
63
64   return ($sql, $bind);
65 }
66
67 =head2 connect_call_set_auto_cast
68
69 Executes:
70
71   $schema->storage->auto_cast(1);
72
73 on connection.
74
75 Used as:
76
77     on_connect_call => ['set_auto_cast']
78
79 in L<DBIx::Class::Storage::DBI/connect_info>.
80
81 =cut
82
83 sub connect_call_set_auto_cast {
84   my $self = shift;
85   $self->auto_cast(1);
86 }
87
88 =head1 AUTHOR
89
90 See L<DBIx::Class/CONTRIBUTORS>
91
92 =head1 LICENSE
93
94 You may distribute this code under the same terms as Perl itself.
95
96 =cut
97
98 1;