third_party/sqlite/sqlite-src-3280000/src/test_tclvar.c - chromium/src - Git at Google

 /*
 ** 2006 June 13
 **
 ** The author disclaims copyright to this source code.  In place of
 ** a legal notice, here is a blessing:
 **
 **    May you do good and not evil.
 **    May you find forgiveness for yourself and forgive others.
 **    May you share freely, never taking more than you give.
 **
 *************************************************************************
 ** Code for testing the virtual table interfaces.  This code
 ** is not included in the SQLite library.  It is used for automated
 ** testing of the SQLite library.
 **
 ** The emphasis of this file is a virtual table that provides
 ** access to TCL variables.
 **
 ** The TCLVAR eponymous virtual table has a schema like this:
 **
 **    CREATE TABLE tclvar(
 **       name TEXT,       -- base name of the variable:  "x" in "$x(y)"
 **       arrayname TEXT,  -- array index name: "y" in "$x(y)"
 **       value TEXT,      -- the value of the variable
 **       fullname TEXT,   -- the full name of the variable
 **       PRIMARY KEY(fullname)
 **    ) WITHOUT ROWID;
 **
 ** DELETE, INSERT, and UPDATE operations use the "fullname" field to
 ** determine the variable to be modified.  Changing "value" to NULL
 ** deletes the variable.
 **
 ** For SELECT operations, the "name" and "arrayname" fields will always
 ** match the "fullname" field.  For DELETE, INSERT, and UPDATE, the
 ** "name" and "arrayname" fields are ignored and the variable is modified
 ** according to "fullname" and "value" only.
 */
 #include "sqliteInt.h"
 #if defined(INCLUDE_SQLITE_TCL_H)
 #  include "sqlite_tcl.h"
 #else
 #  include "tcl.h"
 #endif
 #include <stdlib.h>
 #include <string.h>

 #ifndef SQLITE_OMIT_VIRTUALTABLE

 /*
 ** Characters that make up the idxStr created by xBestIndex for xFilter.
 */
 #define TCLVAR_NAME_EQ      'e'
 #define TCLVAR_NAME_MATCH   'm'
 #define TCLVAR_VALUE_GLOB   'g'
 #define TCLVAR_VALUE_REGEXP 'r'
 #define TCLVAR_VALUE_LIKE   'l'

 typedef struct tclvar_vtab tclvar_vtab;
 typedef struct tclvar_cursor tclvar_cursor;

 /*
 ** A tclvar virtual-table object
 */
 struct tclvar_vtab {
   sqlite3_vtab base;
   Tcl_Interp *interp;
 };

 /* A tclvar cursor object */
 struct tclvar_cursor {
   sqlite3_vtab_cursor base;

   Tcl_Obj *pList1;     /* Result of [info vars ?pattern?] */
   Tcl_Obj *pList2;     /* Result of [array names [lindex $pList1 $i1]] */
   int i1;              /* Current item in pList1 */
   int i2;              /* Current item (if any) in pList2 */
 };

 /* Methods for the tclvar module */
 static int tclvarConnect(
   sqlite3 *db,
   void *pAux,
   int argc, const char *const*argv,
   sqlite3_vtab **ppVtab,
   char **pzErr
 ){
   tclvar_vtab *pVtab;
   static const char zSchema[] =
      "CREATE TABLE x("
      "  name TEXT,"                       /* Base name */
      "  arrayname TEXT,"                  /* Array index */
      "  value TEXT,"                      /* Value */
      "  fullname TEXT PRIMARY KEY"        /* base(index) name */
      ") WITHOUT ROWID";
   pVtab = sqlite3MallocZero( sizeof(*pVtab) );
   if( pVtab==0 ) return SQLITE_NOMEM;
   *ppVtab = &pVtab->base;
   pVtab->interp = (Tcl_Interp *)pAux;
   sqlite3_declare_vtab(db, zSchema);
   return SQLITE_OK;
 }
 /* Note that for this virtual table, the xCreate and xConnect
 ** methods are identical. */

 static int tclvarDisconnect(sqlite3_vtab *pVtab){
   sqlite3_free(pVtab);
   return SQLITE_OK;
 }
 /* The xDisconnect and xDestroy methods are also the same */

 /*
 ** Open a new tclvar cursor.
 */
 static int tclvarOpen(sqlite3_vtab *pVTab, sqlite3_vtab_cursor **ppCursor){
   tclvar_cursor *pCur;
   pCur = sqlite3MallocZero(sizeof(tclvar_cursor));
   *ppCursor = &pCur->base;
   return SQLITE_OK;
 }

 /*
 ** Close a tclvar cursor.
 */
 static int tclvarClose(sqlite3_vtab_cursor *cur){
   tclvar_cursor *pCur = (tclvar_cursor *)cur;
   if( pCur->pList1 ){
     Tcl_DecrRefCount(pCur->pList1);
   }
   if( pCur->pList2 ){
     Tcl_DecrRefCount(pCur->pList2);
   }
   sqlite3_free(pCur);
   return SQLITE_OK;
 }

 /*
 ** Returns 1 if data is ready, or 0 if not.
 */
 static int next2(Tcl_Interp *interp, tclvar_cursor *pCur, Tcl_Obj *pObj){
   Tcl_Obj *p;

   if( pObj ){
     if( !pCur->pList2 ){
       p = Tcl_NewStringObj("array names", -1);
       Tcl_IncrRefCount(p);
       Tcl_ListObjAppendElement(0, p, pObj);
       Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
       Tcl_DecrRefCount(p);
       pCur->pList2 = Tcl_GetObjResult(interp);
       Tcl_IncrRefCount(pCur->pList2);
       assert( pCur->i2==0 );
     }else{
       int n = 0;
       pCur->i2++;
       Tcl_ListObjLength(0, pCur->pList2, &n);
       if( pCur->i2>=n ){
         Tcl_DecrRefCount(pCur->pList2);
         pCur->pList2 = 0;
         pCur->i2 = 0;
         return 0;
       }
     }
   }

   return 1;
 }

 static int tclvarNext(sqlite3_vtab_cursor *cur){
   Tcl_Obj *pObj;
   int n = 0;
   int ok = 0;

   tclvar_cursor *pCur = (tclvar_cursor *)cur;
   Tcl_Interp *interp = ((tclvar_vtab *)(cur->pVtab))->interp;

   Tcl_ListObjLength(0, pCur->pList1, &n);
   while( !ok && pCur->i1<n ){
     Tcl_ListObjIndex(0, pCur->pList1, pCur->i1, &pObj);
     ok = next2(interp, pCur, pObj);
     if( !ok ){
       pCur->i1++;
     }
   }

   return 0;
 }

 static int tclvarFilter(
   sqlite3_vtab_cursor *pVtabCursor,
   int idxNum, const char *idxStr,
   int argc, sqlite3_value **argv
 ){
   tclvar_cursor *pCur = (tclvar_cursor *)pVtabCursor;
   Tcl_Interp *interp = ((tclvar_vtab *)(pVtabCursor->pVtab))->interp;
   Tcl_Obj *p = Tcl_NewStringObj("tclvar_filter_cmd", -1);

   const char *zEq = "";
   const char *zMatch = "";
   const char *zGlob = "";
   const char *zRegexp = "";
   const char *zLike = "";
   int i;

   for(i=0; idxStr[i]; i++){
     switch( idxStr[i] ){
       case TCLVAR_NAME_EQ:
         zEq = (const char*)sqlite3_value_text(argv[i]);
         break;
       case TCLVAR_NAME_MATCH:
         zMatch = (const char*)sqlite3_value_text(argv[i]);
         break;
       case TCLVAR_VALUE_GLOB:
         zGlob = (const char*)sqlite3_value_text(argv[i]);
         break;
       case TCLVAR_VALUE_REGEXP:
         zRegexp = (const char*)sqlite3_value_text(argv[i]);
         break;
       case TCLVAR_VALUE_LIKE:
         zLike = (const char*)sqlite3_value_text(argv[i]);
         break;
       default:
         assert( 0 );
     }
   }

   Tcl_IncrRefCount(p);
   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zEq, -1));
   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zMatch, -1));
   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zGlob, -1));
   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zRegexp, -1));
   Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zLike, -1));

   Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
   if( pCur->pList1 ){
     Tcl_DecrRefCount(pCur->pList1);
   }
   if( pCur->pList2 ){
     Tcl_DecrRefCount(pCur->pList2);
     pCur->pList2 = 0;
   }
   pCur->i1 = 0;
   pCur->i2 = 0;
   pCur->pList1 = Tcl_GetObjResult(interp);
   Tcl_IncrRefCount(pCur->pList1);

   Tcl_DecrRefCount(p);
   return tclvarNext(pVtabCursor);
 }

 static int tclvarColumn(sqlite3_vtab_cursor *cur, sqlite3_context *ctx, int i){
   Tcl_Obj *p1;
   Tcl_Obj *p2;
   const char *z1;
   const char *z2 = "";
   tclvar_cursor *pCur = (tclvar_cursor*)cur;
   Tcl_Interp *interp = ((tclvar_vtab *)cur->pVtab)->interp;

   Tcl_ListObjIndex(interp, pCur->pList1, pCur->i1, &p1);
   Tcl_ListObjIndex(interp, pCur->pList2, pCur->i2, &p2);
   z1 = Tcl_GetString(p1);
   if( p2 ){
     z2 = Tcl_GetString(p2);
   }
   switch (i) {
     case 0: {
       sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
       break;
     }
     case 1: {
       sqlite3_result_text(ctx, z2, -1, SQLITE_TRANSIENT);
       break;
     }
     case 2: {
       Tcl_Obj *pVal = Tcl_GetVar2Ex(interp, z1, *z2?z2:0, TCL_GLOBAL_ONLY);
       sqlite3_result_text(ctx, Tcl_GetString(pVal), -1, SQLITE_TRANSIENT);
       break;
     }
     case 3: {
       char *z3;
       if( p2 ){
         z3 = sqlite3_mprintf("%s(%s)", z1, z2);
         sqlite3_result_text(ctx, z3, -1, sqlite3_free);
       }else{
         sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
       }
       break;
     }
   }
   return SQLITE_OK;
 }

 static int tclvarRowid(sqlite3_vtab_cursor *cur, sqlite_int64 *pRowid){
   *pRowid = 0;
   return SQLITE_OK;
 }

 static int tclvarEof(sqlite3_vtab_cursor *cur){
   tclvar_cursor *pCur = (tclvar_cursor*)cur;
   return (pCur->pList2?0:1);
 }

 /*
 ** If nul-terminated string zStr does not already contain the character
 ** passed as the second argument, append it and return 0. Or, if there is
 ** already an instance of x in zStr, do nothing return 1;
 **
 ** There is guaranteed to be enough room in the buffer pointed to by zStr
 ** for the new character and nul-terminator.
 */
 static int tclvarAddToIdxstr(char *zStr, char x){
   int i;
   for(i=0; zStr[i]; i++){
     if( zStr[i]==x ) return 1;
   }
   zStr[i] = x;
   zStr[i+1] = '\0';
   return 0;
 }

 /*
 ** Return true if variable $::tclvar_set_omit exists and is set to true.
 ** False otherwise.
 */
 static int tclvarSetOmit(Tcl_Interp *interp){
   int rc;
   int res = 0;
   Tcl_Obj *pRes;
   rc = Tcl_Eval(interp,
     "expr {[info exists ::tclvar_set_omit] && $::tclvar_set_omit}"
   );
   if( rc==TCL_OK ){
     pRes = Tcl_GetObjResult(interp);
     rc = Tcl_GetBooleanFromObj(0, pRes, &res);
   }
   return (rc==TCL_OK && res);
 }

 /*
 ** The xBestIndex() method. This virtual table supports the following
 ** operators:
 **
 **     name = ?                    (omit flag clear)
 **     name MATCH ?                (omit flag set)
 **     value GLOB ?                (omit flag set iff $::tclvar_set_omit)
 **     value REGEXP ?              (omit flag set iff $::tclvar_set_omit)
 **     value LIKE ?                (omit flag set iff $::tclvar_set_omit)
 **
 ** For each constraint present, the corresponding TCLVAR_XXX character is
 ** appended to the idxStr value.
 */
 static int tclvarBestIndex(sqlite3_vtab *tab, sqlite3_index_info *pIdxInfo){
   tclvar_vtab *pTab = (tclvar_vtab*)tab;
   int ii;
   char *zStr = sqlite3_malloc(32);
   int iStr = 0;

   if( zStr==0 ) return SQLITE_NOMEM;
   zStr[0] = '\0';

   for(ii=0; ii<pIdxInfo->nConstraint; ii++){
     struct sqlite3_index_constraint const *pCons = &pIdxInfo->aConstraint[ii];
     struct sqlite3_index_constraint_usage *pUsage;

     pUsage = &pIdxInfo->aConstraintUsage[ii];
     if( pCons->usable ){
       /* name = ? */
       if( pCons->op==SQLITE_INDEX_CONSTRAINT_EQ && pCons->iColumn==0 ){
         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_EQ) ){
           pUsage->argvIndex = ++iStr;
           pUsage->omit = 0;
         }
       }

       /* name MATCH ? */
       if( pCons->op==SQLITE_INDEX_CONSTRAINT_MATCH && pCons->iColumn==0 ){
         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_MATCH) ){
           pUsage->argvIndex = ++iStr;
           pUsage->omit = 1;
         }
       }

       /* value GLOB ? */
       if( pCons->op==SQLITE_INDEX_CONSTRAINT_GLOB && pCons->iColumn==2 ){
         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_GLOB) ){
           pUsage->argvIndex = ++iStr;
           pUsage->omit = tclvarSetOmit(pTab->interp);
         }
       }

       /* value REGEXP ? */
       if( pCons->op==SQLITE_INDEX_CONSTRAINT_REGEXP && pCons->iColumn==2 ){
         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_REGEXP) ){
           pUsage->argvIndex = ++iStr;
           pUsage->omit = tclvarSetOmit(pTab->interp);
         }
       }

       /* value LIKE ? */
       if( pCons->op==SQLITE_INDEX_CONSTRAINT_LIKE && pCons->iColumn==2 ){
         if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_LIKE) ){
           pUsage->argvIndex = ++iStr;
           pUsage->omit = tclvarSetOmit(pTab->interp);
         }
       }
     }
   }
   pIdxInfo->idxStr = zStr;
   pIdxInfo->needToFreeIdxStr = 1;

   return SQLITE_OK;
 }

 /*
 ** Invoked for any UPDATE, INSERT, or DELETE against a tclvar table
 */
 static int tclvarUpdate(
   sqlite3_vtab *tab,
   int argc,
   sqlite3_value **argv,
   sqlite_int64 *pRowid
 ){
   tclvar_vtab *pTab = (tclvar_vtab*)tab;
   if( argc==1 ){
     /* A DELETE operation.  The variable to be deleted is stored in argv[0] */
     const char *zVar = (const char*)sqlite3_value_text(argv[0]);
     Tcl_UnsetVar(pTab->interp, zVar, TCL_GLOBAL_ONLY);
     return SQLITE_OK;
   }
   if( sqlite3_value_type(argv[0])==SQLITE_NULL ){
     /* An INSERT operation */
     const char *zValue = (const char*)sqlite3_value_text(argv[4]);
     const char *zName;
     if( sqlite3_value_type(argv[5])!=SQLITE_TEXT ){
       tab->zErrMsg = sqlite3_mprintf("the 'fullname' column must be TEXT");
       return SQLITE_ERROR;
     }
     zName = (const char*)sqlite3_value_text(argv[5]);
     if( zValue ){
       Tcl_SetVar(pTab->interp, zName, zValue, TCL_GLOBAL_ONLY);
     }else{
       Tcl_UnsetVar(pTab->interp, zName, TCL_GLOBAL_ONLY);
     }
     return SQLITE_OK;
   }
   if( sqlite3_value_type(argv[0])==SQLITE_TEXT
    && sqlite3_value_type(argv[1])==SQLITE_TEXT
   ){
     /* An UPDATE operation */
     const char *zOldName = (const char*)sqlite3_value_text(argv[0]);
     const char *zNewName = (const char*)sqlite3_value_text(argv[1]);
     const char *zValue = (const char*)sqlite3_value_text(argv[4]);

     if( strcmp(zOldName, zNewName)!=0 || zValue==0 ){
       Tcl_UnsetVar(pTab->interp, zOldName, TCL_GLOBAL_ONLY);
     }
     if( zValue!=0 ){
       Tcl_SetVar(pTab->interp, zNewName, zValue, TCL_GLOBAL_ONLY);
     }
     return SQLITE_OK;
   }
   tab->zErrMsg = sqlite3_mprintf("prohibited TCL variable change");
   return SQLITE_ERROR;
 }

 /*
 ** A virtual table module that provides read-only access to a
 ** Tcl global variable namespace.
 */
 static sqlite3_module tclvarModule = {
   0,                         /* iVersion */
   tclvarConnect,
   tclvarConnect,
   tclvarBestIndex,
   tclvarDisconnect,
   tclvarDisconnect,
   tclvarOpen,                  /* xOpen - open a cursor */
   tclvarClose,                 /* xClose - close a cursor */
   tclvarFilter,                /* xFilter - configure scan constraints */
   tclvarNext,                  /* xNext - advance a cursor */
   tclvarEof,                   /* xEof - check for end of scan */
   tclvarColumn,                /* xColumn - read data */
   tclvarRowid,                 /* xRowid - read data */
   tclvarUpdate,                /* xUpdate */
   0,                           /* xBegin */
   0,                           /* xSync */
   0,                           /* xCommit */
   0,                           /* xRollback */
   0,                           /* xFindMethod */
   0,                           /* xRename */
 };

 /*
 ** Decode a pointer to an sqlite3 object.
 */
 extern int getDbPointer(Tcl_Interp *interp, const char *zA, sqlite3 **ppDb);

 /*
 ** Register the echo virtual table module.
 */
 static int SQLITE_TCLAPI register_tclvar_module(
   ClientData clientData, /* Pointer to sqlite3_enable_XXX function */
   Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
   int objc,              /* Number of arguments */
   Tcl_Obj *CONST objv[]  /* Command arguments */
 ){
   int rc = TCL_OK;
   sqlite3 *db;
   if( objc!=2 ){
     Tcl_WrongNumArgs(interp, 1, objv, "DB");
     return TCL_ERROR;
   }
   if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;
 #ifndef SQLITE_OMIT_VIRTUALTABLE
   sqlite3_create_module(db, "tclvar", &tclvarModule, (void*)interp);
   rc = Tcl_Eval(interp,
       "proc like {pattern str} {\n"
       "  set p [string map {% * _ ?} $pattern]\n"
       "  string match $p $str\n"
       "}\n"
       "proc tclvar_filter_cmd {eq match glob regexp like} {\n"
       "  set res {}\n"
       "  set pattern $eq\n"
       "  if {$pattern=={}} { set pattern $match }\n"
       "  if {$pattern=={}} { set pattern * }\n"
       "  foreach v [uplevel #0 info vars $pattern] {\n"
       "    if {($glob=={} || [string match $glob [uplevel #0 set $v]])\n"
       "     && ($like=={} || [like $like [uplevel #0 set $v]])\n"
       "     && ($regexp=={} || [regexp $regexp [uplevel #0 set $v]])\n"
       "    } {\n"
       "      lappend res $v\n"
       "    }\n"
       "  }\n"
       "  set res\n"
       "}\n"
   );
 #endif
   return rc;
 }

 #endif


 /*
 ** Register commands with the TCL interpreter.
 */
 int Sqlitetesttclvar_Init(Tcl_Interp *interp){
 #ifndef SQLITE_OMIT_VIRTUALTABLE
   static struct {
      char *zName;
      Tcl_ObjCmdProc *xProc;
      void *clientData;
   } aObjCmd[] = {
      { "register_tclvar_module",   register_tclvar_module, 0 },
   };
   int i;
   for(i=0; i<sizeof(aObjCmd)/sizeof(aObjCmd[0]); i++){
     Tcl_CreateObjCommand(interp, aObjCmd[i].zName,
         aObjCmd[i].xProc, aObjCmd[i].clientData, 0);
   }
 #endif
   return TCL_OK;
 }
	/*
	** 2006 June 13
	**
	** The author disclaims copyright to this source code. In place of
	** a legal notice, here is a blessing:
	**
	** May you do good and not evil.
	** May you find forgiveness for yourself and forgive others.
	** May you share freely, never taking more than you give.
	**
	*************************************************************************
	** Code for testing the virtual table interfaces. This code
	** is not included in the SQLite library. It is used for automated
	** testing of the SQLite library.
	**
	** The emphasis of this file is a virtual table that provides
	** access to TCL variables.
	**
	** The TCLVAR eponymous virtual table has a schema like this:
	**
	** CREATE TABLE tclvar(
	** name TEXT, -- base name of the variable: "x" in "$x(y)"
	** arrayname TEXT, -- array index name: "y" in "$x(y)"
	** value TEXT, -- the value of the variable
	** fullname TEXT, -- the full name of the variable
	** PRIMARY KEY(fullname)
	** ) WITHOUT ROWID;
	**
	** DELETE, INSERT, and UPDATE operations use the "fullname" field to
	** determine the variable to be modified. Changing "value" to NULL
	** deletes the variable.
	**
	** For SELECT operations, the "name" and "arrayname" fields will always
	** match the "fullname" field. For DELETE, INSERT, and UPDATE, the
	** "name" and "arrayname" fields are ignored and the variable is modified
	** according to "fullname" and "value" only.
	*/
	#include "sqliteInt.h"
	#if defined(INCLUDE_SQLITE_TCL_H)
	# include "sqlite_tcl.h"
	#else
	# include "tcl.h"
	#endif
	#include <stdlib.h>
	#include <string.h>

	#ifndef SQLITE_OMIT_VIRTUALTABLE

	/*
	** Characters that make up the idxStr created by xBestIndex for xFilter.
	*/
	#define TCLVAR_NAME_EQ 'e'
	#define TCLVAR_NAME_MATCH 'm'
	#define TCLVAR_VALUE_GLOB 'g'
	#define TCLVAR_VALUE_REGEXP 'r'
	#define TCLVAR_VALUE_LIKE 'l'

	typedef struct tclvar_vtab tclvar_vtab;
	typedef struct tclvar_cursor tclvar_cursor;

	/*
	** A tclvar virtual-table object
	*/
	struct tclvar_vtab {
	sqlite3_vtab base;
	Tcl_Interp *interp;
	};

	/* A tclvar cursor object */
	struct tclvar_cursor {
	sqlite3_vtab_cursor base;

	Tcl_Obj pList1; / Result of [info vars ?pattern?] */
	Tcl_Obj pList2; / Result of [array names [lindex $pList1 $i1]] */
	int i1; /* Current item in pList1 */
	int i2; /* Current item (if any) in pList2 */
	};

	/* Methods for the tclvar module */
	static int tclvarConnect(
	sqlite3 *db,
	void *pAux,
	int argc, const char constargv,
	sqlite3_vtab **ppVtab,
	char **pzErr
	){
	tclvar_vtab *pVtab;
	static const char zSchema[] =
	"CREATE TABLE x("
	" name TEXT," /* Base name */
	" arrayname TEXT," /* Array index */
	" value TEXT," /* Value */
	" fullname TEXT PRIMARY KEY" /* base(index) name */
	") WITHOUT ROWID";
	pVtab = sqlite3MallocZero( sizeof(*pVtab) );
	if( pVtab==0 ) return SQLITE_NOMEM;
	*ppVtab = &pVtab->base;
	pVtab->interp = (Tcl_Interp *)pAux;
	sqlite3_declare_vtab(db, zSchema);
	return SQLITE_OK;
	}
	/* Note that for this virtual table, the xCreate and xConnect
	** methods are identical. */

	static int tclvarDisconnect(sqlite3_vtab *pVtab){
	sqlite3_free(pVtab);
	return SQLITE_OK;
	}
	/* The xDisconnect and xDestroy methods are also the same */

	/*
	** Open a new tclvar cursor.
	*/
	static int tclvarOpen(sqlite3_vtab pVTab, sqlite3_vtab_cursor *ppCursor){
	tclvar_cursor *pCur;
	pCur = sqlite3MallocZero(sizeof(tclvar_cursor));
	*ppCursor = &pCur->base;
	return SQLITE_OK;
	}

	/*
	** Close a tclvar cursor.
	*/
	static int tclvarClose(sqlite3_vtab_cursor *cur){
	tclvar_cursor pCur = (tclvar_cursor )cur;
	if( pCur->pList1 ){
	Tcl_DecrRefCount(pCur->pList1);
	}
	if( pCur->pList2 ){
	Tcl_DecrRefCount(pCur->pList2);
	}
	sqlite3_free(pCur);
	return SQLITE_OK;
	}

	/*
	** Returns 1 if data is ready, or 0 if not.
	*/
	static int next2(Tcl_Interp interp, tclvar_cursor pCur, Tcl_Obj *pObj){
	Tcl_Obj *p;

	if( pObj ){
	if( !pCur->pList2 ){
	p = Tcl_NewStringObj("array names", -1);
	Tcl_IncrRefCount(p);
	Tcl_ListObjAppendElement(0, p, pObj);
	Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(p);
	pCur->pList2 = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(pCur->pList2);
	assert( pCur->i2==0 );
	}else{
	int n = 0;
	pCur->i2++;
	Tcl_ListObjLength(0, pCur->pList2, &n);
	if( pCur->i2>=n ){
	Tcl_DecrRefCount(pCur->pList2);
	pCur->pList2 = 0;
	pCur->i2 = 0;
	return 0;
	}
	}
	}

	return 1;
	}

	static int tclvarNext(sqlite3_vtab_cursor *cur){
	Tcl_Obj *pObj;
	int n = 0;
	int ok = 0;

	tclvar_cursor pCur = (tclvar_cursor )cur;
	Tcl_Interp interp = ((tclvar_vtab )(cur->pVtab))->interp;

	Tcl_ListObjLength(0, pCur->pList1, &n);
	while( !ok && pCur->i1<n ){
	Tcl_ListObjIndex(0, pCur->pList1, pCur->i1, &pObj);
	ok = next2(interp, pCur, pObj);
	if( !ok ){
	pCur->i1++;
	}
	}

	return 0;
	}

	static int tclvarFilter(
	sqlite3_vtab_cursor *pVtabCursor,
	int idxNum, const char *idxStr,
	int argc, sqlite3_value **argv
	){
	tclvar_cursor pCur = (tclvar_cursor )pVtabCursor;
	Tcl_Interp interp = ((tclvar_vtab )(pVtabCursor->pVtab))->interp;
	Tcl_Obj *p = Tcl_NewStringObj("tclvar_filter_cmd", -1);

	const char *zEq = "";
	const char *zMatch = "";
	const char *zGlob = "";
	const char *zRegexp = "";
	const char *zLike = "";
	int i;

	for(i=0; idxStr[i]; i++){
	switch( idxStr[i] ){
	case TCLVAR_NAME_EQ:
	zEq = (const char*)sqlite3_value_text(argv[i]);
	break;
	case TCLVAR_NAME_MATCH:
	zMatch = (const char*)sqlite3_value_text(argv[i]);
	break;
	case TCLVAR_VALUE_GLOB:
	zGlob = (const char*)sqlite3_value_text(argv[i]);
	break;
	case TCLVAR_VALUE_REGEXP:
	zRegexp = (const char*)sqlite3_value_text(argv[i]);
	break;
	case TCLVAR_VALUE_LIKE:
	zLike = (const char*)sqlite3_value_text(argv[i]);
	break;
	default:
	assert( 0 );
	}
	}

	Tcl_IncrRefCount(p);
	Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zEq, -1));
	Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zMatch, -1));
	Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zGlob, -1));
	Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zRegexp, -1));
	Tcl_ListObjAppendElement(0, p, Tcl_NewStringObj(zLike, -1));

	Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
	if( pCur->pList1 ){
	Tcl_DecrRefCount(pCur->pList1);
	}
	if( pCur->pList2 ){
	Tcl_DecrRefCount(pCur->pList2);
	pCur->pList2 = 0;
	}
	pCur->i1 = 0;
	pCur->i2 = 0;
	pCur->pList1 = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(pCur->pList1);

	Tcl_DecrRefCount(p);
	return tclvarNext(pVtabCursor);
	}

	static int tclvarColumn(sqlite3_vtab_cursor cur, sqlite3_context ctx, int i){
	Tcl_Obj *p1;
	Tcl_Obj *p2;
	const char *z1;
	const char *z2 = "";
	tclvar_cursor pCur = (tclvar_cursor)cur;
	Tcl_Interp interp = ((tclvar_vtab )cur->pVtab)->interp;

	Tcl_ListObjIndex(interp, pCur->pList1, pCur->i1, &p1);
	Tcl_ListObjIndex(interp, pCur->pList2, pCur->i2, &p2);
	z1 = Tcl_GetString(p1);
	if( p2 ){
	z2 = Tcl_GetString(p2);
	}
	switch (i) {
	case 0: {
	sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
	break;
	}
	case 1: {
	sqlite3_result_text(ctx, z2, -1, SQLITE_TRANSIENT);
	break;
	}
	case 2: {
	Tcl_Obj pVal = Tcl_GetVar2Ex(interp, z1, z2?z2:0, TCL_GLOBAL_ONLY);
	sqlite3_result_text(ctx, Tcl_GetString(pVal), -1, SQLITE_TRANSIENT);
	break;
	}
	case 3: {
	char *z3;
	if( p2 ){
	z3 = sqlite3_mprintf("%s(%s)", z1, z2);
	sqlite3_result_text(ctx, z3, -1, sqlite3_free);
	}else{
	sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
	}
	break;
	}
	}
	return SQLITE_OK;
	}

	static int tclvarRowid(sqlite3_vtab_cursor cur, sqlite_int64 pRowid){
	*pRowid = 0;
	return SQLITE_OK;
	}

	static int tclvarEof(sqlite3_vtab_cursor *cur){
	tclvar_cursor pCur = (tclvar_cursor)cur;
	return (pCur->pList2?0:1);
	}

	/*
	** If nul-terminated string zStr does not already contain the character
	** passed as the second argument, append it and return 0. Or, if there is
	** already an instance of x in zStr, do nothing return 1;
	**
	** There is guaranteed to be enough room in the buffer pointed to by zStr
	** for the new character and nul-terminator.
	*/
	static int tclvarAddToIdxstr(char *zStr, char x){
	int i;
	for(i=0; zStr[i]; i++){
	if( zStr[i]==x ) return 1;
	}
	zStr[i] = x;
	zStr[i+1] = '\0';
	return 0;
	}

	/*
	** Return true if variable $::tclvar_set_omit exists and is set to true.
	** False otherwise.
	*/
	static int tclvarSetOmit(Tcl_Interp *interp){
	int rc;
	int res = 0;
	Tcl_Obj *pRes;
	rc = Tcl_Eval(interp,
	"expr {[info exists ::tclvar_set_omit] && $::tclvar_set_omit}"
	);
	if( rc==TCL_OK ){
	pRes = Tcl_GetObjResult(interp);
	rc = Tcl_GetBooleanFromObj(0, pRes, &res);
	}
	return (rc==TCL_OK && res);
	}

	/*
	** The xBestIndex() method. This virtual table supports the following
	** operators:
	**
	** name = ? (omit flag clear)
	** name MATCH ? (omit flag set)
	** value GLOB ? (omit flag set iff $::tclvar_set_omit)
	** value REGEXP ? (omit flag set iff $::tclvar_set_omit)
	** value LIKE ? (omit flag set iff $::tclvar_set_omit)
	**
	** For each constraint present, the corresponding TCLVAR_XXX character is
	** appended to the idxStr value.
	*/
	static int tclvarBestIndex(sqlite3_vtab tab, sqlite3_index_info pIdxInfo){
	tclvar_vtab pTab = (tclvar_vtab)tab;
	int ii;
	char *zStr = sqlite3_malloc(32);
	int iStr = 0;

	if( zStr==0 ) return SQLITE_NOMEM;
	zStr[0] = '\0';

	for(ii=0; ii<pIdxInfo->nConstraint; ii++){
	struct sqlite3_index_constraint const *pCons = &pIdxInfo->aConstraint[ii];
	struct sqlite3_index_constraint_usage *pUsage;

	pUsage = &pIdxInfo->aConstraintUsage[ii];
	if( pCons->usable ){
	/* name = ? */
	if( pCons->op==SQLITE_INDEX_CONSTRAINT_EQ && pCons->iColumn==0 ){
	if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_EQ) ){
	pUsage->argvIndex = ++iStr;
	pUsage->omit = 0;
	}
	}

	/* name MATCH ? */
	if( pCons->op==SQLITE_INDEX_CONSTRAINT_MATCH && pCons->iColumn==0 ){
	if( 0==tclvarAddToIdxstr(zStr, TCLVAR_NAME_MATCH) ){
	pUsage->argvIndex = ++iStr;
	pUsage->omit = 1;
	}
	}

	/* value GLOB ? */
	if( pCons->op==SQLITE_INDEX_CONSTRAINT_GLOB && pCons->iColumn==2 ){
	if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_GLOB) ){
	pUsage->argvIndex = ++iStr;
	pUsage->omit = tclvarSetOmit(pTab->interp);
	}
	}

	/* value REGEXP ? */
	if( pCons->op==SQLITE_INDEX_CONSTRAINT_REGEXP && pCons->iColumn==2 ){
	if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_REGEXP) ){
	pUsage->argvIndex = ++iStr;
	pUsage->omit = tclvarSetOmit(pTab->interp);
	}
	}

	/* value LIKE ? */
	if( pCons->op==SQLITE_INDEX_CONSTRAINT_LIKE && pCons->iColumn==2 ){
	if( 0==tclvarAddToIdxstr(zStr, TCLVAR_VALUE_LIKE) ){
	pUsage->argvIndex = ++iStr;
	pUsage->omit = tclvarSetOmit(pTab->interp);
	}
	}
	}
	}
	pIdxInfo->idxStr = zStr;
	pIdxInfo->needToFreeIdxStr = 1;

	return SQLITE_OK;
	}

	/*
	** Invoked for any UPDATE, INSERT, or DELETE against a tclvar table
	*/
	static int tclvarUpdate(
	sqlite3_vtab *tab,
	int argc,
	sqlite3_value **argv,
	sqlite_int64 *pRowid
	){
	tclvar_vtab pTab = (tclvar_vtab)tab;
	if( argc==1 ){
	/* A DELETE operation. The variable to be deleted is stored in argv[0] */
	const char zVar = (const char)sqlite3_value_text(argv[0]);
	Tcl_UnsetVar(pTab->interp, zVar, TCL_GLOBAL_ONLY);
	return SQLITE_OK;
	}
	if( sqlite3_value_type(argv[0])==SQLITE_NULL ){
	/* An INSERT operation */
	const char zValue = (const char)sqlite3_value_text(argv[4]);
	const char *zName;
	if( sqlite3_value_type(argv[5])!=SQLITE_TEXT ){
	tab->zErrMsg = sqlite3_mprintf("the 'fullname' column must be TEXT");
	return SQLITE_ERROR;
	}
	zName = (const char*)sqlite3_value_text(argv[5]);
	if( zValue ){
	Tcl_SetVar(pTab->interp, zName, zValue, TCL_GLOBAL_ONLY);
	}else{
	Tcl_UnsetVar(pTab->interp, zName, TCL_GLOBAL_ONLY);
	}
	return SQLITE_OK;
	}
	if( sqlite3_value_type(argv[0])==SQLITE_TEXT
	&& sqlite3_value_type(argv[1])==SQLITE_TEXT
	){
	/* An UPDATE operation */
	const char zOldName = (const char)sqlite3_value_text(argv[0]);
	const char zNewName = (const char)sqlite3_value_text(argv[1]);
	const char zValue = (const char)sqlite3_value_text(argv[4]);

	if( strcmp(zOldName, zNewName)!=0 \|\| zValue==0 ){
	Tcl_UnsetVar(pTab->interp, zOldName, TCL_GLOBAL_ONLY);
	}
	if( zValue!=0 ){
	Tcl_SetVar(pTab->interp, zNewName, zValue, TCL_GLOBAL_ONLY);
	}
	return SQLITE_OK;
	}
	tab->zErrMsg = sqlite3_mprintf("prohibited TCL variable change");
	return SQLITE_ERROR;
	}

	/*
	** A virtual table module that provides read-only access to a
	** Tcl global variable namespace.
	*/
	static sqlite3_module tclvarModule = {
	0, /* iVersion */
	tclvarConnect,
	tclvarConnect,
	tclvarBestIndex,
	tclvarDisconnect,
	tclvarDisconnect,
	tclvarOpen, /* xOpen - open a cursor */
	tclvarClose, /* xClose - close a cursor */
	tclvarFilter, /* xFilter - configure scan constraints */
	tclvarNext, /* xNext - advance a cursor */
	tclvarEof, /* xEof - check for end of scan */
	tclvarColumn, /* xColumn - read data */
	tclvarRowid, /* xRowid - read data */
	tclvarUpdate, /* xUpdate */
	0, /* xBegin */
	0, /* xSync */
	0, /* xCommit */
	0, /* xRollback */
	0, /* xFindMethod */
	0, /* xRename */
	};

	/*
	** Decode a pointer to an sqlite3 object.
	*/
	extern int getDbPointer(Tcl_Interp interp, const char zA, sqlite3 **ppDb);

	/*
	** Register the echo virtual table module.
	*/
	static int SQLITE_TCLAPI register_tclvar_module(
	ClientData clientData, /* Pointer to sqlite3_enable_XXX function */
	Tcl_Interp interp, / The TCL interpreter that invoked this command */
	int objc, /* Number of arguments */
	Tcl_Obj CONST objv[] / Command arguments */
	){
	int rc = TCL_OK;
	sqlite3 *db;
	if( objc!=2 ){
	Tcl_WrongNumArgs(interp, 1, objv, "DB");
	return TCL_ERROR;
	}
	if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;
	#ifndef SQLITE_OMIT_VIRTUALTABLE
	sqlite3_create_module(db, "tclvar", &tclvarModule, (void*)interp);
	rc = Tcl_Eval(interp,
	"proc like {pattern str} {\n"
	" set p [string map {% * _ ?} $pattern]\n"
	" string match $p $str\n"
	"}\n"
	"proc tclvar_filter_cmd {eq match glob regexp like} {\n"
	" set res {}\n"
	" set pattern $eq\n"
	" if {$pattern=={}} { set pattern $match }\n"
	" if {$pattern=={}} { set pattern * }\n"
	" foreach v [uplevel #0 info vars $pattern] {\n"
	" if {($glob=={} \|\| [string match $glob [uplevel #0 set $v]])\n"
	" && ($like=={} \|\| [like $like [uplevel #0 set $v]])\n"
	" && ($regexp=={} \|\| [regexp $regexp [uplevel #0 set $v]])\n"
	" } {\n"
	" lappend res $v\n"
	" }\n"
	" }\n"
	" set res\n"
	"}\n"
	);
	#endif
	return rc;
	}

	#endif


	/*
	** Register commands with the TCL interpreter.
	*/
	int Sqlitetesttclvar_Init(Tcl_Interp *interp){
	#ifndef SQLITE_OMIT_VIRTUALTABLE
	static struct {
	char *zName;
	Tcl_ObjCmdProc *xProc;
	void *clientData;
	} aObjCmd[] = {
	{ "register_tclvar_module", register_tclvar_module, 0 },
	};
	int i;
	for(i=0; i<sizeof(aObjCmd)/sizeof(aObjCmd[0]); i++){
	Tcl_CreateObjCommand(interp, aObjCmd[i].zName,
	aObjCmd[i].xProc, aObjCmd[i].clientData, 0);
	}
	#endif
	return TCL_OK;
	}