From 9a1b8fe4f06e1532ddfba5e028dc79edd41a8aee Mon Sep 17 00:00:00 2001
From: Kenichi Ishigaki <ishigaki@cpan.org>
Date: Thu, 29 Sep 2011 15:29:01 +0000
Subject: [PATCH] resolved #71311; needs more tests for non-blobs

---
 Changes                           |   4 +
 dbdimp.c                          |  22 +++++-
 t/rt_71311_bind_col_and_unicode.t | 117 ++++++++++++++++++++++++++++++
 3 files changed, 142 insertions(+), 1 deletion(-)
 create mode 100644 t/rt_71311_bind_col_and_unicode.t

diff --git a/Changes b/Changes
index fdefb23..45b939d 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Changes for Perl extension DBD-SQLite
 
+1.34_02 to be released
+    - Resolved #71311: binding output columns as SQL_BLOB returns
+      nothing (ISHIGAKI)
+
 1.34_01 Thu 22 Sep 2011
     - Updated to SQLite 3.7.8 (ISHIGAKI)
     - Made util/getsqlite.pl work properly for SQLite 3.7.5+ (ISHIGAKI)
diff --git a/dbdimp.c b/dbdimp.c
index 7ba85be..2c65bbc 100644
--- a/dbdimp.c
+++ b/dbdimp.c
@@ -106,6 +106,26 @@ sqlite_type_to_odbc_type(int type)
     }
 }
 
+static int
+sqlite_type_from_odbc_type(int type)
+{
+    switch(type) {
+        case SQL_INTEGER:
+        case SQL_SMALLINT:
+        case SQL_TINYINT:
+        case SQL_BIGINT:
+            return SQLITE_INTEGER;
+        case SQL_FLOAT:
+        case SQL_REAL:
+        case SQL_DOUBLE:
+            return SQLITE_FLOAT;
+        case SQL_BLOB:
+            return SQLITE_BLOB;
+        default:
+            return SQLITE_TEXT;
+    }
+}
+
 static void
 sqlite_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error)
 {
@@ -854,7 +874,7 @@ sqlite_st_fetch(SV *sth, imp_sth_t *imp_sth)
         SV **sql_type = av_fetch(imp_sth->col_types, i, 0);
         if (sql_type && SvOK(*sql_type)) {
             if (SvIV(*sql_type)) {
-                col_type = SvIV(*sql_type);
+                col_type = sqlite_type_from_odbc_type(SvIV(*sql_type));
             }
         }
         switch(col_type) {
diff --git a/t/rt_71311_bind_col_and_unicode.t b/t/rt_71311_bind_col_and_unicode.t
new file mode 100644
index 0000000..d85ac1e
--- /dev/null
+++ b/t/rt_71311_bind_col_and_unicode.t
@@ -0,0 +1,117 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test qw/connect_ok/;
+use Test::More;
+BEGIN {
+	if ( $] >= 5.008005 ) {
+		plan( tests => 50 );
+	} else {
+		plan( skip_all => 'Unicode is not supported before 5.8.5' );
+	}
+}
+use Test::NoWarnings;
+use DBI qw/:sql_types/;
+
+my $dbh = connect_ok(sqlite_unicode => 1);
+$dbh->do('create table test1 (a integer, b blob)');
+
+my $blob = "\x{82}\x{A0}";
+my $str  = "\x{20ac}";
+
+{
+	my $sth = $dbh->prepare('insert into test1 values (?, ?)');
+
+	$sth->execute(1, $blob);
+
+	$sth->bind_param(1, 2);;
+	$sth->bind_param(2, $blob, SQL_BLOB);
+	$sth->execute;
+
+	$sth->bind_param(1, 3);;
+	$sth->bind_param(2, $blob, {TYPE => SQL_BLOB});
+	$sth->execute;
+
+	$sth->execute(4, $str);
+
+	$sth->bind_param(1, 5);;
+	$sth->bind_param(2, utf8::encode($str), SQL_BLOB);
+	$sth->execute;
+
+	$sth->bind_param(1, 6);;
+	$sth->bind_param(2, utf8::encode($str), {TYPE => SQL_BLOB});
+	$sth->execute;
+
+	$sth->finish;
+}
+
+{
+	my $sth = $dbh->prepare('select * from test1');
+	$sth->execute;
+
+	my $expected = [undef, 1, 0, 0, 1, 1, 1];
+	for (1..6) {
+		my $row = $sth->fetch;
+
+		ok $row && $row->[0] == $_;
+		ok $row && utf8::is_utf8($row->[1]) == $expected->[$_],
+			"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
+	}
+	$sth->finish;
+}
+
+{
+	my $sth = $dbh->prepare('select * from test1');
+	$sth->bind_col(1, \my $col1);
+	$sth->bind_col(2, \my $col2);
+	$sth->execute;
+
+	my $expected = [undef, 1, 0, 0, 1, 1, 1];
+	for (1..6) {
+		$sth->fetch;
+
+		ok $col1 && $col1 == $_;
+		ok $col1 && utf8::is_utf8($col2) == $expected->[$_],
+			"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
+	}
+	$sth->finish;
+}
+
+{
+	my $sth = $dbh->prepare('select * from test1');
+	$sth->bind_col(1, \my $col1);
+	$sth->bind_col(2, \my $col2, SQL_BLOB);
+	$sth->execute;
+
+	my $expected = [undef, 0, 0, 0, 0, 0, 0];
+	for (1..6) {
+		$sth->fetch;
+
+		ok $col1 && $col1 == $_;
+		ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
+			"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
+	}
+	$sth->finish;
+}
+
+{
+	my $sth = $dbh->prepare('select * from test1');
+	$sth->bind_col(1, \my $col1);
+	$sth->bind_col(2, \my $col2, {TYPE => SQL_BLOB});
+	$sth->execute;
+
+	my $expected = [undef, 0, 0, 0, 0, 0, 0];
+	for (1..6) {
+		$sth->fetch;
+
+		ok $col1 && $col1 == $_;
+		ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
+			"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
+	}
+	$sth->finish;
+}