blob for MariaDB

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 {

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;

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;
 }

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 {

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

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 {

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 ));