From: Justin Hunter Date: Thu, 30 Apr 2009 21:05:24 +0000 (+0000) Subject: fixes for MSSQL via Sybase X-Git-Tag: v0.08103~118^2~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98464041fda64549ac43bb13393bf4f9a53e30cb;p=dbsrgits%2FDBIx-Class.git fixes for MSSQL via Sybase --- diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 84499ed..2fe0b83 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -8,10 +8,10 @@ use base qw/DBIx::Class::Storage::DBI::NoBindVars/; sub _rebless { my $self = shift; - my $dbh = $self->schema->storage->dbh; - my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]; - if ($DBMS_VERSION =~ /^Microsoft /i) { - my $subclass = 'DBIx::Class::Storage::DBI::Sybase::MSSQL'; + my $dbtype = eval { @{$self->_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] }; + unless ( $@ ) { + $dbtype =~ s/\W/_/gi; + my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}"; if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { bless $self, $subclass; $self->_rebless; diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm new file mode 100644 index 0000000..8a63ef9 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm @@ -0,0 +1,37 @@ +package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server; + +use strict; +use warnings; + +use base qw/DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server DBIx::Class::Storage::DBI::Sybase/; + +1; + +=head1 NAME + +DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Storage::DBI subclass for MSSQL via +DBD::Sybase + +=head1 SYNOPSIS + +This subclass supports MSSQL connected via L. + + $schema->storage_type('::DBI::Sybase::Microsoft_SQL_Server'); + $schema->connect_info('dbi:Sybase:....', ...); + +=head1 BUGS + +Currently, this doesn't work right unless you call C +after connecting. + +=head1 AUTHORS + +Brandon L Black + +Justin Hunter + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut diff --git a/t/74mssql.t b/t/74mssql.t index e50f32f..49f7967 100644 --- a/t/74mssql.t +++ b/t/74mssql.t @@ -7,20 +7,17 @@ use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/}; -#warn "$dsn $user $pass"; - plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test' unless ($dsn); plan tests => 6; - my $schema = DBICTest::Schema->clone; $schema->connection($dsn, $user, $pass); my $dbh = $schema->storage->dbh; -isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::Sybase::MSSQL'); +isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'); $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist");