[Bast-commits] r7727 - in
DBIx-Class/0.08/branches/sybase_bulkinsert_support:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Thu Sep 24 12:45:04 GMT 2009
Author: caelum
Date: 2009-09-24 12:45:04 +0000 (Thu, 24 Sep 2009)
New Revision: 7727
Modified:
DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase_bulkinsert_support/t/746sybase.t
Log:
remove some duplicate code
Modified: DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-24 09:21:18 UTC (rev 7726)
+++ DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-24 12:45:04 UTC (rev 7727)
@@ -510,7 +510,7 @@
$source->columns;
my $is_identity_insert = (List::Util::first
- { $source->column_info ($_)->{is_auto_increment} }
+ { $_ eq $identity_col }
@{$cols}
) ? 1 : 0;
@@ -525,7 +525,7 @@
(not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) {
carp <<'EOF';
Bulk API support disabled due to use of a CODEREF connect_info. Reverting to
-array inserts.
+regular array inserts.
EOF
$self->_bulk_disabled_due_to_coderef_connect_info_warned(1);
}
@@ -647,43 +647,15 @@
}
);
- my $bind_attributes = $self->source_bind_attributes($source);
+ my @bind = do {
+ my $idx = 0;
+ map [ $_, $idx++ ], @source_columns;
+ };
- foreach my $slice_idx (0..$#source_columns) {
- my $col = $source_columns[$slice_idx];
+ $self->_execute_array(
+ $source, $sth, \@bind, \@source_columns, \@new_data, $guard
+ );
- 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);
-
-# 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);
-
- $self->throw_exception(sprintf "%s for populate slice:\n%s",
- ($tuple_status->[$i][1] || $err),
- $self->_pretty_print ({
- map { $source_columns[$_] => $new_data[$i][$_] } (0 .. $#$cols)
- }),
- );
- }
-
- $guard->commit;
- $sth->finish;
-
$bulk->_query_end($sql);
};
my $exception = $@;
@@ -720,7 +692,7 @@
my %blob_cols;
for my $col (keys %$fields) {
- if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
+ if ($self->_is_lob_column($source, $col)) {
my $blob_val = delete $fields->{$col};
if (not defined $blob_val) {
$fields->{$col} = \'NULL';
@@ -744,7 +716,7 @@
for my $i (0..$#$cols) {
my $col = $cols->[$i];
- if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
+ if ($self->_is_lob_column($source, $col)) {
for my $j (0..$#$data) {
my $blob_val = delete $data->[$j][$i];
if (not defined $blob_val) {
Modified: DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI.pm 2009-09-24 09:21:18 UTC (rev 7726)
+++ DBIx-Class/0.08/branches/sybase_bulkinsert_support/lib/DBIx/Class/Storage/DBI.pm 2009-09-24 12:45:04 UTC (rev 7727)
@@ -1346,7 +1346,7 @@
my %colvalues;
@colvalues{@$cols} = (0..$#$cols);
- # bind literal sql if it's the same in all slices
+ # pass scalarref to SQLA for literal sql if it's the same in all slices
for my $i (0..$#$cols) {
my $first_val = $data->[0][$i];
next unless (Scalar::Util::reftype($first_val)||'') eq 'SCALAR';
@@ -1374,24 +1374,25 @@
$self->_query_start( $sql, @bind );
my $sth = $self->sth($sql, 'insert', $sth_attr);
- if ($empty_bind) {
- # bind_param_array doesn't work if there are no binds
- eval {
- local $self->_get_dbh->{RaiseError} = 1;
- local $self->_get_dbh->{PrintError} = 0;
- foreach (0..$#$data) {
- $sth->execute;
- $sth->fetchall_arrayref;
- }
- };
- my $exception = $@;
- $sth->finish;
- $self->throw_exception($exception) if $exception;
- return;
- }
+ my $rv = do {
+ if ($empty_bind) {
+ # bind_param_array doesn't work if there are no binds
+ $self->_execute_array_empty( $sth, scalar @$data );
+ }
+ else {
+# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+ $self->_execute_array( $source, $sth, \@bind, $cols, $data );
+ }
+ };
-# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+ $self->_query_end( $sql, @bind );
+ return (wantarray ? ($rv, $sth, @bind) : $rv);
+}
+
+sub _execute_array {
+ my ($self, $source, $sth, $bind, $cols, $data, $guard) = @_;
+
## This must be an arrayref, else nothing works!
my $tuple_status = [];
@@ -1401,7 +1402,7 @@
## Bind the values and execute
my $placeholder_index = 1;
- foreach my $bound (@bind) {
+ foreach my $bound (@$bind) {
my $attributes = {};
my ($column_name, $data_index) = @$bound;
@@ -1418,7 +1419,11 @@
}
my $rv = eval { $sth->execute_array({ArrayTupleStatus => $tuple_status}) };
+
+ $guard->commit if $guard; # probably only needed for Sybase
+
$sth->finish;
+
if (my $err = $@ || $sth->errstr) {
my $i = 0;
++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
@@ -1434,10 +1439,29 @@
);
}
- $self->_query_end( $sql, @bind );
- return (wantarray ? ($rv, $sth, @bind) : $rv);
+ return $rv;
}
+sub _execute_array_empty {
+ my ($self, $sth, $count) = @_;
+ eval {
+ my $dbh = $self->_get_dbh;
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ foreach (1..$count) {
+ $sth->execute;
+# In case of a multi-statement with a select, some DBDs (namely Sybase) require
+# the cursor to be exhausted.
+ $sth->fetchall_arrayref;
+ }
+ };
+ my $exception = $@;
+ $sth->finish;
+ $self->throw_exception($exception) if $exception;
+
+ return $count;
+}
+
sub update {
my ($self, $source, @args) = @_;
Modified: DBIx-Class/0.08/branches/sybase_bulkinsert_support/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase_bulkinsert_support/t/746sybase.t 2009-09-24 09:21:18 UTC (rev 7726)
+++ DBIx-Class/0.08/branches/sybase_bulkinsert_support/t/746sybase.t 2009-09-24 12:45:04 UTC (rev 7727)
@@ -12,7 +12,7 @@
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
-my $TESTS = 58 + 2;
+my $TESTS = 62 + 2;
if (not ($dsn && $user)) {
plan skip_all =>
@@ -336,7 +336,7 @@
# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
SKIP: {
- skip 'TEXT/IMAGE support does not work with FreeTDS', 18
+ skip 'TEXT/IMAGE support does not work with FreeTDS', 22
if $schema->storage->using_freetds;
my $dbh = $schema->storage->_dbh;
@@ -434,7 +434,7 @@
$rs->delete;
- # now try insert_bulk with blobs
+ # now try insert_bulk with blobs and only blobs
$new_str = $binstr{large} . 'bar';
lives_ok {
$rs->populate([
@@ -457,6 +457,41 @@
is((grep $_->clob eq $new_str, $rs->all), 2,
'TEXT column set correctly via insert_bulk');
+ # now try insert_bulk with blobs and a non-blob which also happens to be an
+ # identity column
+ SKIP: {
+ skip 'no insert_bulk without placeholders', 4
+ if $storage_type =~ /NoBindVars/i;
+
+ $rs->delete;
+ $new_str = $binstr{large} . 'bar';
+ lives_ok {
+ $rs->populate([
+ {
+ id => 1,
+ bytea => 1,
+ blob => $binstr{large},
+ clob => $new_str,
+ },
+ {
+ id => 2,
+ bytea => 1,
+ blob => $binstr{large},
+ clob => $new_str,
+ },
+ ]);
+ } 'insert_bulk with blobs and explicit identity DOES not die';
+
+ is((grep $_->blob eq $binstr{large}, $rs->all), 2,
+ 'IMAGE column set correctly via insert_bulk with identity');
+
+ is((grep $_->clob eq $new_str, $rs->all), 2,
+ 'TEXT column set correctly via insert_bulk with identity');
+
+ is_deeply [ map $_->id, $rs->all ], [ 1,2 ],
+ 'explicit identities set correctly via insert_bulk with blobs';
+ }
+
lives_and {
$rs->delete;
$rs->create({ blob => $binstr{large} }) for (1..2);
More information about the Bast-commits
mailing list