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 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
  23 will 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 L<DBI> C<$dbi_type> via C<_dbi_data_type()>
  27 as defined in your Storage driver, the placeholder for this column will
  28 be converted to:
  29
  30   CAST(? as $dbi_type)
  31
  32 =cut
  33
  34 sub _prep_for_execute {
  35   my $self = shift;
  36   my ($op, $extra_bind, $ident, $args) = @_;
  37
  38   my ($sql, $bind) = $self->next::method (@_);
  39
  40 # If we're using ::NoBindVars, there are no binds by this point so this code
  41 # gets skippeed.
  42   if ($self->auto_cast && @$bind) {
  43     my $new_sql;
  44     my @sql_part = split /\?/, $sql;
  45     my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
  46
  47     foreach my $bound (@$bind) {
  48       my $col = $bound->[0];
  49       my $dbi_type = $self->_dbi_data_type($col_info->{$col}{data_type});
  50
  51       foreach my $data (@{$bound}[1..$#$bound]) {   # <--- this will multiply the amount of ?'s no...?
  52         $new_sql .= shift(@sql_part) .
  53           ($dbi_type ? "CAST(? AS $dbi_type)" : '?');
  54       }
  55     }
  56     $new_sql .= join '', @sql_part;
  57     $sql = $new_sql;
  58   }
  59
  60   return ($sql, $bind);
  61 }
  62
  63
  64 =head1 AUTHORS
  65
  66 See L<DBIx::Class/CONTRIBUTORS>
  67
  68 =head1 LICENSE
  69
  70 You may distribute this code under the same terms as Perl itself.
  71
  72 =cut
  73
  74 1;