src/test_tclvar.c

   1 /*
   2 ** 2006 June 13
   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 ** Code for testing the virtual table interfaces.  This code
  13 ** is not included in the SQLite library.  It is used for automated
  14 ** testing of the SQLite library.
  15 **
  16 ** The emphasis of this file is a virtual table that provides
  17 ** access to TCL variables.
  18 */
  19 #include "sqliteInt.h"
  20 #if defined(INCLUDE_SQLITE_TCL_H)
  21 #  include "sqlite_tcl.h"
  22 #else
  23 #  include "tcl.h"
  24 #endif
  25 #include <stdlib.h>
  26 #include <string.h>
  27
  28 #ifndef SQLITE_OMIT_VIRTUALTABLE
  29
  30 /*
  31 ** Characters that make up the idxStr created by xBestIndex for xFilter.
  32 */
  33 #define TCLVAR_NAME_EQ      'e'
  34 #define TCLVAR_NAME_MATCH   'm'
  35 #define TCLVAR_VALUE_GLOB   'g'
  36 #define TCLVAR_VALUE_REGEXP 'r'
  37 #define TCLVAR_VALUE_LIKE   'l'
  38
  39 typedef struct tclvar_vtab tclvar_vtab;
  40 typedef struct tclvar_cursor tclvar_cursor;
  41
  42 /*
  43 ** A tclvar virtual-table object
  44 */
  45 struct tclvar_vtab {
  46   sqlite3_vtab base;
  47   Tcl_Interp *interp;
  48 };
  49
  50 /* A tclvar cursor object */
  51 struct tclvar_cursor {
  52   sqlite3_vtab_cursor base;
  53
  54   Tcl_Obj *pList1;     /* Result of [info vars ?pattern?] */
  55   Tcl_Obj *pList2;     /* Result of [array names [lindex $pList1 $i1]] */
  56   int i1;              /* Current item in pList1 */
  57   int i2;              /* Current item (if any) in pList2 */
  58 };
  59
  60 /* Methods for the tclvar module */
  61 static int tclvarConnect(
  62   sqlite3 *db,
  63   void *pAux,
  64   int argc, const char *const*argv,
  65   sqlite3_vtab **ppVtab,
  66   char **pzErr
  67 ){
  68   tclvar_vtab *pVtab;
  69   static const char zSchema[] =
  70      "CREATE TABLE whatever(name TEXT, arrayname TEXT, value TEXT)";
  71   pVtab = sqlite3MallocZero( sizeof(*pVtab) );
  72   if( pVtab==0 ) return SQLITE_NOMEM;
  73   *ppVtab = &pVtab->base;
  74   pVtab->interp = (Tcl_Interp *)pAux;
  75   sqlite3_declare_vtab(db, zSchema);
  76   return SQLITE_OK;
  77 }
  78 /* Note that for this virtual table, the xCreate and xConnect
  79 ** methods are identical. */
  80
  81 static int tclvarDisconnect(sqlite3_vtab *pVtab){
  82   sqlite3_free(pVtab);
  83   return SQLITE_OK;
  84 }
  85 /* The xDisconnect and xDestroy methods are also the same */
  86
  87 /*
  88 ** Open a new tclvar cursor.
  89 */
  90 static int tclvarOpen(sqlite3_vtab *pVTab, sqlite3_vtab_cursor **ppCursor){
  91   tclvar_cursor *pCur;
  92   pCur = sqlite3MallocZero(sizeof(tclvar_cursor));
  93   *ppCursor = &pCur->base;
  94   return SQLITE_OK;
  95 }
  96
  97 /*
  98 ** Close a tclvar cursor.
  99 */
 100 static int tclvarClose(sqlite3_vtab_cursor *cur){
 101   tclvar_cursor *pCur = (tclvar_cursor *)cur;
 102   if( pCur->pList1 ){
 103     Tcl_DecrRefCount(pCur->pList1);
 104   }
 105   if( pCur->pList2 ){
 106     Tcl_DecrRefCount(pCur->pList2);
 107   }
 108   sqlite3_free(pCur);
 109   return SQLITE_OK;
 110 }
 111
 112 /*
 113 ** Returns 1 if data is ready, or 0 if not.
 114 */
 115 static int next2(Tcl_Interp *interp, tclvar_cursor *pCur, Tcl_Obj *pObj){
 116   Tcl_Obj *p;
 117
 118   if( pObj ){
 119     if( !pCur->pList2 ){
 120       p = Tcl_NewStringObj("array names", -1);
 121       Tcl_IncrRefCount(p);
 122       Tcl_ListObjAppendElement(0, p, pObj);
 123       Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
 124       Tcl_DecrRefCount(p);
 125       pCur->pList2 = Tcl_GetObjResult(interp);
 126       Tcl_IncrRefCount(pCur->pList2);
 127       assert( pCur->i2==0 );
 128     }else{
 129       int n = 0;
 130       pCur->i2++;
 131       Tcl_ListObjLength(0, pCur->pList2, &n);
 132       if( pCur->i2>=n ){
 133         Tcl_DecrRefCount(pCur->pList2);
 134         pCur->pList2 = 0;
 135         pCur->i2 = 0;
 136         return 0;
 137       }
 138     }
 139   }
 140
 141   return 1;
 142 }
 143
 144 static int tclvarNext(sqlite3_vtab_cursor *cur){
 145   Tcl_Obj *pObj;
 146   int n = 0;
 147   int ok = 0;
 148
 149   tclvar_cursor *pCur = (tclvar_cursor *)cur;
 150   Tcl_Interp *interp = ((tclvar_vtab *)(cur->pVtab))->interp;
 151
 152   Tcl_ListObjLength(0, pCur->pList1, &n);
 153   while( !ok && pCur->i1<n ){
 154     Tcl_ListObjIndex(0, pCur->pList1, pCur->i1, &pObj);
 155     ok = next2(interp, pCur, pObj);
 156     if( !ok ){
 157       pCur->i1++;
 158     }
 159   }
 160
 161   return 0;
 162 }
 163
 164 static int tclvarFilter(
 165   sqlite3_vtab_cursor *pVtabCursor,
 166   int idxNum, const char *idxStr,
 167   int argc, sqlite3_value **argv
 168 ){
 169   tclvar_cursor *pCur = (tclvar_cursor *)pVtabCursor;
 170   Tcl_Interp *interp = ((tclvar_vtab *)(pVtabCursor->pVtab))->interp;
 171   Tcl_Obj *p = Tcl_NewStringObj("tclvar_filter_cmd", -1);
 172
 173   const char *zEq = "";
 174   const char *zMatch = "";
 175   const char *zGlob = "";
 176   const char *zRegexp = "";
 177   const char *zLike = "";
 178   int i;
 179
 180   for(i=0; idxStr[i]; i++){
 181     switch( idxStr[i] ){
 182       case TCLVAR_NAME_EQ:
 183         zEq = (const char*)sqlite3_value_text(argv[i]);
 184         break;
 185       case TCLVAR_NAME_MATCH:
 186         zMatch = (const char*)sqlite3_value_text(argv[i]);
 187         break;
 188       case TCLVAR_VALUE_GLOB:
 189         zGlob = (const char*)sqlite3_value_text(argv[i]);
 190         break;
 191       case TCLVAR_VALUE_REGEXP:
 192         zRegexp = (const char*)sqlite3_value_text(argv[i]);
 193         break;
 194       case TCLVAR_VALUE_LIKE:
 195         zLike = (const char*)sqlite3_value_text(argv[i]);
 196         break;
 197       default:
 198         assert( 0 );
 199     }
 200   }
 201
 202   Tcl_IncrRefCount(p);
 203   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zEq, -1));
 204   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zMatch, -1));
 205   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zGlob, -1));
 206   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zRegexp, -1));
 207   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zLike, -1));
 208
 209   Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
 210   if( pCur->pList1 ){
 211     Tcl_DecrRefCount(pCur->pList1);
 212   }
 213   if( pCur->pList2 ){
 214     Tcl_DecrRefCount(pCur->pList2);
 215     pCur->pList2 = 0;
 216   }
 217   pCur->i1 = 0;
 218   pCur->i2 = 0;
 219   pCur->pList1 = Tcl_GetObjResult(interp);
 220   Tcl_IncrRefCount(pCur->pList1);
 221
 222   Tcl_DecrRefCount(p);
 223   return tclvarNext(pVtabCursor);
 224 }
 225
 226 static int tclvarColumn(sqlite3_vtab_cursor *cur, sqlite3_context *ctx, int i){
 227   Tcl_Obj *p1;
 228   Tcl_Obj *p2;
 229   const char *z1;
 230   const char *z2 = "";
 231   tclvar_cursor *pCur = (tclvar_cursor*)cur;
 232   Tcl_Interp *interp = ((tclvar_vtab *)cur->pVtab)->interp;
 233
 234   Tcl_ListObjIndex(interp, pCur->pList1, pCur->i1, &p1);
 235   Tcl_ListObjIndex(interp, pCur->pList2, pCur->i2, &p2);
 236   z1 = Tcl_GetString(p1);
 237   if( p2 ){
 238     z2 = Tcl_GetString(p2);
 239   }
 240   switch (i) {
 241     case 0: {
 242       sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
 243       break;
 244     }
 245     case 1: {
 246       sqlite3_result_text(ctx, z2, -1, SQLITE_TRANSIENT);
 247       break;
 248     }
 249     case 2: {
 250       Tcl_Obj *pVal = Tcl_GetVar2Ex(interp, z1, *z2?z2:0, TCL_GLOBAL_ONLY);
 251       sqlite3_result_text(ctx, Tcl_GetString(pVal), -1, SQLITE_TRANSIENT);
 252       break;
 253     }
 254   }
 255   return SQLITE_OK;
 256 }
 257
 258 static int tclvarRowid(sqlite3_vtab_cursor *cur, sqlite_int64 *pRowid){
 259   *pRowid = 0;
 260   return SQLITE_OK;
 261 }
 262
 263 static int tclvarEof(sqlite3_vtab_cursor *cur){
 264   tclvar_cursor *pCur = (tclvar_cursor*)cur;
 265   return (pCur->pList2?0:1);
 266 }
 267
 268 /*
 269 ** If nul-terminated string zStr does not already contain the character
 270 ** passed as the second argument, append it and return 0. Or, if there is
 271 ** already an instance of x in zStr, do nothing return 1;
 272 **
 273 ** There is guaranteed to be enough room in the buffer pointed to by zStr
 274 ** for the new character and nul-terminator.
 275 */
 276 static int tclvarAddToIdxstr(char *zStr, char x){
 277   int i;
 278   for(i=0; zStr[i]; i++){
 279     if( zStr[i]==x ) return 1;
 280   }
 281   zStr[i] = x;
 282   zStr[i+1] = '\0';
 283   return 0;
 284 }
 285
 286 /*
 287 ** Return true if variable $::tclvar_set_omit exists and is set to true.
 288 ** False otherwise.
 289 */
 290 static int tclvarSetOmit(Tcl_Interp *interp){
 291   int rc;
 292   int res = 0;
 293   Tcl_Obj *pRes;
 294   rc = Tcl_Eval(interp,
 295     "expr {[info exists ::tclvar_set_omit] && $::tclvar_set_omit}"
 296   );
 297   if( rc==TCL_OK ){
 298     pRes = Tcl_GetObjResult(interp);
 299     rc = Tcl_GetBooleanFromObj(0, pRes, &res);
 300   }
 301   return (rc==TCL_OK && res);
 302 }
 303
 304 /*
 305 ** The xBestIndex() method. This virtual table supports the following
 306 ** operators:
 307 **
 308 **     name = ?                    (omit flag clear)
 309 **     name MATCH ?                (omit flag set)
 310 **     value GLOB ?                (omit flag set iff $::tclvar_set_omit)
 311 **     value REGEXP ?              (omit flag set iff $::tclvar_set_omit)
 312 **     value LIKE ?                (omit flag set iff $::tclvar_set_omit)
 313 **
 314 ** For each constraint present, the corresponding TCLVAR_XXX character is
 315 ** appended to the idxStr value.
 316 */
 317 static int tclvarBestIndex(sqlite3_vtab *tab, sqlite3_index_info *pIdxInfo){
 318   tclvar_vtab *pTab = (tclvar_vtab*)tab;
 319   int ii;
 320   char *zStr = sqlite3_malloc(32);
 321   int iStr = 0;
 322
 323   if( zStr==0 ) return SQLITE_NOMEM;
 324   zStr[0] = '\0';
 325
 326   for(ii=0; ii<pIdxInfo->nConstraint; ii++){
 327     struct sqlite3_index_constraint const *pCons = &pIdxInfo->aConstraint[ii];
 328     struct sqlite3_index_constraint_usage *pUsage;
 329
 330     pUsage = &pIdxInfo->aConstraintUsage[ii];
 331     if( pCons->usable ){
 332       /* name = ? */
 333       if( pCons->op==SQLITE_INDEX_CONSTRAINT_EQ && pCons->iColumn==0 ){
 334         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_EQ) ){
 335           pUsage->argvIndex = ++iStr;
 336           pUsage->omit = 0;
 337         }
 338       }
 339
 340       /* name MATCH ? */
 341       if( pCons->op==SQLITE_INDEX_CONSTRAINT_MATCH && pCons->iColumn==0 ){
 342         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_MATCH) ){
 343           pUsage->argvIndex = ++iStr;
 344           pUsage->omit = 1;
 345         }
 346       }
 347
 348       /* value GLOB ? */
 349       if( pCons->op==SQLITE_INDEX_CONSTRAINT_GLOB && pCons->iColumn==2 ){
 350         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_GLOB) ){
 351           pUsage->argvIndex = ++iStr;
 352           pUsage->omit = tclvarSetOmit(pTab->interp);
 353         }
 354       }
 355
 356       /* value REGEXP ? */
 357       if( pCons->op==SQLITE_INDEX_CONSTRAINT_REGEXP && pCons->iColumn==2 ){
 358         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_REGEXP) ){
 359           pUsage->argvIndex = ++iStr;
 360           pUsage->omit = tclvarSetOmit(pTab->interp);
 361         }
 362       }
 363
 364       /* value LIKE ? */
 365       if( pCons->op==SQLITE_INDEX_CONSTRAINT_LIKE && pCons->iColumn==2 ){
 366         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_LIKE) ){
 367           pUsage->argvIndex = ++iStr;
 368           pUsage->omit = tclvarSetOmit(pTab->interp);
 369         }
 370       }
 371     }
 372   }
 373   pIdxInfo->idxStr = zStr;
 374   pIdxInfo->needToFreeIdxStr = 1;
 375
 376   return SQLITE_OK;
 377 }
 378
 379 /*
 380 ** A virtual table module that provides read-only access to a
 381 ** Tcl global variable namespace.
 382 */
 383 static sqlite3_module tclvarModule = {
 384   0,                         /* iVersion */
 385   tclvarConnect,
 386   tclvarConnect,
 387   tclvarBestIndex,
 388   tclvarDisconnect,
 389   tclvarDisconnect,
 390   tclvarOpen,                  /* xOpen - open a cursor */
 391   tclvarClose,                 /* xClose - close a cursor */
 392   tclvarFilter,                /* xFilter - configure scan constraints */
 393   tclvarNext,                  /* xNext - advance a cursor */
 394   tclvarEof,                   /* xEof - check for end of scan */
 395   tclvarColumn,                /* xColumn - read data */
 396   tclvarRowid,                 /* xRowid - read data */
 397   0,                           /* xUpdate */
 398   0,                           /* xBegin */
 399   0,                           /* xSync */
 400   0,                           /* xCommit */
 401   0,                           /* xRollback */
 402   0,                           /* xFindMethod */
 403   0,                           /* xRename */
 404 };
 405
 406 /*
 407 ** Decode a pointer to an sqlite3 object.
 408 */
 409 extern int getDbPointer(Tcl_Interp *interp, const char *zA, sqlite3 **ppDb);
 410
 411 /*
 412 ** Register the echo virtual table module.
 413 */
 414 static int SQLITE_TCLAPI register_tclvar_module(
 415   ClientData clientData, /* Pointer to sqlite3_enable_XXX function */
 416   Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
 417   int objc,              /* Number of arguments */
 418   Tcl_Obj *CONST objv[]  /* Command arguments */
 419 ){
 420   int rc = TCL_OK;
 421   sqlite3 *db;
 422   if( objc!=2 ){
 423     Tcl_WrongNumArgs(interp, 1, objv, "DB");
 424     return TCL_ERROR;
 425   }
 426   if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;
 427 #ifndef SQLITE_OMIT_VIRTUALTABLE
 428   sqlite3_create_module(db, "tclvar", &tclvarModule, (void*)interp);
 429   rc = Tcl_Eval(interp,
 430       "proc like {pattern str} {\n"
 431       "  set p [string map {% * _ ?} $pattern]\n"
 432       "  string match $p $str\n"
 433       "}\n"
 434       "proc tclvar_filter_cmd {eq match glob regexp like} {\n"
 435       "  set res {}\n"
 436       "  set pattern $eq\n"
 437       "  if {$pattern=={}} { set pattern $match }\n"
 438       "  if {$pattern=={}} { set pattern * }\n"
 439       "  foreach v [uplevel #0 info vars $pattern] {\n"
 440       "    if {($glob=={} || [string match $glob [uplevel #0 set $v]])\n"
 441       "     && ($like=={} || [like $like [uplevel #0 set $v]])\n"
 442       "     && ($regexp=={} || [regexp $regexp [uplevel #0 set $v]])\n"
 443       "    } {\n"
 444       "      lappend res $v\n"
 445       "    }\n"
 446       "  }\n"
 447       "  set res\n"
 448       "}\n"
 449   );
 450 #endif
 451   return rc;
 452 }
 453
 454 #endif
 455
 456
 457 /*
 458 ** Register commands with the TCL interpreter.
 459 */
 460 int Sqlitetesttclvar_Init(Tcl_Interp *interp){
 461 #ifndef SQLITE_OMIT_VIRTUALTABLE
 462   static struct {
 463      char *zName;
 464      Tcl_ObjCmdProc *xProc;
 465      void *clientData;
 466   } aObjCmd[] = {
 467      { "register_tclvar_module",   register_tclvar_module, 0 },
 468   };
 469   int i;
 470   for(i=0; i<sizeof(aObjCmd)/sizeof(aObjCmd[0]); i++){
 471     Tcl_CreateObjCommand(interp, aObjCmd[i].zName,
 472         aObjCmd[i].xProc, aObjCmd[i].clientData, 0);
 473   }
 474 #endif
 475   return TCL_OK;
 476 }