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=0a768c9067712d4f9512748c315c617367fe8dc4;hp=98ca586eb7f3de8a15e2cd159881fe01d72640b4;hpb=ed7ab0f4ce1a9118ea6285ee562ef003085a6b64;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm index 98ca586..1e8851b 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm @@ -1,28 +1,53 @@ package DBIx::Class::Storage::DBI::ODBC; use strict; use warnings; - use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; -use Try::Tiny; - -sub _rebless { - my ($self) = @_; - - my $caught; - my $dbtype; - try { $self->_get_dbh->get_info(17) } - catch { $caught = 1 }; - - unless ( $caught ) { - # 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; - } + +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 $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; +} + +# 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; @@ -36,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: