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