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