From: Rafael Kitover <rkitover@cpan.org>
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<DBD::ADO>.
+
+=head1 DESCRIPTION
+
+The MSSQL specific functionality is provided by
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+C<_identity_method> is set to C<@@identity>, as C<SCOPE_IDENTITY()> doesn't work
+with L<DBD::ADO>. See L<DBIx::Class::Storage::DBI::MSSQL/IMPLEMENTATION NOTES>
+for caveats regarding this.
+
+=head1 AUTHOR
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=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