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 } 477