From: Rafael Kitover Date: Fri, 21 Aug 2009 04:32:14 +0000 (+0000) Subject: something apparently working X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ffa57005fd6e9ecadbfc11157686e8d770e0df6;p=dbsrgits%2FDBIx-Class-Historic.git something apparently working --- diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm new file mode 100644 index 0000000..8a0fa68 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/ADO.pm @@ -0,0 +1,42 @@ +package # hide from PAUSE + DBIx::Class::Storage::DBI::ADO; + +use base 'DBIx::Class::Storage::DBI'; + +sub _rebless { + my $self = shift; + +# check for MSSQL +# XXX This should be using an OpenSchema method of some sort, but I don't know +# how. +# Current version is stolen from Sybase.pm + my $dbtype = eval { + @{$self->_get_dbh + ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1}) + }[2] + }; + + unless ($@) { + $dbtype =~ s/\W/_/gi; + my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}"; + if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { + bless $self, $subclass; + $self->_rebless; + } + } +} + +# set cursor type here, if necessary +#sub _dbh_sth { +# my ($self, $dbh, $sql) = @_; +# +# my $sth = $self->disable_sth_caching +# ? $dbh->prepare($sql, { CursorType => 'adOpenStatic' }) +# : $dbh->prepare_cached($sql, { CursorType => 'adOpenStatic' }, 3); +# +# $self->throw_exception($dbh->errstr) if !$sth; +# +# $sth; +#} + +1; diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm new file mode 100644 index 0000000..4082a93 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm @@ -0,0 +1,45 @@ +package DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server; + +use strict; +use warnings; + +use base qw/ + DBIx::Class::Storage::DBI::ADO + DBIx::Class::Storage::DBI::MSSQL +/; +use mro 'c3'; + +sub _rebless { + my $self = shift; + $self->_identity_method('@@identity'); +} + +1; + +=head1 NAME + +DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Support for Microsoft +SQL Server via DBD::ADO + +=head1 SYNOPSIS + +This subclass supports MSSQL server connections via L. + +=head1 DESCRIPTION + +The MSSQL specific functionality is provided by +L. + +C<_identity_method> is set to C<@@identity>, as C doesn't work +with L. See L +for caveats regarding this. + +=head1 AUTHOR + +See L. + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index b0da553..085d6d0 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -122,7 +122,7 @@ sub _execute { # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked # on in _prep_for_execute above - my ($identity) = $sth->fetchrow_array; + my ($identity) = eval { $sth->fetchrow_array }; # SCOPE_IDENTITY failed, but we can do something else if ( (! $identity) && $self->_identity_method) { diff --git a/t/747mssql_ado.t b/t/747mssql_ado.t new file mode 100644 index 0000000..bcd218e --- /dev/null +++ b/t/747mssql_ado.t @@ -0,0 +1,62 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; + +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/}; + +plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test' + unless ($dsn && $user); + +plan tests => 10; + +my $schema = DBICTest::Schema->connect($dsn, $user, $pass); +$schema->storage->ensure_connected; + +isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server' ); + +$schema->storage->dbh_do (sub { + my ($storage, $dbh) = @_; + eval { $dbh->do("DROP TABLE artist") }; + $dbh->do(<<'SQL'); +CREATE TABLE artist ( + artistid INT IDENTITY NOT NULL, + name VARCHAR(100), + rank INT NOT NULL DEFAULT '13', + charfield CHAR(10) NULL, + primary key(artistid) +) +SQL +}); + +my $new = $schema->resultset('Artist')->create({ name => 'foo' }); +ok($new->artistid > 0, 'Auto-PK worked'); + +# make sure select works +my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first; +is $found->artistid, $new->artistid, 'search works'; + +# create a few more rows +for (1..6) { + $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); +} + +# test multiple active cursors +my $rs1 = $schema->resultset('Artist'); +my $rs2 = $schema->resultset('Artist'); + +while ($rs1->next) { + ok eval { $rs2->next }, 'multiple active cursors'; +} + +# clean up our mess +END { + if (my $dbh = eval { $schema->storage->_dbh }) { + eval { $dbh->do("DROP TABLE $_") } + for qw/artist/; + } +} +# vim:sw=2 sts=2