From: John Napiorkowski Date: Wed, 13 Dec 2006 01:04:55 +0000 (+0000) Subject: updated bulk insert to handle bind_param_array, created some basic tests X-Git-Tag: v0.08010~150^2~106^2~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9fdf90df36ee55e3b16dacd82ad35b12c9d4e15a;p=dbsrgits%2FDBIx-Class.git updated bulk insert to handle bind_param_array, created some basic tests --- diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index cdb585c..c97caf2 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -818,7 +818,7 @@ sub populate { } return @created; } - $self->storage->insert_bulk($self->source($name)->from, \@names, $data); + $self->storage->insert_bulk($self->source($name), \@names, $data); } =head2 exception_action diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index dfb5748..5b2cfaa 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -896,16 +896,14 @@ sub insert { ## scalar refs, or at least, all the same type as the first set, the statement is ## only prepped once. sub insert_bulk { - my ($self, $table, $cols, $data) = @_; + my ($self, $source, $cols, $data) = @_; my %colvalues; + my $table = $source->from; @colvalues{@$cols} = (0..$#$cols); my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues); - ##need this to support using bindtype=>columns for sql abstract - @bind = map {$_->[1]} @bind; - if ($self->debug) { - my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind; + my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind; $self->debugobj->query_start($sql, @debug_bind); } my $sth = $self->sth($sql); @@ -913,16 +911,72 @@ sub insert_bulk { # @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args my $rv; + ## This must be an arrayref, else nothing works! + my $tuple_status = []; -# use Data::Dumper; -# print STDERR Dumper($data); + + ##use Data::Dumper; + ##print STDERR Dumper( $data, $sql, [@bind] ); + if ($sth) { + my $time = time(); - $rv = eval { $sth->execute_array({ ArrayTupleFetch => sub { my $values = shift @$data; return if !$values; return [ @{$values}[@bind] ]}, - ArrayTupleStatus => $tuple_status }) }; -# print STDERR Dumper($tuple_status); -# print STDERR "RV: $rv\n"; + + #$rv = eval { + # + # $sth->execute_array({ + + # ArrayTupleFetch => sub { + + # my $values = shift @$data; + # return if !$values; + # return [ @{$values}[@bind] ]; + # }, + + # ArrayTupleStatus => $tuple_status, + # }) + #}; + + ## Get the bind_attributes, if any exist + + my $bind_attributes; + foreach my $column ($source->columns) { + + my $data_type = $source->column_info($column)->{data_type} || ''; + + $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type) + if $data_type; + } + + ## Bind the values and execute + + $rv = eval { + + my $placeholder_index = 1; + + foreach my $bound (@bind) { + + my $attributes = {}; + my ($column_name, $data_index) = @$bound; + + if( $bind_attributes ) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } + + my @data = map { $_->[$data_index] } @$data; + + $sth->bind_param_array( $placeholder_index, [@data], $attributes ); + $placeholder_index++; + } + $sth->execute_array( {ArrayTupleStatus => $tuple_status} ); + + }; + +#print STDERR Dumper($tuple_status); +#print STDERR "RV: $rv\n"; + if ($@ || !defined $rv) { my $errors = ''; foreach my $tuple (@$tuple_status) diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 8500767..1572938 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -63,7 +63,7 @@ sub bind_attribute_by_data_type { }; if( defined $bind_attributes->{$data_type} ) { - return $bind_attributes->{$data_type} + return $bind_attributes->{$data_type}; } else { return; diff --git a/t/bindtype_columns.t b/t/bindtype_columns.t index d88815d..2d9bffe 100644 --- a/t/bindtype_columns.t +++ b/t/bindtype_columns.t @@ -5,23 +5,60 @@ use Test::More; use lib qw(t/lib); use DBICTest; -my $schema = DBICTest->init_schema(); +my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; -plan tests => 2; +$dsn = 'dbi:Pg:dbname=postgres;host=localhost' unless $dsn; +$dbuser = 'postgres' unless $dbuser; +$dbpass = 'postgres' unless $dbpass; -#Bindtest -{ - my $new = $schema->resultset("Artist")->new({ - - artistid=>25, - name=>'JohnNapiorkowski', - }); - - $new->update_or_insert; +plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test' + unless ($dsn && $dbuser); + +plan tests => 3; + +DBICTest::Schema->compose_connection('PGTest' => $dsn, $dbuser, $dbpass); + +my $dbh = PGTest->schema->storage->dbh; + +$dbh->do(qq[ + + CREATE TABLE artist + ( + artistid serial NOT NULL PRIMARY KEY, + media bytea NOT NULL, + name varchar NULL + ); +],{ RaiseError => 1, PrintError => 1 }); + + +PGTest::Artist->load_components(qw/ + + PK::Auto + Core +/); + +PGTest::Artist->add_columns( - my $resultset = $schema->resultset("Artist")->find({artistid=>25}); + "media", { - is($resultset->id, 25, 'Testing New ID'); - is($resultset->name, 'JohnNapiorkowski', 'Testing New Name'); -} + data_type => "bytea", + is_nullable => 0, + }, +); + +# test primary key handling +my $big_long_string = 'abcd' x 250000; + +my $new = PGTest::Artist->create({ media => $big_long_string }); + +ok($new->artistid, "Created a blob row"); +is($new->media, $big_long_string, "Set the blob correctly."); + +my $rs = PGTest::Artist->find({artistid=>$new->artistid}); + +is($rs->get_column('media'), $big_long_string, "Created the blob correctly."); + +$dbh->do("DROP TABLE artist"); + +