[Bast-commits] r8055 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI/ADO t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-12-09 17:13:33 +0000 (Wed, 09 Dec 2009)
New Revision: 8055

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
   DBIx-Class/0.08/trunk/t/747mssql_ado.t
Log:
workaround for evil ADO bug

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm	2009-12-09 15:12:56 UTC (rev 8054)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm	2009-12-09 17:13:33 UTC (rev 8055)
@@ -14,6 +14,14 @@
   $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

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2009-12-09 15:12:56 UTC (rev 8054)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2009-12-09 17:13:33 UTC (rev 8055)
@@ -1290,6 +1290,12 @@
     }
 }
 
+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 @@
       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++;
     }
   }

Modified: DBIx-Class/0.08/trunk/t/747mssql_ado.t
===================================================================
--- DBIx-Class/0.08/trunk/t/747mssql_ado.t	2009-12-09 15:12:56 UTC (rev 8054)
+++ DBIx-Class/0.08/trunk/t/747mssql_ado.t	2009-12-09 17:13:33 UTC (rev 8055)
@@ -11,8 +11,6 @@
 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->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 @@
   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 }) {