diff --git a/cpanfile b/cpanfile index f4639d0..3ea7334 100644 --- a/cpanfile +++ b/cpanfile @@ -23,6 +23,7 @@ on develop => sub { on test => sub { requires 'version'; requires 'Tie::IxHash'; + requires 'Digest::SHA'; }; feature 'test_sqlite', 'Test SQLite' => sub { diff --git a/lib/Data/ObjectDriver/Driver/DBD/MariaDB.pm b/lib/Data/ObjectDriver/Driver/DBD/MariaDB.pm index cec472b..f01fac3 100644 --- a/lib/Data/ObjectDriver/Driver/DBD/MariaDB.pm +++ b/lib/Data/ObjectDriver/Driver/DBD/MariaDB.pm @@ -3,8 +3,59 @@ package Data::ObjectDriver::Driver::DBD::MariaDB; use strict; use warnings; +use Carp; use base qw( Data::ObjectDriver::Driver::DBD::mysql ); sub fetch_id { $_[3]->{mariadb_insertid} || $_[3]->{insertid} } +sub bind_param_attributes { + my ($dbd, $data_type) = @_; + if ($data_type) { + if ($data_type eq 'blob') { + return DBI::SQL_BINARY; + } elsif ($data_type eq 'binchar') { + return DBI::SQL_BINARY; + } + } + return; +} + +sub bulk_insert { + my $dbd = shift; + my $dbh = shift; + my $table = shift; + + my $cols = shift; + my $rows_ref = shift; + my $attrs = shift || {}; + + croak "Usage bulk_insert(dbd, dbh, table, columnref, rowsref)" + unless (defined $dbd && defined $dbh && defined $table && defined $cols && + defined $rows_ref); + + return 0e0 if (scalar(@{$rows_ref}) == 0); + + my $sql = "INSERT INTO $table (" . join(',', @{$cols}) . ") VALUES\n"; + + my $one_data_row = "(" . (join ',', (('?') x @$cols)) . ")"; + my $ph = join ",", (($one_data_row) x @$rows_ref); + $sql .= $ph; + + # For now just write all data, at some point we need to lookup the + # maximum packet size for SQL + + if (%$attrs) { + my $sth = $dbh->prepare($sql); + my $i = 1; + for my $row (@$rows_ref) { + for (my $j = 0; $j < @$cols; $j++) { + $sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]}); + } + } + $sth->execute; + } else { + return $dbh->do($sql, undef, map { @$_ } @$rows_ref); + } +} + 1; diff --git a/lib/Data/ObjectDriver/Driver/DBD/Oracle.pm b/lib/Data/ObjectDriver/Driver/DBD/Oracle.pm index 5020193..b1f1bf5 100644 --- a/lib/Data/ObjectDriver/Driver/DBD/Oracle.pm +++ b/lib/Data/ObjectDriver/Driver/DBD/Oracle.pm @@ -68,6 +68,7 @@ sub bulk_insert { my $table = shift; my $cols = shift; my $rows_ref = shift; + my $attrs = shift || {}; my $sql = "INSERT INTO $table(" . join(',', @$cols) @@ -76,7 +77,11 @@ sub bulk_insert { . ")"; my $sth = $dbh->prepare($sql); foreach my $row (@{ $rows_ref || []}) { - $sth->execute(@$row); + my $i = 1; + for (my $j = 0; $j < @$cols; $j++) { + $sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]}); + } + $sth->execute; } return 1; } diff --git a/lib/Data/ObjectDriver/Driver/DBD/Pg.pm b/lib/Data/ObjectDriver/Driver/DBD/Pg.pm index 86ad114..5dc1392 100644 --- a/lib/Data/ObjectDriver/Driver/DBD/Pg.pm +++ b/lib/Data/ObjectDriver/Driver/DBD/Pg.pm @@ -51,15 +51,33 @@ sub bulk_insert { my $cols = shift; my $rows_ref = shift; - - my $sql = "COPY $table (" . join(',', @{$cols}) . ') from stdin'; - - $dbh->do($sql); - foreach my $row (@{$rows_ref}) { - my $line = join("\t", map {$_ || '\N'} @{$row}); - $dbh->pg_putline("$line\n"); + my $attrs = shift || {}; + + if (%$attrs) { + my $sql = "INSERT INTO $table (" . join(',', @{$cols}) . ") VALUES\n"; + + my $one_data_row = "(" . (join ',', (('?') x @$cols)) . ")"; + my $ph = join ",", (($one_data_row) x @$rows_ref); + $sql .= $ph; + + my $sth = $dbh->prepare($sql); + my $i = 1; + for my $row (@$rows_ref) { + for (my $j = 0; $j < @$cols; $j++) { + $sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]}); + } + } + $sth->execute; + } else { + my $sql = "COPY $table (" . join(',', @{$cols}) . ') from stdin'; + + $dbh->do($sql); + foreach my $row (@{$rows_ref}) { + my $line = join("\t", map {$_ || '\N'} @{$row}); + $dbh->pg_putline("$line\n"); + } + return $dbh->pg_endcopy(); } - return $dbh->pg_endcopy(); } sub map_error_code { diff --git a/lib/Data/ObjectDriver/Driver/DBD/SQLite.pm b/lib/Data/ObjectDriver/Driver/DBD/SQLite.pm index de65575..18840f2 100644 --- a/lib/Data/ObjectDriver/Driver/DBD/SQLite.pm +++ b/lib/Data/ObjectDriver/Driver/DBD/SQLite.pm @@ -46,13 +46,18 @@ sub bulk_insert { my $cols = shift; my $rows_ref = shift; + my $attrs = shift || {}; my $sql = "INSERT INTO $table(" . join(',', @{$cols}) . ") VALUES (" . join(',', map {'?'} @{$cols}) . ")\n"; my $sth = $dbh->prepare($sql); foreach my $row (@{$rows_ref}) { - $sth->execute(@{$row}); + my $i = 1; + for (my $j = 0; $j < @$cols; $j++) { + $sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]}); + } + $sth->execute; } # For now just write all data, at some point we need to lookup the diff --git a/lib/Data/ObjectDriver/Driver/DBI.pm b/lib/Data/ObjectDriver/Driver/DBI.pm index 449f6eb..c722f17 100644 --- a/lib/Data/ObjectDriver/Driver/DBI.pm +++ b/lib/Data/ObjectDriver/Driver/DBI.pm @@ -642,9 +642,19 @@ sub bulk_insert { # pass this directly to the backend DBD my $dbh = $driver->rw_handle($class->properties->{db}); my $tbl = $driver->table_for($class); - my @db_cols = map {$dbd->db_column_name($tbl, $_) } @{$cols}; - return $dbd->bulk_insert($dbh, $tbl, \@db_cols, $data); + my @db_cols; + my %attrs; + my $col_defs = $class->properties->{column_defs}; + for my $col (@$cols) { + my $db_col = $dbd->db_column_name($tbl, $col); + push @db_cols, $db_col; + my $type = $col_defs->{$col} || 'char'; + my $attr = $dbd->bind_param_attributes($type) or next; + $attrs{$db_col} = $attr; + } + + return $dbd->bulk_insert($dbh, $tbl, \@db_cols, $data, \%attrs); } sub begin_work { diff --git a/t/10-resultset-blob.t b/t/10-resultset-blob.t new file mode 100644 index 0000000..1ced70f --- /dev/null +++ b/t/10-resultset-blob.t @@ -0,0 +1,52 @@ +# $Id: 01-col-inheritance.t 989 2005-09-23 19:58:01Z btrott $ + +use strict; +use warnings; + +use lib 't/lib'; + +$Data::ObjectDriver::DEBUG = 0; +use Test::More; +use DodTestUtil; +BEGIN { eval { require Digest::SHA; 1 } or plan skip_all => 'requires Digest::SHA' } + +BEGIN { DodTestUtil->check_driver } + +plan tests => 5; + +setup_dbs({ + global => [ qw( wines ) ], +}); + +use Wine; +use Storable; + +my $wine = Wine->new; +$wine->name("Saumur Champigny, Le Grand Clos 2001"); +$wine->rating(4); + +## generate some binary data (SQL_BLOB / MEDIUMBLOB) +my $binary = Digest::SHA::sha1("binary"); +$wine->content($binary); +ok($wine->save, 'Object saved successfully'); + +my $iter; + +$iter = Data::ObjectDriver::Iterator->new(sub {}); +my $wine_id = $wine->id; +undef $wine; +$wine = Wine->lookup($wine_id); + +ok $wine; +ok $wine->content eq $binary; + +my @names = qw(Margaux Latour); +Wine->bulk_insert([qw(name content)], [ map {[$_, Digest::SHA::sha1($_)]} @names ]); + +for my $name (@names) { + my ($found) = Wine->search({name => $name}); + ok $found->content eq Digest::SHA::sha1($name); +} + +disconnect_all($wine); +teardown_dbs(qw( global ));