[Bast-commits] r7665 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Wed Sep 16 13:06:36 GMT 2009
Author: caelum
Date: 2009-09-16 13:06:35 +0000 (Wed, 16 Sep 2009)
New Revision: 7665
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
use execute_array for insert_bulk, test insert_bulk with blobs, clean up blob tests a bit
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-15 20:55:15 UTC (rev 7664)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-16 13:06:35 UTC (rev 7665)
@@ -575,11 +575,45 @@
}
);
+ 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 @@
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 @@
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>.
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-09-15 20:55:15 UTC (rev 7664)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-09-16 13:06:35 UTC (rev 7665)
@@ -1376,7 +1376,7 @@
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 @@
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);
}
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-09-15 20:55:15 UTC (rev 7664)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-09-16 13:06:35 UTC (rev 7665)
@@ -11,7 +11,7 @@
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 @@
# 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,46 +341,31 @@
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') };
+ lives_ok {
+ $rs->create( { id => 1, blob => $binstr{large} } )
+ } 'inserted large blob without dying with manual PK';
- $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_and {
+ ok($rs->find(1)->blob eq $binstr{large})
+ } 'verified inserted large blob with manual PK';
- my $got = eval {
- $rs->find(1)->blob
- };
- diag $@ if $@;
- ok($got eq $binstr{large}, "verified inserted large blob with manual PK");
-
# try a blob update
my $new_str = $binstr{large} . 'mtfnpy';
@@ -390,22 +375,48 @@
$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
More information about the Bast-commits
mailing list