lib/DBIx/Class/Storage/DBI/ODBC.pm

   1 package DBIx::Class::Storage::DBI::ODBC;
   2 use strict;
   3 use warnings;
   4 use base qw/DBIx::Class::Storage::DBI/;
   5 use mro 'c3';
   6
   7 sub _rebless {
   8   my ($self) = @_;
   9
  10   if (my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME')) {
  11     # Translate the backend name into a perl identifier
  12     $dbtype =~ s/\W/_/gi;
  13     my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
  14
  15     return if $self->isa($subclass);
  16
  17     if ($self->load_optional_class($subclass)) {
  18       bless $self, $subclass;
  19       $self->_rebless;
  20     }
  21     else {
  22       warn "Expected driver '$subclass' not found, using generic support. " .
  23            "Please file an RT.\n";
  24     }
  25   }
  26   else {
  27     warn "Could not determine your database type, using generic support.\n";
  28   }
  29 }
  30
  31 # Whether or not we are connecting via the freetds ODBC driver.
  32 sub _using_freetds {
  33   my $self = shift;
  34
  35   my $dsn = $self->_dbi_connect_info->[0];
  36
  37   return 1 if (
  38     ( (! ref $dsn) and $dsn =~ /driver=FreeTDS/i)
  39       or
  40     ( ($self->_dbh_get_info('SQL_DRIVER_NAME')||'') =~ /tdsodbc/i )
  41   );
  42
  43   return 0;
  44 }
  45
  46 # Either returns the FreeTDS version via which we are connecting, 0 if can't
  47 # be determined, or undef otherwise
  48 sub _using_freetds_version {
  49   my $self = shift;
  50   return undef unless $self->_using_freetds;
  51   return $self->_dbh_get_info('SQL_DRIVER_VER') || 0;
  52 }
  53
  54 sub _disable_odbc_array_ops {
  55   my $self = shift;
  56   my $dbh  = $self->_get_dbh;
  57
  58   if (eval { DBD::ODBC->VERSION('1.35_01') }) {
  59     $dbh->{odbc_array_operations} = 0;
  60   }
  61   elsif (eval { DBD::ODBC->VERSION('1.33_01') }) {
  62     $dbh->{odbc_disable_array_operations} = 1;
  63   }
  64 }
  65
  66 1;
  67
  68 =head1 NAME
  69
  70 DBIx::Class::Storage::DBI::ODBC - Base class for ODBC drivers
  71
  72 =head1 DESCRIPTION
  73
  74 This class simply provides a mechanism for discovering and loading a sub-class
  75 for a specific ODBC backend.  It should be transparent to the user.
  76
  77 =head1 AUTHOR
  78
  79 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
  80
  81 =head1 LICENSE
  82
  83 You may distribute this code under the same terms as Perl itself.
  84
  85 =cut
  86 # vim:sts=2 sw=2: