From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 9 Dec 2009 17:13:33 +0000 (+0000)
Subject: workaround for evil ADO bug
X-Git-Tag: v0.08116~104
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8bcd9ece59ed15506918847950e64f8b44815fa8;p=dbsrgits%2FDBIx-Class.git

workaround for evil ADO bug
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 1288c47..f7a9955 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1290,6 +1290,12 @@ sub _query_end {
     }
 }
 
+sub _sth_bind_param {
+  my ($self, $sth, $placeholder_index, $data, $attributes) = @_;
+
+  $sth->bind_param($placeholder_index, $data, $attributes);
+}
+
 sub _dbh_execute {
   my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
 
@@ -1314,7 +1320,7 @@ sub _dbh_execute {
       my $ref = ref $data;
       $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs)
 
-      $sth->bind_param($placeholder_index, $data, $attributes);
+      $self->_sth_bind_param($sth, $placeholder_index, $data, $attributes);
       $placeholder_index++;
     }
   }
diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
index e375b2c..b4bb2e9 100644
--- a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
@@ -14,6 +14,14 @@ sub _rebless {
   $self->_identity_method('@@identity');
 }
 
+sub _sth_bind_param {
+  my ($self, $sth, $placeholder_index, $data, $attributes, @extra) = @_;
+
+  $attributes->{ado_size} = 8000; # max VARCHAR on MSSQL
+
+  $self->next::method($sth, $placeholder_index, $data, $attributes, @extra);
+}
+
 1;
 
 =head1 NAME
diff --git a/t/747mssql_ado.t b/t/747mssql_ado.t
index 7981c78..fd847bd 100644
--- a/t/747mssql_ado.t
+++ b/t/747mssql_ado.t
@@ -11,8 +11,6 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PAS
 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test'
   unless ($dsn && $user);
 
-plan tests => 12;
-
 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 $schema->storage->ensure_connected;
 
@@ -48,7 +46,7 @@ is $found->artistid, $new->artistid, 'select with big column list';
 is $found->get_column('foo_50'), 'foo', 'last item in big column list';
 
 # create a few more rows
-for (1..6) {
+for (1..12) {
   $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
 }
 
@@ -60,6 +58,17 @@ while ($rs1->next) {
   ok eval { $rs2->next }, 'multiple active cursors';
 }
 
+# test bug where ADO blows up if the first bindparam is shorter than the second
+is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
+  'Artist 1',
+  'short bindparam';
+
+is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
+  'Artist 12',
+  'longer bindparam';
+
+done_testing;
+
 # clean up our mess
 END {
   if (my $dbh = eval { $schema->storage->_dbh }) {