TclODBC2.3.1でMicrosoft SQL Server 2008に接続してnvarcharのデータが文字化けというか「?」になることに気がついた。どうやらTclODBCはunicodeの文字列型には対応していなかったらしい・・・。まだODBC2.0の仕様のままのようだ。とはいえ、最近のSQL ServerのODBCドライバはODBC3.0以上なので、TclODBCにその型さえ登録してしまえば、Tclの文字列の内部表現のUTF-8に完全にデータの損失なしにやり取りできるはず。さっそくやっつけ仕事で修正パッチを書いた。とりあえず、WindowsでSQL Server接続以外のことは考えずに書いたので、他の環境（Unixとか）でうまくコンパイルできないかもしれない。
diff -BwE --strip-trailing-cr -ur tclodbc.old/database.cxx tclodbc.new/database.cxx
--- tclodbc.old/database.cxx 2004-03-21 07:14:19 +0900
+++ tclodbc.new/database.cxx 2017-03-27 09:39:55 +0900
@@ -293,7 +293,7 @@
if (objc < 4 || objc > 6) {
THROWSTR("wrong # args, should be eval proc sql [typedefs] [args]");
} else {
- TclSqlStatement stmt(*this, Tcl_GetString(objv[3]),
+ TclSqlStatement stmt(*this, objv[3],
useMultipleResultSets);
TclObj proc (objv[2]);
@@ -312,7 +312,7 @@
if (objc < 4 || objc > 6) {
THROWSTR("wrong # args, should be read array sql [typedefs] [args]");
} else {
- TclSqlStatement stmt(*this, Tcl_GetString(objv[3]),
+ TclSqlStatement stmt(*this, objv[3],
useMultipleResultSets);
TclObj arraySpec (objv[2]);
@@ -331,7 +331,7 @@
if (objc < 2 || objc > 4) {
THROWSTR("wrong # args, should be sql [typedefs] [args]");
} else {
- TclSqlStatement stmt(*this, Tcl_GetString(objv[1]),
+ TclSqlStatement stmt(*this, objv[1],
useMultipleResultSets);
if (objc == 4) {
stmt.SetArgDefs(interp, objv[2]);
diff -BwE --strip-trailing-cr -ur tclodbc.old/statemnt.cxx tclodbc.new/statemnt.cxx
--- tclodbc.old/statemnt.cxx 2004-03-21 07:14:19 +0900
+++ tclodbc.new/statemnt.cxx 2017-05-24 16:43:33 +0900
@@ -261,6 +261,10 @@
THROWOBJ(SqlErr(env, SQL_NULL_HDBC, stmt))
}
+ if (EncodedType(resultBuffer[i].fSqlType)) {
+ resultBuffer[i].cbValueMax *= 2;
+ }
+
// target type
resultBuffer[i].fTargetType = MapSqlType (resultBuffer[i].fSqlType);
@@ -562,7 +566,7 @@
// (1 for string null terminator, obligatory with some drivers)
char dummy;
while ((rc = SQLGetData(stmt, (UWORD) (i+1), resultBuffer[i].fTargetType,
- &dummy, resultBuffer[i].fTargetType == SQL_C_CHAR ? 1 : 0,
+ &dummy, resultBuffer[i].fTargetType == SQL_C_WCHAR ? 1 : 0,
&(resultBuffer[i].cbValue))) == SQL_STILL_EXECUTING) Tcl_Sleep(0);
if (rc == SQL_ERROR) {
THROWOBJ(SqlErr(env, SQL_NULL_HDBC, stmt))
@@ -598,7 +602,7 @@
// get buffer full of data
while ((rc = SQLGetData(stmt, i+1, resultBuffer[i].fTargetType,
(char*) buffer,
- BUFSIZE + (resultBuffer[i].fTargetType == SQL_C_CHAR ? 1 : 0),
+ BUFSIZE + (resultBuffer[i].fTargetType == SQL_C_WCHAR ? 1 : 0),
&(resultBuffer[i].cbValue))) == SQL_STILL_EXECUTING) Tcl_Sleep(0);
if (rc == SQL_ERROR) {
THROWOBJ(SqlErr(env, SQL_NULL_HDBC, stmt))
@@ -614,7 +618,7 @@
// finally, get the actual data
while ((rc = SQLGetData(stmt, i+1, resultBuffer[i].fTargetType,
(char*) element,
- resultBuffer[i].cbValue + 1,
+ resultBuffer[i].cbValue + 2,
&(resultBuffer[i].cbValue))) == SQL_STILL_EXECUTING) Tcl_Sleep(0);
// set element length again. Some drivers return originally too long value
@@ -625,8 +629,12 @@
}
}
- if (EncodedType(resultBuffer[i].fSqlType))
- element.Decode(pDb->Encoding());
+ if (EncodedType(resultBuffer[i].fSqlType)) {
+ Tcl_Encoding e = Tcl_GetEncoding(NULL, "unicode");
+ element.Decode(e);
+ Tcl_FreeEncoding(e);
+ }
+
row.appendElement(element);
}
}
@@ -721,11 +729,12 @@
useMultipleResultSets = multiSets;
- // encode TclObj to selected character set
- sql.Encode(db.Encoding());
+ int wsqllen;
+ SQLWCHAR *wsql;
+ wsql = (SQLWCHAR*)Tcl_GetUnicodeFromObj(sql, &wsqllen);
// prepare statement
- while ((rc = SQLPrepare(stmt, (UCHAR*) sql.EncodedValue(), sql.EncodedLenght())) == SQL_STILL_EXECUTING) Tcl_Sleep(0);
+ while (((rc = SQLPrepareW(stmt, wsql, wsqllen))) == SQL_STILL_EXECUTING) Tcl_Sleep(0);
if (rc == SQL_ERROR)
THROWOBJ(SqlErr(env, db.DBC(), stmt))
@@ -834,6 +843,12 @@
if (EncodedType(argDefBuffer[i].fSqlType))
sqlArg.Encode(pDb->Encoding());
+ if (EncodedType(argDefBuffer[i].fSqlType)) {
+ Tcl_Encoding e = Tcl_GetEncoding(NULL, "unicode");
+ sqlArg.Encode(e);
+ Tcl_FreeEncoding(e);
+ }
+
sqlarglen = sqlArg.EncodedLenght();
if (sqlarglen == 0) {
diff -BwE --strip-trailing-cr -ur tclodbc.old/strings.cxx tclodbc.new/strings.cxx
--- tclodbc.old/strings.cxx 2004-03-21 07:14:19 +0900
+++ tclodbc.new/strings.cxx 2012-01-24 11:58:48 +0900
@@ -110,7 +110,7 @@
// in the struct.
NumStr sqlType [] = {
- {19, NULL },
+ {22, NULL },
{SQL_BIGINT, "BIGINT" },
{SQL_BINARY, "BINARY" },
{SQL_BIT, "BIT" },
@@ -129,7 +129,10 @@
{SQL_TIMESTAMP, "TIMESTAMP" },
{SQL_TINYINT, "TINYINT" },
{SQL_VARBINARY, "VARBINARY" },
- {SQL_VARCHAR, "VARCHAR" }
+ {SQL_VARCHAR, "VARCHAR" },
+ {SQL_WCHAR, "WCHAR" },
+ {SQL_WVARCHAR, "WVARCHAR" },
+ {SQL_WLONGVARCHAR, "WLONGVARCHAR"}
};
NumStr attrDef [] = {
diff -BwE --strip-trailing-cr -ur tclodbc.old/tclodbc.cxx tclodbc.new/tclodbc.cxx
--- tclodbc.old/tclodbc.cxx 2004-03-20 05:32:21 +0900
+++ tclodbc.new/tclodbc.cxx 2017-03-27 08:36:55 +0900
@@ -118,24 +118,24 @@
//
TclObj SqlErr (HENV env, HDBC dbc, HSTMT stmt) {
- char SqlMessage[SQL_MAX_MESSAGE_LENGTH];
- char SqlState[6];
+ SQLWCHAR SqlMessage[SQL_MAX_MESSAGE_LENGTH];
+ SQLWCHAR SqlState[6];
SDWORD NativeError;
SWORD Available;
RETCODE rc;
TclObj errObj;
- rc = SQLError(env, dbc, stmt,
- (UCHAR*) SqlState, &NativeError, (UCHAR*) SqlMessage,
+ rc = SQLErrorW(env, dbc, stmt,
+ SqlState, &NativeError, SqlMessage,
SQL_MAX_MESSAGE_LENGTH-1, &Available);
// sql error object is a triple:
// {standard error code} {native error code} {error message}
if (rc != SQL_ERROR) {
- errObj.appendElement(TclObj(SqlState));
+ errObj.appendElement(TclObj(Tcl_NewUnicodeObj((Tcl_UniChar*)SqlState, 5)));
errObj.appendElement(TclObj(NativeError));
- errObj.appendElement(TclObj(SqlMessage,Available));
+ errObj.appendElement(TclObj(Tcl_NewUnicodeObj((Tcl_UniChar*)SqlMessage, Available)));
} else {
errObj.appendElement("FATAL ERROR: Failed to receive error message");
}
@@ -202,6 +202,9 @@
case SQL_CHAR:
case SQL_VARCHAR:
case SQL_LONGVARCHAR:
+ case SQL_WCHAR:
+ case SQL_WVARCHAR:
+ case SQL_WLONGVARCHAR:
return TRUE;
default:
return FALSE;
@@ -214,6 +217,13 @@
case SQL_VARBINARY:
case SQL_LONGVARBINARY:
return SQL_C_BINARY;
+ case SQL_CHAR:
+ case SQL_VARCHAR:
+ case SQL_LONGVARCHAR:
+ case SQL_WCHAR:
+ case SQL_WVARCHAR:
+ case SQL_WLONGVARCHAR:
+ return SQL_C_WCHAR;
default:
return SQL_C_CHAR;
}
@@ -339,7 +348,7 @@
extern "C" {
_declspec(dllexport)
-Tclodbc_Init(Tcl_Interp *interp)
+int Tclodbc_Init(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
diff -BwE --strip-trailing-cr -ur tclodbc.old/tclodbc.hxx tclodbc.new/tclodbc.hxx
--- tclodbc.old/tclodbc.hxx 2005-03-26 05:49:21 +0900
+++ tclodbc.new/tclodbc.hxx 2012-01-24 12:37:32 +0900
@@ -542,6 +542,8 @@
SWORD MapSqlType (SDWORD colType);
+BOOL UnicodeType (int i);
+
#ifdef _DEBUG
int tclodbc_validateNumStrArrays();
int tclodbc_validateStrToNumFunction();
このパッチでは、次の点を改良した。
TclODBCのソースコードが読みにくい。C++な上、Tcl7.6とソースを共有してるので、古いTclのAPIが混在してる。BLTみたいにifdefで書き分けるスタイルだ。もうTcl8.1以上にしてしまえばコードもすっきりするのに。あとUnicode対応とか文字列の扱いが結構昔のままだった。昔のコードの残骸があちこちに散らばってるので、きれいに書き直したくなる。こう思うのはどうやら俺だけではないようで、TclODBCをプレーンなCに書き直したやつもあるようだ。でもこれはなぜかSWIG使ってる。もしこれがSWIG無しで、綺麗にTEAとMINGWで完結できれば最高なんだが。また今回パッチを書くのにODBCについてちょっと調べたけど、それほど難しいものでもなかったので、時間があったら自分でODBC3.5に対応したのを書いてみたい気もする。他にもODBC接続のライブラリは色々あるようだがイマイチどれも決め手に欠けメジャーになりきれてないようだ。。