X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FODBC.pm;h=1e8851b20bcd715c4a7608f9483469663f7648dc;hb=b1dbf7164ee06fa23aef5a799dd57df0357514ba;hp=f8e92098ac425b9260bc110fbca8dae102d82b79;hpb=243d702ea2d1350e9c08d52eb84cdde745913452;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm index f8e9209..1e8851b 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm @@ -1,24 +1,53 @@ package DBIx::Class::Storage::DBI::ODBC; use strict; use warnings; - use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; -sub _rebless { - my ($self) = @_; +use DBIx::Class::_Util 'modver_gt_or_eq'; +use namespace::clean; + +sub _rebless { shift->_determine_connector_driver('ODBC') } + +# Whether or not we are connecting via the freetds ODBC driver +sub _using_freetds { + my $self = shift; - my $dbtype = eval { $self->_get_dbh->get_info(17) }; + my $dsn = $self->_dbi_connect_info->[0]; + + return 1 if ( + ( (! ref $dsn) and $dsn =~ /driver=FreeTDS/i) + or + ( ($self->_dbh_get_info('SQL_DRIVER_NAME')||'') =~ /tdsodbc/i ) + ); + + return 0; +} - unless ( $@ ) { - # Translate the backend name into a perl identifier - $dbtype =~ s/\W/_/gi; - my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}"; - if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { - bless $self, $subclass; - $self->_rebless; - } +# Either returns the FreeTDS version via which we are connecting, 0 if can't +# be determined, or undef otherwise +sub _using_freetds_version { + my $self = shift; + return undef unless $self->_using_freetds; + return $self->_dbh_get_info('SQL_DRIVER_VER') || 0; +} + +sub _disable_odbc_array_ops { + my $self = shift; + my $dbh = $self->_get_dbh; + + $DBD::ODBC::__DBIC_DISABLE_ARRAY_OPS_VIA__ ||= [ do { + if( modver_gt_or_eq('DBD::ODBC', '1.35_01') ) { + odbc_array_operations => 0; } + elsif( modver_gt_or_eq('DBD::ODBC', '1.33_01') ) { + odbc_disable_array_operations => 1; + } + }]; + + if (my ($k, $v) = @$DBD::ODBC::__DBIC_DISABLE_ARRAY_OPS_VIA__) { + $dbh->{$k} = $v; + } } 1; @@ -32,12 +61,13 @@ DBIx::Class::Storage::DBI::ODBC - Base class for ODBC drivers This class simply provides a mechanism for discovering and loading a sub-class for a specific ODBC backend. It should be transparent to the user. -=head1 AUTHORS +=head1 AUTHOR -Marc Mims C<< >> +See L and L. =head1 LICENSE You may distribute this code under the same terms as Perl itself. =cut +# vim:sts=2 sw=2: