-C Documentation\sfixes.\s\sTicket\s#1306.\s(CVS\s2529)
-D 2005-06-25T19:42:38
+C Tcl\sinterface\suses\sTcl_Objs\sto\simplement\suser-defined\sfunctions,\sthus\sallowing\nBLOB\svalues\sto\sbe\stransferred\scorrectly.\s\sTicket\s#1304.\s(CVS\s2530)
+D 2005-06-26T17:55:34
F Makefile.in 64a6635ef44a98325e0cffe8d67669920a3dad47
F Makefile.linux-gcc 06be33b2a9ad4f005a5f42b22c4a19dab3cbb5c7
F README 9c4e2d6706bdcc3efdd773ce752a8cdab4f90028
F src/sqlite.h.in e06d5774e9cfa5962376ae988300a9f114a3e3d7
F src/sqliteInt.h 2135a5bab820af868bf308f51cdf1adbcb3a85b7
F src/table.c 25b3ff2b39b7d87e8d4a5da0713d68dfc06cbee9
-F src/tclsqlite.c 9b84e9e612ed573ee664e12bda62c7511e7b7746
+F src/tclsqlite.c cccaf6b78c290d824cf8ea089b8b27377e545830
F src/test1.c b2885afb71c93e49db6a36f101fe38c71e7e3d6c
F src/test2.c 716c1809dba8e5be6093703e9cada99d627542dc
F src/test3.c 683e1e3819152ffd35da2f201e507228921148d0
F src/vdbe.c 56e892e351eb3ed634c3c239e4ad5c03aecfc2bf
F src/vdbe.h 75e466d84d362b0c4498978a9d6b1e6bd32ecf3b
F src/vdbeInt.h 4312faf41630a6c215924b6c7c2f39ebb1af8ffb
-F src/vdbeapi.c 5025a9163107e0a4964212d16e1c4defa13dc5c2
+F src/vdbeapi.c 7f392f0792d1258c958083d7de9eae7c3530c9a6
F src/vdbeaux.c 38332d91887817a2146f46b58fff2a8a88ed0278
F src/vdbemem.c da8e8d6f29dd1323f782f000d7cd120027c9ff03
F src/where.c 3a9a2258ab3364655e9ea215ad5ae7bf41813f54
F test/subselect.test 3f3f7a940dc3195c3139f4d530385cb54665d614
F test/table.test e87fb2211b97c6a3a367fbc116e8572091b53160
F test/tableapi.test 6a66d58b37d46dc0f2b3c7d4bd2617d209399bd1
-F test/tclsqlite.test 7593733310c1d89f0b63c84fb155104ad948135c
+F test/tclsqlite.test faa15080060c39c9d6caa7e067c35e0ab3d4e793
F test/temptable.test c71eeffe8af807f76eafdc5a39824639a1e301df
F test/tester.tcl 98ecdc5723b3b2be5a8a5c3a7f38fa53031466ee
F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
F www/version3.tcl a99cf5f6d8bd4d5537584a2b342f0fb9fa601d8b
F www/whentouse.tcl 528299b8316726dbcc5548e9aa0648c8b1bd055b
-P 8c99dca60aebee0ec5de9ed11350de864bc76584
-R f298a28bc4d82dbd5adfaab265db9284
+P 3dcdb7942ea9a9e5d708a198ba5183103d5075d9
+R 921bd56e87c8fac8c240733a327a399e
U drh
-Z e8b0b3df38f0878df8807440d3147bbe
+Z 2d49decf778ceb912dc5c67c477d786e
*************************************************************************
** A TCL Interface to SQLite
**
-** $Id: tclsqlite.c,v 1.126 2005/06/25 19:31:48 drh Exp $
+** $Id: tclsqlite.c,v 1.127 2005/06/26 17:55:34 drh Exp $
*/
#ifndef NO_TCL /* Omit this whole file if TCL is unavailable */
#include <stdlib.h>
#include <string.h>
#include <assert.h>
+#include <ctype.h>
#define NUM_PREPARED_STMTS 10
#define MAX_PREPARED_STMTS 100
typedef struct SqlFunc SqlFunc;
struct SqlFunc {
Tcl_Interp *interp; /* The TCL interpret to execute the function */
- char *zScript; /* The script to be run */
+ Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
+ int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
+ char *zName; /* Name of this function */
SqlFunc *pNext; /* Next function on the list of them all */
};
struct SqlCollate {
Tcl_Interp *interp; /* The TCL interpret to execute the function */
char *zScript; /* The script to be run */
- SqlCollate *pNext; /* Next function on the list of them all */
+ SqlCollate *pNext; /* Next function on the list of them all */
};
/*
*/
typedef struct SqliteDb SqliteDb;
struct SqliteDb {
- sqlite3 *db; /* The "real" database structure */
- Tcl_Interp *interp; /* The interpreter used for this database */
- char *zBusy; /* The busy callback routine */
- char *zCommit; /* The commit hook callback routine */
- char *zTrace; /* The trace callback routine */
- char *zProgress; /* The progress callback routine */
- char *zAuth; /* The authorization callback routine */
- char *zNull; /* Text to substitute for an SQL NULL value */
- SqlFunc *pFunc; /* List of SQL functions */
- SqlCollate *pCollate; /* List of SQL collation functions */
- int rc; /* Return code of most recent sqlite3_exec() */
- Tcl_Obj *pCollateNeeded; /* Collation needed script */
+ sqlite3 *db; /* The "real" database structure */
+ Tcl_Interp *interp; /* The interpreter used for this database */
+ char *zBusy; /* The busy callback routine */
+ char *zCommit; /* The commit hook callback routine */
+ char *zTrace; /* The trace callback routine */
+ char *zProgress; /* The progress callback routine */
+ char *zAuth; /* The authorization callback routine */
+ char *zNull; /* Text to substitute for an SQL NULL value */
+ SqlFunc *pFunc; /* List of SQL functions */
+ SqlCollate *pCollate; /* List of SQL collation functions */
+ int rc; /* Return code of most recent sqlite3_exec() */
+ Tcl_Obj *pCollateNeeded; /* Collation needed script */
SqlPreparedStmt *stmtList; /* List of prepared statements*/
SqlPreparedStmt *stmtLast; /* Last statement in the list */
int maxStmt; /* The next maximum number of stmtList */
int nStmt; /* Number of statements in stmtList */
};
+/*
+** Look at the script prefix in pCmd. We will be executing this script
+** after first appending one or more arguments. This routine analyzes
+** the script to see if it is safe to use Tcl_EvalObjv() on the script
+** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
+** faster.
+**
+** Scripts that are safe to use with Tcl_EvalObjv() consists of a
+** command name followed by zero or more arguments with no [...] or $
+** or {...} or ; to be seen anywhere. Most callback scripts consist
+** of just a single procedure name and they meet this requirement.
+*/
+static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
+ /* We could try to do something with Tcl_Parse(). But we will instead
+ ** just do a search for forbidden characters. If any of the forbidden
+ ** characters appear in pCmd, we will report the string as unsafe.
+ */
+ const char *z;
+ int n;
+ z = Tcl_GetStringFromObj(pCmd, &n);
+ while( n-- > 0 ){
+ int c = *(z++);
+ if( c=='$' || c=='[' || c==';' ) return 0;
+ }
+ return 1;
+}
+
+/*
+** Find an SqlFunc structure with the given name. Or create a new
+** one if an existing one cannot be found. Return a pointer to the
+** structure.
+*/
+static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
+ SqlFunc *p, *pNew;
+ int i;
+ pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );
+ pNew->zName = (char*)&pNew[1];
+ for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
+ pNew->zName[i] = 0;
+ for(p=pDb->pFunc; p; p=p->pNext){
+ if( strcmp(p->zName, pNew->zName)==0 ){
+ Tcl_Free((char*)pNew);
+ return p;
+ }
+ }
+ pNew->interp = pDb->interp;
+ pNew->pScript = 0;
+ pNew->pNext = pDb->pFunc;
+ pDb->pFunc = pNew;
+ return pNew;
+}
+
/*
** Finalize and free a list of prepared statements
*/
while( pDb->pFunc ){
SqlFunc *pFunc = pDb->pFunc;
pDb->pFunc = pFunc->pNext;
+ Tcl_DecrRefCount(pFunc->pScript);
Tcl_Free((char*)pFunc);
}
while( pDb->pCollate ){
SqliteDb *pDb = (SqliteDb*)cd;
int rc;
char zVal[30];
- char *zCmd;
- Tcl_DString cmd;
- Tcl_DStringInit(&cmd);
- Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
sprintf(zVal, "%d", nTries);
- Tcl_DStringAppendElement(&cmd, zVal);
- zCmd = Tcl_DStringValue(&cmd);
- rc = Tcl_Eval(pDb->interp, zCmd);
- Tcl_DStringFree(&cmd);
+ rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
return 0;
}
Tcl_IncrRefCount(pCmd);
Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
- Tcl_EvalObjEx(p->interp, pCmd, 0);
+ Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
Tcl_DecrRefCount(pCmd);
return (atoi(Tcl_GetStringResult(p->interp)));
}
*/
static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
SqlFunc *p = sqlite3_user_data(context);
- Tcl_DString cmd;
+ Tcl_Obj *pCmd;
int i;
int rc;
- Tcl_DStringInit(&cmd);
- Tcl_DStringAppend(&cmd, p->zScript, -1);
- for(i=0; i<argc; i++){
- if( SQLITE_NULL==sqlite3_value_type(argv[i]) ){
- Tcl_DStringAppendElement(&cmd, "");
- }else{
- Tcl_DStringAppendElement(&cmd, sqlite3_value_text(argv[i]));
+ if( argc==0 ){
+ /* If there are no arguments to the function, call Tcl_EvalObjEx on the
+ ** script object directly. This allows the TCL compiler to generate
+ ** bytecode for the command on the first invocation and thus make
+ ** subsequent invocations much faster. */
+ pCmd = p->pScript;
+ Tcl_IncrRefCount(pCmd);
+ rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
+ Tcl_DecrRefCount(pCmd);
+ }else{
+ /* If there are arguments to the function, make a shallow copy of the
+ ** script object, lappend the arguments, then evaluate the copy.
+ **
+ ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
+ ** The new Tcl_Obj contains pointers to the original list elements.
+ ** That way, when Tcl_EvalObjv() is run and shimmers the first element
+ ** of the list to tclCmdNameType, that alternate representation will
+ ** be preserved and reused on the next invocation.
+ */
+ Tcl_Obj **aArg;
+ int nArg;
+ if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
+ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
+ return;
+ }
+ pCmd = Tcl_NewListObj(nArg, aArg);
+ Tcl_IncrRefCount(pCmd);
+ for(i=0; i<argc; i++){
+ sqlite3_value *pIn = argv[i];
+ Tcl_Obj *pVal;
+
+ /* Set pVal to contain the i'th column of this row. */
+ switch( sqlite3_value_type(pIn) ){
+ case SQLITE_BLOB: {
+ int bytes = sqlite3_value_bytes(pIn);
+ pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
+ break;
+ }
+ case SQLITE_INTEGER: {
+ sqlite_int64 v = sqlite3_value_int64(pIn);
+ if( v>=-2147483647 && v<=2147483647 ){
+ pVal = Tcl_NewIntObj(v);
+ }else{
+ pVal = Tcl_NewWideIntObj(v);
+ }
+ break;
+ }
+ case SQLITE_FLOAT: {
+ double r = sqlite3_value_double(pIn);
+ pVal = Tcl_NewDoubleObj(r);
+ break;
+ }
+ case SQLITE_NULL: {
+ pVal = Tcl_NewStringObj("", 0);
+ break;
+ }
+ default: {
+ int bytes = sqlite3_value_bytes(pIn);
+ pVal = Tcl_NewStringObj(sqlite3_value_text(pIn), bytes);
+ break;
+ }
+ }
+ rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
+ if( rc ){
+ Tcl_DecrRefCount(pCmd);
+ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
+ return;
+ }
+ }
+ if( !p->useEvalObjv ){
+ /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
+ ** is a list without a string representation. To prevent this from
+ ** happening, make sure pCmd has a valid string representation */
+ Tcl_GetString(pCmd);
}
+ rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
+ Tcl_DecrRefCount(pCmd);
}
- rc = Tcl_EvalEx(p->interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
- TCL_EVAL_DIRECT);
- Tcl_DStringFree(&cmd);
if( rc && rc!=TCL_RETURN ){
sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
char *zType = pVar->typePtr ? pVar->typePtr->name : "";
char c = zType[0];
if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
- /* Only load a BLOB type if the Tcl variable is a bytearray and
+ /* Only return a BLOB type if the Tcl variable is a bytearray and
** has no string representation. */
data = Tcl_GetByteArrayFromObj(pVar, &n);
sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
*/
case DB_FUNCTION: {
SqlFunc *pFunc;
+ Tcl_Obj *pScript;
char *zName;
- char *zScript;
- int nScript;
if( objc!=4 ){
Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
return TCL_ERROR;
}
zName = Tcl_GetStringFromObj(objv[2], 0);
- zScript = Tcl_GetStringFromObj(objv[3], &nScript);
- pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
+ pScript = objv[3];
+ pFunc = findSqlFunc(pDb, zName);
if( pFunc==0 ) return TCL_ERROR;
- pFunc->interp = interp;
- pFunc->pNext = pDb->pFunc;
- pFunc->zScript = (char*)&pFunc[1];
- pDb->pFunc = pFunc;
- strcpy(pFunc->zScript, zScript);
+ if( pFunc->pScript ){
+ Tcl_DecrRefCount(pFunc->pScript);
+ }
+ pFunc->pScript = pScript;
+ Tcl_IncrRefCount(pScript);
+ pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
pFunc, tclSqlFunc, 0, 0);
if( rc!=SQLITE_OK ){