use execute_array for insert_bulk, test insert_bulk with blobs, clean up blob tests...

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index ed79308..5f63e28 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1376,7 +1376,7 @@ sub insert_bulk {
     my $i = 0;
     ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
 
-    $self->throw_exception($sth->errstr || "Unexpected populate error: $err")
+    $self->throw_exception("Unexpected populate error: $err")
       if ($i > $#$tuple_status);
 
     require Data::Dumper;
@@ -1387,16 +1387,14 @@ sub insert_bulk {
     local $Data::Dumper::Sortkeys = 1;
 
     $self->throw_exception(sprintf "%s for populate slice:\n%s",
-      $tuple_status->[$i][1],
+      ($tuple_status->[$i][1] || $err),
       Data::Dumper::Dumper(
         { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) }
       ),
     );
   }
-  $self->throw_exception($sth->errstr) if !$rv;
 
   $sth->finish;
-
   $self->_query_end( $sql, @bind );
   return (wantarray ? ($rv, $sth, @bind) : $rv);
 }

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index b3f8c4b..c68f21f 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -575,11 +575,45 @@ EOF
       }
     );
 
+    my $bind_attributes = $self->source_bind_attributes($source);
+
+    foreach my $slice_idx (0..$#source_columns) {
+      my $col = $source_columns[$slice_idx];
+
+      my $attributes = $bind_attributes->{$col}
+        if $bind_attributes && defined $bind_attributes->{$col};
+
+      my @slice = map $_->[$slice_idx], @new_data;
+
+      $sth->bind_param_array(($slice_idx + 1), \@slice, $attributes);
+    }
+
     $bulk->_query_start($sql);
 
-    for my $datum (@new_data) {
-      $sth->execute(@$datum);
-      die $sth->errstr if $sth->errstr; # just in case
+# this is stolen from DBI::insert_bulk
+    my $tuple_status = [];
+    my $rv = eval { $sth->execute_array({ArrayTupleStatus => $tuple_status}) };
+
+    if (my $err = $@ || $sth->errstr) {
+      my $i = 0;
+      ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
+
+      $self->throw_exception("Unexpected populate error: $err")
+        if ($i > $#$tuple_status);
+
+      require Data::Dumper;
+      local $Data::Dumper::Terse = 1;
+      local $Data::Dumper::Indent = 1;
+      local $Data::Dumper::Useqq = 1;
+      local $Data::Dumper::Quotekeys = 0;
+      local $Data::Dumper::Sortkeys = 1;
+
+      $self->throw_exception(sprintf "%s for populate slice:\n%s",
+        ($tuple_status->[$i][1] || $err),
+        Data::Dumper::Dumper(
+          { map { $source_columns[$_] => $new_data[$i][$_] } (0 .. $#$cols) }
+        ),
+      );
     }
 
     $guard->commit;
@@ -607,7 +641,7 @@ EOF
     DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 # rollback makes the bulkLogin connection unusable
     $self->_bulk_storage->disconnect;
-    $self->throw_exception($exception) if $exception;
+    $self->throw_exception($exception);
   }
 
   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
@@ -970,6 +1004,9 @@ calls in your C<Result> classes B<must> list columns in database order for this
 to work. Also, you may have to unset the C<LANG> environment variable before
 loading your app, if it doesn't match the character set of your database.
 
+When inserting IMAGE columns using this method, you'll need to use
+L</connect_call_blob_setup> as well.
+
 =head1 AUTHOR
 
 See L<DBIx::Class/CONTRIBUTORS>.

diff --git a/t/746sybase.t b/t/746sybase.t
index 59b7178..92b6818 100644 (file)
--- a/t/746sybase.t
+++ b/t/746sybase.t
@@ -11,7 +11,7 @@ use DBIx::Class::Storage::DBI::Sybase::NoBindVars;
 
 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
 
-my $TESTS = 52 + 2;
+my $TESTS = 55 + 2;
 
 if (not ($dsn && $user)) {
   plan skip_all =>
@@ -304,7 +304,7 @@ SQL
 
 # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
   SKIP: {
-    skip 'TEXT/IMAGE support does not work with FreeTDS', 13
+    skip 'TEXT/IMAGE support does not work with FreeTDS', 16
       if $schema->storage->using_freetds;
 
     my $dbh = $schema->storage->_dbh;
@@ -341,45 +341,30 @@ SQL
       foreach my $size (qw(small large)) {
         no warnings 'uninitialized';
 
-        my $created = eval { $rs->create( { $type => $binstr{$size} } ) };
-        ok(!$@, "inserted $size $type without dying");
-        diag $@ if $@;
+        my $created;
+        lives_ok {
+          $created = $rs->create( { $type => $binstr{$size} } )
+        } "inserted $size $type without dying";
 
         $last_id = $created->id if $created;
 
-        my $got = eval {
-          $rs->find($last_id)->$type
-        };
-        diag $@ if $@;
-        ok($got eq $binstr{$size}, "verified inserted $size $type");
+        lives_and {
+          ok($rs->find($last_id)->$type eq $binstr{$size})
+        } "verified inserted $size $type";
       }
     }
 
+    $rs->delete;
+
     # blob insert with explicit PK
     # also a good opportunity to test IDENTITY_INSERT
-    {
-      local $SIG{__WARN__} = sub {};
-      eval { $dbh->do('DROP TABLE bindtype_test') };
-
-      $dbh->do(qq[
-        CREATE TABLE bindtype_test 
-        (
-          id    INT   IDENTITY PRIMARY KEY,
-          bytea INT   NULL,
-          blob  IMAGE NULL,
-          clob  TEXT  NULL
-        )
-      ],{ RaiseError => 1, PrintError => 0 });
-    }
-    my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) };
-    ok(!$@, "inserted large blob without dying with manual PK");
-    diag $@ if $@;
+    lives_ok {
+      $rs->create( { id => 1, blob => $binstr{large} } )
+    } 'inserted large blob without dying with manual PK';
 
-    my $got = eval {
-      $rs->find(1)->blob
-    };
-    diag $@ if $@;
-    ok($got eq $binstr{large}, "verified inserted large blob with manual PK");
+    lives_and {
+      ok($rs->find(1)->blob eq $binstr{large})
+    } 'verified inserted large blob with manual PK';
 
     # try a blob update
     my $new_str = $binstr{large} . 'mtfnpy';
@@ -390,22 +375,48 @@ SQL
       $schema = get_schema();
     }
 
-    eval { $rs->search({ id => 1 })->update({ blob => $new_str }) };
-    ok !$@, 'updated blob successfully';
-    diag $@ if $@;
-    $got = eval {
-      $rs->find(1)->blob
-    };
-    diag $@ if $@;
-    ok($got eq $new_str, "verified updated blob");
+    lives_ok {
+      $rs->search({ id => 1 })->update({ blob => $new_str })
+    } 'updated blob successfully';
+
+    lives_and {
+      ok($rs->find(1)->blob eq $new_str)
+    } 'verified updated blob';
 
     ## try multi-row blob update
     # first insert some blobs
-    $rs->find(1)->delete;
-    $rs->create({ blob => $binstr{large} }) for (1..3);
     $new_str = $binstr{large} . 'foo';
-    $rs->update({ blob => $new_str });
-    is((grep $_->blob eq $new_str, $rs->all), 3, 'multi-row blob update');
+    lives_and {
+      $rs->delete;
+      $rs->create({ blob => $binstr{large} }) for (1..2);
+      $rs->update({ blob => $new_str });
+      is((grep $_->blob eq $new_str, $rs->all), 2);
+    } 'multi-row blob update';
+
+    $rs->delete;
+
+    # now try insert_bulk with blobs
+    $new_str = $binstr{large} . 'bar';
+    lives_ok {
+      $rs->populate([
+        {
+          bytea => 1,
+          blob => $binstr{large},
+          clob => $new_str,
+        },
+        {
+          bytea => 1,
+          blob => $binstr{large},
+          clob => $new_str,
+        },
+      ]);
+    } 'insert_bulk with blobs does not die';
+
+    is((grep $_->blob eq $binstr{large}, $rs->all), 2,
+      'IMAGE column set correctly via insert_bulk');
+
+    is((grep $_->clob eq $new_str, $rs->all), 2,
+      'TEXT column set correctly via insert_bulk');
   }
 
 # test MONEY column support