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