ext/fts5/fts5_tcl.c

   1 /*
   2 ** 2014 Dec 01
   3 **
   4 ** The author disclaims copyright to this source code.  In place of
   5 ** a legal notice, here is a blessing:
   6 **
   7 **    May you do good and not evil.
   8 **    May you find forgiveness for yourself and forgive others.
   9 **    May you share freely, never taking more than you give.
  10 **
  11 ******************************************************************************
  12 **
  13 */
  14
  15
  16 #ifdef SQLITE_TEST
  17 #if defined(INCLUDE_SQLITE_TCL_H)
  18 #  include "sqlite_tcl.h"
  19 #else
  20 #  include "tcl.h"
  21 #  ifndef SQLITE_TCLAPI
  22 #    define SQLITE_TCLAPI
  23 #  endif
  24 #endif
  25
  26 #ifdef SQLITE_ENABLE_FTS5
  27
  28 #include "fts5.h"
  29 #include <string.h>
  30 #include <assert.h>
  31
  32 #ifdef SQLITE_DEBUG
  33 extern int sqlite3_fts5_may_be_corrupt;
  34 #endif
  35 extern int sqlite3Fts5TestRegisterMatchinfo(sqlite3*);
  36 extern int sqlite3Fts5TestRegisterTok(sqlite3*, fts5_api*);
  37
  38 /*************************************************************************
  39 ** This is a copy of the first part of the SqliteDb structure in
  40 ** tclsqlite.c.  We need it here so that the get_sqlite_pointer routine
  41 ** can extract the sqlite3* pointer from an existing Tcl SQLite
  42 ** connection.
  43 */
  44
  45 extern const char *sqlite3ErrName(int);
  46
  47 struct SqliteDb {
  48   sqlite3 *db;
  49 };
  50
  51 /*
  52 ** Decode a pointer to an sqlite3 object.
  53 */
  54 static int f5tDbPointer(Tcl_Interp *interp, Tcl_Obj *pObj, sqlite3 **ppDb){
  55   struct SqliteDb *p;
  56   Tcl_CmdInfo cmdInfo;
  57   char *z = Tcl_GetString(pObj);
  58   if( Tcl_GetCommandInfo(interp, z, &cmdInfo) ){
  59     p = (struct SqliteDb*)cmdInfo.objClientData;
  60     *ppDb = p->db;
  61     return TCL_OK;
  62   }
  63   return TCL_ERROR;
  64 }
  65
  66 /* End of code that accesses the SqliteDb struct.
  67 **************************************************************************/
  68
  69 static int f5tResultToErrorCode(const char *zRes){
  70   struct ErrorCode {
  71     int rc;
  72     const char *zError;
  73   } aErr[] = {
  74     { SQLITE_DONE,  "SQLITE_DONE" },
  75     { SQLITE_ERROR, "SQLITE_ERROR" },
  76     { SQLITE_OK,    "SQLITE_OK" },
  77     { SQLITE_OK,    "" },
  78   };
  79   int i;
  80
  81   for(i=0; i<sizeof(aErr)/sizeof(aErr[0]); i++){
  82     if( 0==sqlite3_stricmp(zRes, aErr[i].zError) ){
  83       return aErr[i].rc;
  84     }
  85   }
  86
  87   return SQLITE_ERROR;
  88 }
  89
  90 static int SQLITE_TCLAPI f5tDbAndApi(
  91   Tcl_Interp *interp,
  92   Tcl_Obj *pObj,
  93   sqlite3 **ppDb,
  94   fts5_api **ppApi
  95 ){
  96   sqlite3 *db = 0;
  97   int rc = f5tDbPointer(interp, pObj, &db);
  98   if( rc!=TCL_OK ){
  99     return TCL_ERROR;
 100   }else{
 101     sqlite3_stmt *pStmt = 0;
 102     fts5_api *pApi = 0;
 103
 104     rc = sqlite3_prepare_v2(db, "SELECT fts5(?1)", -1, &pStmt, 0);
 105     if( rc!=SQLITE_OK ){
 106       Tcl_AppendResult(interp, "error: ", sqlite3_errmsg(db), 0);
 107       return TCL_ERROR;
 108     }
 109     sqlite3_bind_pointer(pStmt, 1, (void*)&pApi, "fts5_api_ptr", 0);
 110     sqlite3_step(pStmt);
 111
 112     if( sqlite3_finalize(pStmt)!=SQLITE_OK ){
 113       Tcl_AppendResult(interp, "error: ", sqlite3_errmsg(db), 0);
 114       return TCL_ERROR;
 115     }
 116
 117     *ppDb = db;
 118     *ppApi = pApi;
 119   }
 120
 121   return TCL_OK;
 122 }
 123
 124 typedef struct F5tFunction F5tFunction;
 125 struct F5tFunction {
 126   Tcl_Interp *interp;
 127   Tcl_Obj *pScript;
 128 };
 129
 130 typedef struct F5tApi F5tApi;
 131 struct F5tApi {
 132   const Fts5ExtensionApi *pApi;
 133   Fts5Context *pFts;
 134 };
 135
 136 /*
 137 ** An object of this type is used with the xSetAuxdata() and xGetAuxdata()
 138 ** API test wrappers. The tcl interface allows a single tcl value to be
 139 ** saved using xSetAuxdata(). Instead of simply storing a pointer to the
 140 ** tcl object, the code in this file wraps it in an sqlite3_malloc'd
 141 ** instance of the following struct so that if the destructor is not
 142 ** correctly invoked it will be reported as an SQLite memory leak.
 143 */
 144 typedef struct F5tAuxData F5tAuxData;
 145 struct F5tAuxData {
 146   Tcl_Obj *pObj;
 147 };
 148
 149 static int xTokenizeCb(
 150   void *pCtx,
 151   int tflags,
 152   const char *zToken, int nToken,
 153   int iStart, int iEnd
 154 ){
 155   F5tFunction *p = (F5tFunction*)pCtx;
 156   Tcl_Obj *pEval = Tcl_DuplicateObj(p->pScript);
 157   int rc;
 158
 159   Tcl_IncrRefCount(pEval);
 160   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zToken, nToken));
 161   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewIntObj(iStart));
 162   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewIntObj(iEnd));
 163
 164   rc = Tcl_EvalObjEx(p->interp, pEval, 0);
 165   Tcl_DecrRefCount(pEval);
 166   if( rc==TCL_OK ){
 167     rc = f5tResultToErrorCode(Tcl_GetStringResult(p->interp));
 168   }
 169
 170   return rc;
 171 }
 172
 173 static int SQLITE_TCLAPI xF5tApi(void*, Tcl_Interp*, int, Tcl_Obj *CONST []);
 174
 175 static int xQueryPhraseCb(
 176   const Fts5ExtensionApi *pApi,
 177   Fts5Context *pFts,
 178   void *pCtx
 179 ){
 180   F5tFunction *p = (F5tFunction*)pCtx;
 181   static sqlite3_int64 iCmd = 0;
 182   Tcl_Obj *pEval;
 183   int rc;
 184
 185   char zCmd[64];
 186   F5tApi sApi;
 187
 188   sApi.pApi = pApi;
 189   sApi.pFts = pFts;
 190   sprintf(zCmd, "f5t_2_%lld", iCmd++);
 191   Tcl_CreateObjCommand(p->interp, zCmd, xF5tApi, &sApi, 0);
 192
 193   pEval = Tcl_DuplicateObj(p->pScript);
 194   Tcl_IncrRefCount(pEval);
 195   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zCmd, -1));
 196   rc = Tcl_EvalObjEx(p->interp, pEval, 0);
 197   Tcl_DecrRefCount(pEval);
 198   Tcl_DeleteCommand(p->interp, zCmd);
 199
 200   if( rc==TCL_OK ){
 201     rc = f5tResultToErrorCode(Tcl_GetStringResult(p->interp));
 202   }
 203
 204   return rc;
 205 }
 206
 207 static void xSetAuxdataDestructor(void *p){
 208   F5tAuxData *pData = (F5tAuxData*)p;
 209   Tcl_DecrRefCount(pData->pObj);
 210   sqlite3_free(pData);
 211 }
 212
 213 /*
 214 **      api sub-command...
 215 **
 216 ** Description...
 217 */
 218 static int SQLITE_TCLAPI xF5tApi(
 219   void * clientData,
 220   Tcl_Interp *interp,
 221   int objc,
 222   Tcl_Obj *CONST objv[]
 223 ){
 224   struct Sub {
 225     const char *zName;
 226     int nArg;
 227     const char *zMsg;
 228   } aSub[] = {
 229     { "xColumnCount",      0, "" },                   /*  0 */
 230     { "xRowCount",         0, "" },                   /*  1 */
 231     { "xColumnTotalSize",  1, "COL" },                /*  2 */
 232     { "xTokenize",         2, "TEXT SCRIPT" },        /*  3 */
 233     { "xPhraseCount",      0, "" },                   /*  4 */
 234     { "xPhraseSize",       1, "PHRASE" },             /*  5 */
 235     { "xInstCount",        0, "" },                   /*  6 */
 236     { "xInst",             1, "IDX" },                /*  7 */
 237     { "xRowid",            0, "" },                   /*  8 */
 238     { "xColumnText",       1, "COL" },                /*  9 */
 239     { "xColumnSize",       1, "COL" },                /* 10 */
 240     { "xQueryPhrase",      2, "PHRASE SCRIPT" },      /* 11 */
 241     { "xSetAuxdata",       1, "VALUE" },              /* 12 */
 242     { "xGetAuxdata",       1, "CLEAR" },              /* 13 */
 243     { "xSetAuxdataInt",    1, "INTEGER" },            /* 14 */
 244     { "xGetAuxdataInt",    1, "CLEAR" },              /* 15 */
 245     { "xPhraseForeach",    4, "IPHRASE COLVAR OFFVAR SCRIPT" }, /* 16 */
 246     { "xPhraseColumnForeach", 3, "IPHRASE COLVAR SCRIPT" }, /* 17 */
 247     { 0, 0, 0}
 248   };
 249
 250   int rc;
 251   int iSub = 0;
 252   F5tApi *p = (F5tApi*)clientData;
 253
 254   if( objc<2 ){
 255     Tcl_WrongNumArgs(interp, 1, objv, "SUB-COMMAND");
 256     return TCL_ERROR;
 257   }
 258
 259   rc = Tcl_GetIndexFromObjStruct(
 260       interp, objv[1], aSub, sizeof(aSub[0]), "SUB-COMMAND", 0, &iSub
 261   );
 262   if( rc!=TCL_OK ) return rc;
 263   if( aSub[iSub].nArg!=objc-2 ){
 264     Tcl_WrongNumArgs(interp, 1, objv, aSub[iSub].zMsg);
 265     return TCL_ERROR;
 266   }
 267
 268 #define CASE(i,str) case i: assert( strcmp(aSub[i].zName, str)==0 );
 269   switch( iSub ){
 270     CASE(0, "xColumnCount") {
 271       int nCol;
 272       nCol = p->pApi->xColumnCount(p->pFts);
 273       if( rc==SQLITE_OK ){
 274         Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
 275       }
 276       break;
 277     }
 278     CASE(1, "xRowCount") {
 279       sqlite3_int64 nRow;
 280       rc = p->pApi->xRowCount(p->pFts, &nRow);
 281       if( rc==SQLITE_OK ){
 282         Tcl_SetObjResult(interp, Tcl_NewWideIntObj(nRow));
 283       }
 284       break;
 285     }
 286     CASE(2, "xColumnTotalSize") {
 287       int iCol;
 288       sqlite3_int64 nSize;
 289       if( Tcl_GetIntFromObj(interp, objv[2], &iCol) ) return TCL_ERROR;
 290       rc = p->pApi->xColumnTotalSize(p->pFts, iCol, &nSize);
 291       if( rc==SQLITE_OK ){
 292         Tcl_SetObjResult(interp, Tcl_NewWideIntObj(nSize));
 293       }
 294       break;
 295     }
 296     CASE(3, "xTokenize") {
 297       int nText;
 298       char *zText = Tcl_GetStringFromObj(objv[2], &nText);
 299       F5tFunction ctx;
 300       ctx.interp = interp;
 301       ctx.pScript = objv[3];
 302       rc = p->pApi->xTokenize(p->pFts, zText, nText, &ctx, xTokenizeCb);
 303       if( rc==SQLITE_OK ){
 304         Tcl_ResetResult(interp);
 305       }
 306       return rc;
 307     }
 308     CASE(4, "xPhraseCount") {
 309       int nPhrase;
 310       nPhrase = p->pApi->xPhraseCount(p->pFts);
 311       if( rc==SQLITE_OK ){
 312         Tcl_SetObjResult(interp, Tcl_NewIntObj(nPhrase));
 313       }
 314       break;
 315     }
 316     CASE(5, "xPhraseSize") {
 317       int iPhrase;
 318       int sz;
 319       if( Tcl_GetIntFromObj(interp, objv[2], &iPhrase) ){
 320         return TCL_ERROR;
 321       }
 322       sz = p->pApi->xPhraseSize(p->pFts, iPhrase);
 323       if( rc==SQLITE_OK ){
 324         Tcl_SetObjResult(interp, Tcl_NewIntObj(sz));
 325       }
 326       break;
 327     }
 328     CASE(6, "xInstCount") {
 329       int nInst;
 330       rc = p->pApi->xInstCount(p->pFts, &nInst);
 331       if( rc==SQLITE_OK ){
 332         Tcl_SetObjResult(interp, Tcl_NewIntObj(nInst));
 333       }
 334       break;
 335     }
 336     CASE(7, "xInst") {
 337       int iIdx, ip, ic, io;
 338       if( Tcl_GetIntFromObj(interp, objv[2], &iIdx) ){
 339         return TCL_ERROR;
 340       }
 341       rc = p->pApi->xInst(p->pFts, iIdx, &ip, &ic, &io);
 342       if( rc==SQLITE_OK ){
 343         Tcl_Obj *pList = Tcl_NewObj();
 344         Tcl_ListObjAppendElement(interp, pList, Tcl_NewIntObj(ip));
 345         Tcl_ListObjAppendElement(interp, pList, Tcl_NewIntObj(ic));
 346         Tcl_ListObjAppendElement(interp, pList, Tcl_NewIntObj(io));
 347         Tcl_SetObjResult(interp, pList);
 348       }
 349       break;
 350     }
 351     CASE(8, "xRowid") {
 352       sqlite3_int64 iRowid = p->pApi->xRowid(p->pFts);
 353       Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iRowid));
 354       break;
 355     }
 356     CASE(9, "xColumnText") {
 357       const char *z = 0;
 358       int n = 0;
 359       int iCol;
 360       if( Tcl_GetIntFromObj(interp, objv[2], &iCol) ){
 361         return TCL_ERROR;
 362       }
 363       rc = p->pApi->xColumnText(p->pFts, iCol, &z, &n);
 364       if( rc==SQLITE_OK ){
 365         Tcl_SetObjResult(interp, Tcl_NewStringObj(z, n));
 366       }
 367       break;
 368     }
 369     CASE(10, "xColumnSize") {
 370       int n = 0;
 371       int iCol;
 372       if( Tcl_GetIntFromObj(interp, objv[2], &iCol) ){
 373         return TCL_ERROR;
 374       }
 375       rc = p->pApi->xColumnSize(p->pFts, iCol, &n);
 376       if( rc==SQLITE_OK ){
 377         Tcl_SetObjResult(interp, Tcl_NewIntObj(n));
 378       }
 379       break;
 380     }
 381     CASE(11, "xQueryPhrase") {
 382       int iPhrase;
 383       F5tFunction ctx;
 384       if( Tcl_GetIntFromObj(interp, objv[2], &iPhrase) ){
 385         return TCL_ERROR;
 386       }
 387       ctx.interp = interp;
 388       ctx.pScript = objv[3];
 389       rc = p->pApi->xQueryPhrase(p->pFts, iPhrase, &ctx, xQueryPhraseCb);
 390       if( rc==SQLITE_OK ){
 391         Tcl_ResetResult(interp);
 392       }
 393       break;
 394     }
 395     CASE(12, "xSetAuxdata") {
 396       F5tAuxData *pData = (F5tAuxData*)sqlite3_malloc(sizeof(F5tAuxData));
 397       if( pData==0 ){
 398         Tcl_AppendResult(interp, "out of memory", 0);
 399         return TCL_ERROR;
 400       }
 401       pData->pObj = objv[2];
 402       Tcl_IncrRefCount(pData->pObj);
 403       rc = p->pApi->xSetAuxdata(p->pFts, pData, xSetAuxdataDestructor);
 404       break;
 405     }
 406     CASE(13, "xGetAuxdata") {
 407       F5tAuxData *pData;
 408       int bClear;
 409       if( Tcl_GetBooleanFromObj(interp, objv[2], &bClear) ){
 410         return TCL_ERROR;
 411       }
 412       pData = (F5tAuxData*)p->pApi->xGetAuxdata(p->pFts, bClear);
 413       if( pData==0 ){
 414         Tcl_ResetResult(interp);
 415       }else{
 416         Tcl_SetObjResult(interp, pData->pObj);
 417         if( bClear ){
 418           xSetAuxdataDestructor((void*)pData);
 419         }
 420       }
 421       break;
 422     }
 423
 424     /* These two - xSetAuxdataInt and xGetAuxdataInt - are similar to the
 425     ** xSetAuxdata and xGetAuxdata methods implemented above. The difference
 426     ** is that they may only save an integer value as auxiliary data, and
 427     ** do not specify a destructor function.  */
 428     CASE(14, "xSetAuxdataInt") {
 429       int iVal;
 430       if( Tcl_GetIntFromObj(interp, objv[2], &iVal) ) return TCL_ERROR;
 431       rc = p->pApi->xSetAuxdata(p->pFts, (void*)((char*)0 + iVal), 0);
 432       break;
 433     }
 434     CASE(15, "xGetAuxdataInt") {
 435       int iVal;
 436       int bClear;
 437       if( Tcl_GetBooleanFromObj(interp, objv[2], &bClear) ) return TCL_ERROR;
 438       iVal = (int)((char*)p->pApi->xGetAuxdata(p->pFts, bClear) - (char*)0);
 439       Tcl_SetObjResult(interp, Tcl_NewIntObj(iVal));
 440       break;
 441     }
 442
 443     CASE(16, "xPhraseForeach") {
 444       int iPhrase;
 445       int iCol;
 446       int iOff;
 447       const char *zColvar;
 448       const char *zOffvar;
 449       Tcl_Obj *pScript = objv[5];
 450       Fts5PhraseIter iter;
 451
 452       if( Tcl_GetIntFromObj(interp, objv[2], &iPhrase) ) return TCL_ERROR;
 453       zColvar = Tcl_GetString(objv[3]);
 454       zOffvar = Tcl_GetString(objv[4]);
 455
 456       rc = p->pApi->xPhraseFirst(p->pFts, iPhrase, &iter, &iCol, &iOff);
 457       if( rc!=SQLITE_OK ){
 458         Tcl_AppendResult(interp, sqlite3ErrName(rc), 0);
 459         return TCL_ERROR;
 460       }
 461       for( ;iCol>=0; p->pApi->xPhraseNext(p->pFts, &iter, &iCol, &iOff) ){
 462         Tcl_SetVar2Ex(interp, zColvar, 0, Tcl_NewIntObj(iCol), 0);
 463         Tcl_SetVar2Ex(interp, zOffvar, 0, Tcl_NewIntObj(iOff), 0);
 464         rc = Tcl_EvalObjEx(interp, pScript, 0);
 465         if( rc==TCL_CONTINUE ) rc = TCL_OK;
 466         if( rc!=TCL_OK ){
 467           if( rc==TCL_BREAK ) rc = TCL_OK;
 468           break;
 469         }
 470       }
 471
 472       break;
 473     }
 474
 475     CASE(17, "xPhraseColumnForeach") {
 476       int iPhrase;
 477       int iCol;
 478       const char *zColvar;
 479       Tcl_Obj *pScript = objv[4];
 480       Fts5PhraseIter iter;
 481
 482       if( Tcl_GetIntFromObj(interp, objv[2], &iPhrase) ) return TCL_ERROR;
 483       zColvar = Tcl_GetString(objv[3]);
 484
 485       rc = p->pApi->xPhraseFirstColumn(p->pFts, iPhrase, &iter, &iCol);
 486       if( rc!=SQLITE_OK ){
 487         Tcl_SetResult(interp, (char*)sqlite3ErrName(rc), TCL_VOLATILE);
 488         return TCL_ERROR;
 489       }
 490       for( ; iCol>=0; p->pApi->xPhraseNextColumn(p->pFts, &iter, &iCol)){
 491         Tcl_SetVar2Ex(interp, zColvar, 0, Tcl_NewIntObj(iCol), 0);
 492         rc = Tcl_EvalObjEx(interp, pScript, 0);
 493         if( rc==TCL_CONTINUE ) rc = TCL_OK;
 494         if( rc!=TCL_OK ){
 495           if( rc==TCL_BREAK ) rc = TCL_OK;
 496           break;
 497         }
 498       }
 499
 500       break;
 501     }
 502
 503     default:
 504       assert( 0 );
 505       break;
 506   }
 507 #undef CASE
 508
 509   if( rc!=SQLITE_OK ){
 510     Tcl_SetResult(interp, (char*)sqlite3ErrName(rc), TCL_VOLATILE);
 511     return TCL_ERROR;
 512   }
 513
 514   return TCL_OK;
 515 }
 516
 517 static void xF5tFunction(
 518   const Fts5ExtensionApi *pApi,   /* API offered by current FTS version */
 519   Fts5Context *pFts,              /* First arg to pass to pApi functions */
 520   sqlite3_context *pCtx,          /* Context for returning result/error */
 521   int nVal,                       /* Number of values in apVal[] array */
 522   sqlite3_value **apVal           /* Array of trailing arguments */
 523 ){
 524   F5tFunction *p = (F5tFunction*)pApi->xUserData(pFts);
 525   Tcl_Obj *pEval;                 /* Script to evaluate */
 526   int i;
 527   int rc;
 528
 529   static sqlite3_int64 iCmd = 0;
 530   char zCmd[64];
 531   F5tApi sApi;
 532   sApi.pApi = pApi;
 533   sApi.pFts = pFts;
 534
 535   sprintf(zCmd, "f5t_%lld", iCmd++);
 536   Tcl_CreateObjCommand(p->interp, zCmd, xF5tApi, &sApi, 0);
 537   pEval = Tcl_DuplicateObj(p->pScript);
 538   Tcl_IncrRefCount(pEval);
 539   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zCmd, -1));
 540
 541   for(i=0; i<nVal; i++){
 542     Tcl_Obj *pObj = 0;
 543     switch( sqlite3_value_type(apVal[i]) ){
 544       case SQLITE_TEXT:
 545         pObj = Tcl_NewStringObj((const char*)sqlite3_value_text(apVal[i]), -1);
 546         break;
 547       case SQLITE_BLOB:
 548         pObj = Tcl_NewByteArrayObj(
 549             sqlite3_value_blob(apVal[i]), sqlite3_value_bytes(apVal[i])
 550         );
 551         break;
 552       case SQLITE_INTEGER:
 553         pObj = Tcl_NewWideIntObj(sqlite3_value_int64(apVal[i]));
 554         break;
 555       case SQLITE_FLOAT:
 556         pObj = Tcl_NewDoubleObj(sqlite3_value_double(apVal[i]));
 557         break;
 558       default:
 559         pObj = Tcl_NewObj();
 560         break;
 561     }
 562     Tcl_ListObjAppendElement(p->interp, pEval, pObj);
 563   }
 564
 565   rc = Tcl_EvalObjEx(p->interp, pEval, TCL_GLOBAL_ONLY);
 566   Tcl_DecrRefCount(pEval);
 567   Tcl_DeleteCommand(p->interp, zCmd);
 568
 569   if( rc!=TCL_OK ){
 570     sqlite3_result_error(pCtx, Tcl_GetStringResult(p->interp), -1);
 571   }else{
 572     Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
 573     int n;
 574     const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
 575     char c = zType[0];
 576     if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
 577       /* Only return a BLOB type if the Tcl variable is a bytearray and
 578       ** has no string representation. */
 579       unsigned char *data = Tcl_GetByteArrayFromObj(pVar, &n);
 580       sqlite3_result_blob(pCtx, data, n, SQLITE_TRANSIENT);
 581     }else if( c=='b' && strcmp(zType,"boolean")==0 ){
 582       Tcl_GetIntFromObj(0, pVar, &n);
 583       sqlite3_result_int(pCtx, n);
 584     }else if( c=='d' && strcmp(zType,"double")==0 ){
 585       double r;
 586       Tcl_GetDoubleFromObj(0, pVar, &r);
 587       sqlite3_result_double(pCtx, r);
 588     }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
 589           (c=='i' && strcmp(zType,"int")==0) ){
 590       Tcl_WideInt v;
 591       Tcl_GetWideIntFromObj(0, pVar, &v);
 592       sqlite3_result_int64(pCtx, v);
 593     }else{
 594       unsigned char *data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
 595       sqlite3_result_text(pCtx, (char *)data, n, SQLITE_TRANSIENT);
 596     }
 597   }
 598 }
 599
 600 static void xF5tDestroy(void *pCtx){
 601   F5tFunction *p = (F5tFunction*)pCtx;
 602   Tcl_DecrRefCount(p->pScript);
 603   ckfree((char *)p);
 604 }
 605
 606 /*
 607 **      sqlite3_fts5_create_function DB NAME SCRIPT
 608 **
 609 ** Description...
 610 */
 611 static int SQLITE_TCLAPI f5tCreateFunction(
 612   void * clientData,
 613   Tcl_Interp *interp,
 614   int objc,
 615   Tcl_Obj *CONST objv[]
 616 ){
 617   char *zName;
 618   Tcl_Obj *pScript;
 619   sqlite3 *db = 0;
 620   fts5_api *pApi = 0;
 621   F5tFunction *pCtx = 0;
 622   int rc;
 623
 624   if( objc!=4 ){
 625     Tcl_WrongNumArgs(interp, 1, objv, "DB NAME SCRIPT");
 626     return TCL_ERROR;
 627   }
 628   if( f5tDbAndApi(interp, objv[1], &db, &pApi) ) return TCL_ERROR;
 629
 630   zName = Tcl_GetString(objv[2]);
 631   pScript = objv[3];
 632   pCtx = (F5tFunction*)ckalloc(sizeof(F5tFunction));
 633   pCtx->interp = interp;
 634   pCtx->pScript = pScript;
 635   Tcl_IncrRefCount(pScript);
 636
 637   rc = pApi->xCreateFunction(
 638       pApi, zName, (void*)pCtx, xF5tFunction, xF5tDestroy
 639   );
 640   if( rc!=SQLITE_OK ){
 641     Tcl_AppendResult(interp, "error: ", sqlite3_errmsg(db), 0);
 642     return TCL_ERROR;
 643   }
 644
 645   return TCL_OK;
 646 }
 647
 648 typedef struct F5tTokenizeCtx F5tTokenizeCtx;
 649 struct F5tTokenizeCtx {
 650   Tcl_Obj *pRet;
 651   int bSubst;
 652   const char *zInput;
 653 };
 654
 655 static int xTokenizeCb2(
 656   void *pCtx,
 657   int tflags,
 658   const char *zToken, int nToken,
 659   int iStart, int iEnd
 660 ){
 661   F5tTokenizeCtx *p = (F5tTokenizeCtx*)pCtx;
 662   if( p->bSubst ){
 663     Tcl_ListObjAppendElement(0, p->pRet, Tcl_NewStringObj(zToken, nToken));
 664     Tcl_ListObjAppendElement(
 665         0, p->pRet, Tcl_NewStringObj(&p->zInput[iStart], iEnd-iStart)
 666     );
 667   }else{
 668     Tcl_ListObjAppendElement(0, p->pRet, Tcl_NewStringObj(zToken, nToken));
 669     Tcl_ListObjAppendElement(0, p->pRet, Tcl_NewIntObj(iStart));
 670     Tcl_ListObjAppendElement(0, p->pRet, Tcl_NewIntObj(iEnd));
 671   }
 672   return SQLITE_OK;
 673 }
 674
 675
 676 /*
 677 **      sqlite3_fts5_tokenize DB TOKENIZER TEXT
 678 **
 679 ** Description...
 680 */
 681 static int SQLITE_TCLAPI f5tTokenize(
 682   void * clientData,
 683   Tcl_Interp *interp,
 684   int objc,
 685   Tcl_Obj *CONST objv[]
 686 ){
 687   char *zText;
 688   int nText;
 689   sqlite3 *db = 0;
 690   fts5_api *pApi = 0;
 691   Fts5Tokenizer *pTok = 0;
 692   fts5_tokenizer tokenizer;
 693   Tcl_Obj *pRet = 0;
 694   void *pUserdata;
 695   int rc;
 696
 697   int nArg;
 698   const char **azArg;
 699   F5tTokenizeCtx ctx;
 700
 701   if( objc!=4 && objc!=5 ){
 702     Tcl_WrongNumArgs(interp, 1, objv, "?-subst? DB NAME TEXT");
 703     return TCL_ERROR;
 704   }
 705   if( objc==5 ){
 706     char *zOpt = Tcl_GetString(objv[1]);
 707     if( strcmp("-subst", zOpt) ){
 708       Tcl_AppendResult(interp, "unrecognized option: ", zOpt, 0);
 709       return TCL_ERROR;
 710     }
 711   }
 712   if( f5tDbAndApi(interp, objv[objc-3], &db, &pApi) ) return TCL_ERROR;
 713   if( Tcl_SplitList(interp, Tcl_GetString(objv[objc-2]), &nArg, &azArg) ){
 714     return TCL_ERROR;
 715   }
 716   if( nArg==0 ){
 717     Tcl_AppendResult(interp, "no such tokenizer: ", 0);
 718     Tcl_Free((void*)azArg);
 719     return TCL_ERROR;
 720   }
 721   zText = Tcl_GetStringFromObj(objv[objc-1], &nText);
 722
 723   rc = pApi->xFindTokenizer(pApi, azArg[0], &pUserdata, &tokenizer);
 724   if( rc!=SQLITE_OK ){
 725     Tcl_AppendResult(interp, "no such tokenizer: ", azArg[0], 0);
 726     return TCL_ERROR;
 727   }
 728
 729   rc = tokenizer.xCreate(pUserdata, &azArg[1], nArg-1, &pTok);
 730   if( rc!=SQLITE_OK ){
 731     Tcl_AppendResult(interp, "error in tokenizer.xCreate()", 0);
 732     return TCL_ERROR;
 733   }
 734
 735   pRet = Tcl_NewObj();
 736   Tcl_IncrRefCount(pRet);
 737   ctx.bSubst = (objc==5);
 738   ctx.pRet = pRet;
 739   ctx.zInput = zText;
 740   rc = tokenizer.xTokenize(
 741       pTok, (void*)&ctx, FTS5_TOKENIZE_DOCUMENT, zText, nText, xTokenizeCb2
 742   );
 743   tokenizer.xDelete(pTok);
 744   if( rc!=SQLITE_OK ){
 745     Tcl_AppendResult(interp, "error in tokenizer.xTokenize()", 0);
 746     Tcl_DecrRefCount(pRet);
 747     return TCL_ERROR;
 748   }
 749
 750
 751   Tcl_Free((void*)azArg);
 752   Tcl_SetObjResult(interp, pRet);
 753   Tcl_DecrRefCount(pRet);
 754   return TCL_OK;
 755 }
 756
 757 /*************************************************************************
 758 ** Start of tokenizer wrapper.
 759 */
 760
 761 typedef struct F5tTokenizerContext F5tTokenizerContext;
 762 typedef struct F5tTokenizerCb F5tTokenizerCb;
 763 typedef struct F5tTokenizerModule F5tTokenizerModule;
 764 typedef struct F5tTokenizerInstance F5tTokenizerInstance;
 765
 766 struct F5tTokenizerContext {
 767   void *pCtx;
 768   int (*xToken)(void*, int, const char*, int, int, int);
 769 };
 770
 771 struct F5tTokenizerModule {
 772   Tcl_Interp *interp;
 773   Tcl_Obj *pScript;
 774   F5tTokenizerContext *pContext;
 775 };
 776
 777 struct F5tTokenizerInstance {
 778   Tcl_Interp *interp;
 779   Tcl_Obj *pScript;
 780   F5tTokenizerContext *pContext;
 781 };
 782
 783 static int f5tTokenizerCreate(
 784   void *pCtx,
 785   const char **azArg,
 786   int nArg,
 787   Fts5Tokenizer **ppOut
 788 ){
 789   F5tTokenizerModule *pMod = (F5tTokenizerModule*)pCtx;
 790   Tcl_Obj *pEval;
 791   int rc = TCL_OK;
 792   int i;
 793
 794   pEval = Tcl_DuplicateObj(pMod->pScript);
 795   Tcl_IncrRefCount(pEval);
 796   for(i=0; rc==TCL_OK && i<nArg; i++){
 797     Tcl_Obj *pObj = Tcl_NewStringObj(azArg[i], -1);
 798     rc = Tcl_ListObjAppendElement(pMod->interp, pEval, pObj);
 799   }
 800
 801   if( rc==TCL_OK ){
 802     rc = Tcl_EvalObjEx(pMod->interp, pEval, TCL_GLOBAL_ONLY);
 803   }
 804   Tcl_DecrRefCount(pEval);
 805
 806   if( rc==TCL_OK ){
 807     F5tTokenizerInstance *pInst;
 808     pInst = (F5tTokenizerInstance*)ckalloc(sizeof(F5tTokenizerInstance));
 809     memset(pInst, 0, sizeof(F5tTokenizerInstance));
 810     pInst->interp = pMod->interp;
 811     pInst->pScript = Tcl_GetObjResult(pMod->interp);
 812     pInst->pContext = pMod->pContext;
 813     Tcl_IncrRefCount(pInst->pScript);
 814     *ppOut = (Fts5Tokenizer*)pInst;
 815   }
 816
 817   return rc;
 818 }
 819
 820
 821 static void f5tTokenizerDelete(Fts5Tokenizer *p){
 822   F5tTokenizerInstance *pInst = (F5tTokenizerInstance*)p;
 823   Tcl_DecrRefCount(pInst->pScript);
 824   ckfree((char *)pInst);
 825 }
 826
 827 static int f5tTokenizerTokenize(
 828   Fts5Tokenizer *p,
 829   void *pCtx,
 830   int flags,
 831   const char *pText, int nText,
 832   int (*xToken)(void*, int, const char*, int, int, int)
 833 ){
 834   F5tTokenizerInstance *pInst = (F5tTokenizerInstance*)p;
 835   void *pOldCtx;
 836   int (*xOldToken)(void*, int, const char*, int, int, int);
 837   Tcl_Obj *pEval;
 838   int rc;
 839   const char *zFlags;
 840
 841   pOldCtx = pInst->pContext->pCtx;
 842   xOldToken = pInst->pContext->xToken;
 843
 844   pInst->pContext->pCtx = pCtx;
 845   pInst->pContext->xToken = xToken;
 846
 847   assert(
 848       flags==FTS5_TOKENIZE_DOCUMENT
 849    || flags==FTS5_TOKENIZE_AUX
 850    || flags==FTS5_TOKENIZE_QUERY
 851    || flags==(FTS5_TOKENIZE_QUERY | FTS5_TOKENIZE_PREFIX)
 852   );
 853   pEval = Tcl_DuplicateObj(pInst->pScript);
 854   Tcl_IncrRefCount(pEval);
 855   switch( flags ){
 856     case FTS5_TOKENIZE_DOCUMENT:
 857       zFlags = "document";
 858       break;
 859     case FTS5_TOKENIZE_AUX:
 860       zFlags = "aux";
 861       break;
 862     case FTS5_TOKENIZE_QUERY:
 863       zFlags = "query";
 864       break;
 865     case (FTS5_TOKENIZE_PREFIX | FTS5_TOKENIZE_QUERY):
 866       zFlags = "prefixquery";
 867       break;
 868     default:
 869       assert( 0 );
 870       zFlags = "invalid";
 871       break;
 872   }
 873
 874   Tcl_ListObjAppendElement(pInst->interp, pEval, Tcl_NewStringObj(zFlags, -1));
 875   Tcl_ListObjAppendElement(pInst->interp, pEval, Tcl_NewStringObj(pText,nText));
 876   rc = Tcl_EvalObjEx(pInst->interp, pEval, TCL_GLOBAL_ONLY);
 877   Tcl_DecrRefCount(pEval);
 878
 879   pInst->pContext->pCtx = pOldCtx;
 880   pInst->pContext->xToken = xOldToken;
 881   return rc;
 882 }
 883
 884 /*
 885 ** sqlite3_fts5_token ?-colocated? TEXT START END
 886 */
 887 static int SQLITE_TCLAPI f5tTokenizerReturn(
 888   void * clientData,
 889   Tcl_Interp *interp,
 890   int objc,
 891   Tcl_Obj *CONST objv[]
 892 ){
 893   F5tTokenizerContext *p = (F5tTokenizerContext*)clientData;
 894   int iStart;
 895   int iEnd;
 896   int nToken;
 897   int tflags = 0;
 898   char *zToken;
 899   int rc;
 900
 901   if( objc==5 ){
 902     int nArg;
 903     char *zArg = Tcl_GetStringFromObj(objv[1], &nArg);
 904     if( nArg<=10 && nArg>=2 && memcmp("-colocated", zArg, nArg)==0 ){
 905       tflags |= FTS5_TOKEN_COLOCATED;
 906     }else{
 907       goto usage;
 908     }
 909   }else if( objc!=4 ){
 910     goto usage;
 911   }
 912
 913   zToken = Tcl_GetStringFromObj(objv[objc-3], &nToken);
 914   if( Tcl_GetIntFromObj(interp, objv[objc-2], &iStart)
 915    || Tcl_GetIntFromObj(interp, objv[objc-1], &iEnd)
 916   ){
 917     return TCL_ERROR;
 918   }
 919
 920   if( p->xToken==0 ){
 921     Tcl_AppendResult(interp,
 922         "sqlite3_fts5_token may only be used by tokenizer callback", 0
 923     );
 924     return TCL_ERROR;
 925   }
 926
 927   rc = p->xToken(p->pCtx, tflags, zToken, nToken, iStart, iEnd);
 928   Tcl_SetResult(interp, (char*)sqlite3ErrName(rc), TCL_VOLATILE);
 929   return rc==SQLITE_OK ? TCL_OK : TCL_ERROR;
 930
 931  usage:
 932   Tcl_WrongNumArgs(interp, 1, objv, "?-colocated? TEXT START END");
 933   return TCL_ERROR;
 934 }
 935
 936 static void f5tDelTokenizer(void *pCtx){
 937   F5tTokenizerModule *pMod = (F5tTokenizerModule*)pCtx;
 938   Tcl_DecrRefCount(pMod->pScript);
 939   ckfree((char *)pMod);
 940 }
 941
 942 /*
 943 **      sqlite3_fts5_create_tokenizer DB NAME SCRIPT
 944 **
 945 ** Register a tokenizer named NAME implemented by script SCRIPT. When
 946 ** a tokenizer instance is created (fts5_tokenizer.xCreate), any tokenizer
 947 ** arguments are appended to SCRIPT and the result executed.
 948 **
 949 ** The value returned by (SCRIPT + args) is itself a tcl script. This
 950 ** script - call it SCRIPT2 - is executed to tokenize text using the
 951 ** tokenizer instance "returned" by SCRIPT. Specifically, to tokenize
 952 ** text SCRIPT2 is invoked with a single argument appended to it - the
 953 ** text to tokenize.
 954 **
 955 ** SCRIPT2 should invoke the [sqlite3_fts5_token] command once for each
 956 ** token within the tokenized text.
 957 */
 958 static int SQLITE_TCLAPI f5tCreateTokenizer(
 959   ClientData clientData,
 960   Tcl_Interp *interp,
 961   int objc,
 962   Tcl_Obj *CONST objv[]
 963 ){
 964   F5tTokenizerContext *pContext = (F5tTokenizerContext*)clientData;
 965   sqlite3 *db;
 966   fts5_api *pApi;
 967   char *zName;
 968   Tcl_Obj *pScript;
 969   fts5_tokenizer t;
 970   F5tTokenizerModule *pMod;
 971   int rc;
 972
 973   if( objc!=4 ){
 974     Tcl_WrongNumArgs(interp, 1, objv, "DB NAME SCRIPT");
 975     return TCL_ERROR;
 976   }
 977   if( f5tDbAndApi(interp, objv[1], &db, &pApi) ){
 978     return TCL_ERROR;
 979   }
 980   zName = Tcl_GetString(objv[2]);
 981   pScript = objv[3];
 982
 983   t.xCreate = f5tTokenizerCreate;
 984   t.xTokenize = f5tTokenizerTokenize;
 985   t.xDelete = f5tTokenizerDelete;
 986
 987   pMod = (F5tTokenizerModule*)ckalloc(sizeof(F5tTokenizerModule));
 988   pMod->interp = interp;
 989   pMod->pScript = pScript;
 990   pMod->pContext = pContext;
 991   Tcl_IncrRefCount(pScript);
 992   rc = pApi->xCreateTokenizer(pApi, zName, (void*)pMod, &t, f5tDelTokenizer);
 993   if( rc!=SQLITE_OK ){
 994     Tcl_AppendResult(interp, "error in fts5_api.xCreateTokenizer()", 0);
 995     return TCL_ERROR;
 996   }
 997
 998   return TCL_OK;
 999 }
1000
1001 static void SQLITE_TCLAPI xF5tFree(ClientData clientData){
1002   ckfree(clientData);
1003 }
1004
1005 /*
1006 **      sqlite3_fts5_may_be_corrupt BOOLEAN
1007 **
1008 ** Set or clear the global "may-be-corrupt" flag. Return the old value.
1009 */
1010 static int SQLITE_TCLAPI f5tMayBeCorrupt(
1011   void * clientData,
1012   Tcl_Interp *interp,
1013   int objc,
1014   Tcl_Obj *CONST objv[]
1015 ){
1016 #ifdef SQLITE_DEBUG
1017   int bOld = sqlite3_fts5_may_be_corrupt;
1018
1019   if( objc!=2 && objc!=1 ){
1020     Tcl_WrongNumArgs(interp, 1, objv, "?BOOLEAN?");
1021     return TCL_ERROR;
1022   }
1023   if( objc==2 ){
1024     int bNew;
1025     if( Tcl_GetBooleanFromObj(interp, objv[1], &bNew) ) return TCL_ERROR;
1026     sqlite3_fts5_may_be_corrupt = bNew;
1027   }
1028
1029   Tcl_SetObjResult(interp, Tcl_NewIntObj(bOld));
1030 #endif
1031   return TCL_OK;
1032 }
1033
1034
1035 static unsigned int f5t_fts5HashKey(int nSlot, const char *p, int n){
1036   int i;
1037   unsigned int h = 13;
1038   for(i=n-1; i>=0; i--){
1039     h = (h << 3) ^ h ^ p[i];
1040   }
1041   return (h % nSlot);
1042 }
1043
1044 static int SQLITE_TCLAPI f5tTokenHash(
1045   void * clientData,
1046   Tcl_Interp *interp,
1047   int objc,
1048   Tcl_Obj *CONST objv[]
1049 ){
1050   char *z;
1051   int n;
1052   unsigned int iVal;
1053   int nSlot;
1054
1055   if( objc!=3 ){
1056     Tcl_WrongNumArgs(interp, 1, objv, "NSLOT TOKEN");
1057     return TCL_ERROR;
1058   }
1059   if( Tcl_GetIntFromObj(interp, objv[1], &nSlot) ){
1060     return TCL_ERROR;
1061   }
1062   z = Tcl_GetStringFromObj(objv[2], &n);
1063
1064   iVal = f5t_fts5HashKey(nSlot, z, n);
1065   Tcl_SetObjResult(interp, Tcl_NewIntObj(iVal));
1066   return TCL_OK;
1067 }
1068
1069 static int SQLITE_TCLAPI f5tRegisterMatchinfo(
1070   void * clientData,
1071   Tcl_Interp *interp,
1072   int objc,
1073   Tcl_Obj *CONST objv[]
1074 ){
1075   int rc;
1076   sqlite3 *db = 0;
1077
1078   if( objc!=2 ){
1079     Tcl_WrongNumArgs(interp, 1, objv, "DB");
1080     return TCL_ERROR;
1081   }
1082   if( f5tDbPointer(interp, objv[1], &db) ){
1083     return TCL_ERROR;
1084   }
1085
1086   rc = sqlite3Fts5TestRegisterMatchinfo(db);
1087   if( rc!=SQLITE_OK ){
1088     Tcl_SetResult(interp, (char*)sqlite3ErrName(rc), TCL_VOLATILE);
1089     return TCL_ERROR;
1090   }
1091   return TCL_OK;
1092 }
1093
1094 static int SQLITE_TCLAPI f5tRegisterTok(
1095   void * clientData,
1096   Tcl_Interp *interp,
1097   int objc,
1098   Tcl_Obj *CONST objv[]
1099 ){
1100   int rc;
1101   sqlite3 *db = 0;
1102   fts5_api *pApi = 0;
1103
1104   if( objc!=2 ){
1105     Tcl_WrongNumArgs(interp, 1, objv, "DB");
1106     return TCL_ERROR;
1107   }
1108   if( f5tDbAndApi(interp, objv[1], &db, &pApi) ){
1109     return TCL_ERROR;
1110   }
1111
1112   rc = sqlite3Fts5TestRegisterTok(db, pApi);
1113   if( rc!=SQLITE_OK ){
1114     Tcl_SetResult(interp, (char*)sqlite3ErrName(rc), TCL_VOLATILE);
1115     return TCL_ERROR;
1116   }
1117   return TCL_OK;
1118 }
1119
1120 /*
1121 ** Entry point.
1122 */
1123 int Fts5tcl_Init(Tcl_Interp *interp){
1124   static struct Cmd {
1125     char *zName;
1126     Tcl_ObjCmdProc *xProc;
1127     int bTokenizeCtx;
1128   } aCmd[] = {
1129     { "sqlite3_fts5_create_tokenizer",   f5tCreateTokenizer, 1 },
1130     { "sqlite3_fts5_token",              f5tTokenizerReturn, 1 },
1131     { "sqlite3_fts5_tokenize",           f5tTokenize, 0 },
1132     { "sqlite3_fts5_create_function",    f5tCreateFunction, 0 },
1133     { "sqlite3_fts5_may_be_corrupt",     f5tMayBeCorrupt, 0 },
1134     { "sqlite3_fts5_token_hash",         f5tTokenHash, 0 },
1135     { "sqlite3_fts5_register_matchinfo", f5tRegisterMatchinfo, 0 },
1136     { "sqlite3_fts5_register_fts5tokenize", f5tRegisterTok, 0 }
1137   };
1138   int i;
1139   F5tTokenizerContext *pContext;
1140
1141   pContext = (F5tTokenizerContext*)ckalloc(sizeof(F5tTokenizerContext));
1142   memset(pContext, 0, sizeof(*pContext));
1143
1144   for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){
1145     struct Cmd *p = &aCmd[i];
1146     void *pCtx = 0;
1147     if( p->bTokenizeCtx ) pCtx = (void*)pContext;
1148     Tcl_CreateObjCommand(interp, p->zName, p->xProc, pCtx, (i ? 0 : xF5tFree));
1149   }
1150
1151   return TCL_OK;
1152 }
1153 #else  /* SQLITE_ENABLE_FTS5 */
1154 int Fts5tcl_Init(Tcl_Interp *interp){
1155   return TCL_OK;
1156 }
1157 #endif /* SQLITE_ENABLE_FTS5 */
1158 #endif /* SQLITE_TEST */