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とか)でうまくコンパイルできないかもしれない。
 Index: database.cxx
 ===================================================================
 RCS file: /cvsroot/tclodbc/tclodbc/database.cxx,v
 retrieving revision 1.7
 diff -u -r1.7 database.cxx
 --- database.cxx        20 Mar 2004 22:14:19 -0000      1.7
 +++ database.cxx        20 Jun 2009 17:18:13 -0000
 @@ -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]);
 Index: statemnt.cxx
 ===================================================================
 RCS file: /cvsroot/tclodbc/tclodbc/statemnt.cxx,v
 retrieving revision 1.7
 diff -u -r1.7 statemnt.cxx
 --- statemnt.cxx        20 Mar 2004 22:14:19 -0000      1.7
 +++ statemnt.cxx        20 Jun 2009 17:18:13 -0000
 @@ -627,6 +627,13 @@
 
              if (EncodedType(resultBuffer[i].fSqlType))
                  element.Decode(pDb->Encoding());
 +
 +            if (UnicodeType(resultBuffer[i].fSqlType)) {
 +                Tcl_Encoding e = Tcl_GetEncoding(NULL, "unicode");
 +                element.Decode(e);
 +                Tcl_FreeEncoding(e);
 +            }
 +
              row.appendElement(element);
          }
      }
 @@ -720,12 +727,13 @@
      RETCODE rc;
 
      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 +842,12 @@
              if (EncodedType(argDefBuffer[i].fSqlType))
                  sqlArg.Encode(pDb->Encoding());
 
 +            if (UnicodeType(argDefBuffer[i].fSqlType)) {
 +                Tcl_Encoding e = Tcl_GetEncoding(NULL, "unicode");
 +                sqlArg.Encode(e);
 +                Tcl_FreeEncoding(e);
 +            }
 +
              sqlarglen = sqlArg.EncodedLenght();
 
              if (sqlarglen == 0) {
 Index: strings.cxx
 ===================================================================
 RCS file: /cvsroot/tclodbc/tclodbc/strings.cxx,v
 retrieving revision 1.4
 diff -u -r1.4 strings.cxx
 --- strings.cxx 20 Mar 2004 22:14:19 -0000      1.4
 +++ strings.cxx 20 Jun 2009 17:18:14 -0000
 @@ -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 [] = {
 Index: tclodbc.cxx
 ===================================================================
 RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.cxx,v
 retrieving revision 1.5
 diff -u -r1.5 tclodbc.cxx
 --- tclodbc.cxx 19 Mar 2004 20:32:21 -0000      1.5
 +++ tclodbc.cxx 20 Jun 2009 17:18:14 -0000
 @@ -116,26 +116,25 @@
  //////////////////////////////////////////////////////////////////////////
  // MISANCELLOUS HELPER FUNCTIONS
  //
 -
  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");
      }
 @@ -214,11 +213,28 @@
         case SQL_VARBINARY:
         case SQL_LONGVARBINARY:
             return SQL_C_BINARY;
 +    case SQL_WCHAR:
 +    case SQL_WVARCHAR:
 +    case SQL_WLONGVARCHAR:
 +        return SQL_C_BINARY;
         default:
             return SQL_C_CHAR;
      }
  }
 
 +// this routine determines which sql types is unicode
 +BOOL UnicodeType (int i)
 +{
 +    switch (i) {
 +       case SQL_WCHAR:
 +       case SQL_WVARCHAR:
 +       case SQL_WLONGVARCHAR:
 +           return TRUE;
 +       default:
 +           return FALSE;
 +    }
 +}
 +
 
  //////////////////////////////////////////////////////////////////////////
  // TCL COMMAND INTERFACE
 @@ -339,7 +355,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) {
 Index: tclodbc.hxx
 ===================================================================
 RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.hxx,v
 retrieving revision 1.5
 diff -u -r1.5 tclodbc.hxx
 --- tclodbc.hxx 25 Mar 2005 20:49:21 -0000      1.5
 +++ tclodbc.hxx 20 Jun 2009 17:18:14 -0000
 @@ -542,6 +542,8 @@
 
  SWORD MapSqlType (SDWORD colType);
 
 +BOOL UnicodeType (int i);
 +
  #ifdef _DEBUG
  int tclodbc_validateNumStrArrays();
  int tclodbc_validateStrToNumFunction();

このパッチでは、次の点を改良した。
+ UNICODE文字列型に対応した。
+ SQL文は全てunicode文字列として扱うことにした。(Tclの内部表現であるUTF-8をUTF-16にしてそのまま渡す。)
+ varchar型のデータの取得に関しては従来どおり、database set encodingで設定したエンコーディングから変換して取得/設定する。ただし、database set encodingのエンコーディング自動変換が利くのは取得するデータ、ステートメントのパラメータの設定のみ。ステートメントのSQL文そのものはTclの文字列(UTF-8)をそのままUTF-16にして渡すので、エンコーディングは変換されない(unicodeとして扱う)。今まではステートメントのSQL文もdatabase set encodingの設定したものに変換していたが、こんなことをする必要があるのかと。。。WindowsでのODBCの関数はANSI系とUNICODE系の2種類あるのだが、ひょっとしたらUNIXで使うODBCドライバマネージャ絡みでこうしないといけないのかもしれない。よく調べてません。スイマセン。まあとりあえずこれで自分がやりたいことはできたので深く追求しないことにする。
+ エラーメッセージはUnicodeで取得して、そのままUTF-8に変換してTclに渡すので、文字化けしなくなった。

**ダウンロード [#w0d8e76c]
http://reddog.s35.xrea.com/software/tclodbc2.5r1-win32-bin.zip

**雑感 [#p689b144]
TclODBCのソースコードが読みにくい。C++な上、Tcl7.6とソースを共有してるので、古いTclのAPIが混在してる。BLTみたいにifdefで書き分けるスタイルだ。もうTcl8.1以上にしてしまえばコードもすっきりするのに。あとUnicode対応とか文字列の扱いが結構昔のままだった。昔のコードの残骸があちこちに散らばってるので、きれいに書き直したくなる。こう思うのはどうやら俺だけではないようで、[[TclODBCをプレーンなCに書き直したやつ:http://freshmeat.net/projects/tclodbc/]]もあるようだ。でもこれはなぜかSWIG使ってる。もしこれがSWIG無しで、綺麗にTEAとMINGWで完結できれば最高なんだが。また今回パッチを書くのにODBCについてちょっと調べたけど、それほど難しいものでもなかったので、時間があったら自分でODBC3.5に対応したのを書いてみたい気もする。他にもODBC接続のライブラリは色々あるようだがイマイチどれも決め手に欠けメジャーになりきれてないようだ。。

**参考リンク [#z7ed9f86]
-http://sourceforge.net/projects/tclodbc
-http://msdn.microsoft.com/en-us/library/ms714177(VS.85).aspx

**コメントをどーぞ [#d131bb86]
#comment
----
[[CategoryTclTk]]

HTML convert time: 0.004 sec.