/*

** 2001 September 15

**

** 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.

**

*************************************************************************

** A TCL Interface to SQLite. Append this file to sqlite3.c and

** compile the whole thing to build a TCL-enabled version of SQLite.

**

** Compile-time options:

**

** -DTCLSH Add a "main()" routine that works as a tclsh.

**

** -DTCLSH_INIT_PROC=name

**

** Invoke name(interp) to initialize the Tcl interpreter.

** If name(interp) returns a non-NULL string, then run

** that string as a Tcl script to launch the application.

** If name(interp) returns NULL, then run the regular

** tclsh-emulator code.

*/

#ifdef TCLSH_INIT_PROC

# define TCLSH 1

#endif

/*

** If requested, include the SQLite compiler options file for MSVC.

*/

#if defined(INCLUDE_MSVC_H)

# include "msvc.h"

#endif

#if defined(INCLUDE_SQLITE_TCL_H)

# include "sqlite_tcl.h"

#else

# include "tcl.h"

# ifndef SQLITE_TCLAPI

# define SQLITE_TCLAPI

# endif

#endif

#include <errno.h>

/*

** Some additional include files are needed if this file is not

** appended to the amalgamation.

*/

#ifndef SQLITE_AMALGAMATION

# include "sqlite3.h"

# include <stdlib.h>

# include <string.h>

# include <assert.h>

typedef unsigned char u8;

#endif

#include <ctype.h>

/* Used to get the current process ID */

#if !defined(_WIN32)

# include <unistd.h>

# define GETPID getpid

#elif !defined(_WIN32_WCE)

# ifndef SQLITE_AMALGAMATION

# ifndef WIN32_LEAN_AND_MEAN

# define WIN32_LEAN_AND_MEAN

# endif

# include <windows.h>

# endif

# define GETPID (int)GetCurrentProcessId

#endif

/*

* Windows needs to know which symbols to export. Unix does not.

* BUILD_sqlite should be undefined for Unix.

*/

#ifdef BUILD_sqlite

#undef TCL_STORAGE_CLASS

#define TCL_STORAGE_CLASS DLLEXPORT

#endif /* BUILD_sqlite */

#define NUM_PREPARED_STMTS 10

#define MAX_PREPARED_STMTS 100

/* Forward declaration */

typedef struct SqliteDb SqliteDb;

/*

** New SQL functions can be created as TCL scripts. Each such function

** is described by an instance of the following structure.

*/

typedef struct SqlFunc SqlFunc;

struct SqlFunc {

Tcl_Interp *interp; /* The TCL interpret to execute the function */

Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */

SqliteDb *pDb; /* Database connection that owns this function */

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 */

};

/*

** New collation sequences function can be created as TCL scripts. Each such

** function is described by an instance of the following structure.

*/

typedef struct SqlCollate SqlCollate;

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 */

};

/*

** Prepared statements are cached for faster execution. Each prepared

** statement is described by an instance of the following structure.

*/

typedef struct SqlPreparedStmt SqlPreparedStmt;

struct SqlPreparedStmt {

SqlPreparedStmt *pNext; /* Next in linked list */

SqlPreparedStmt *pPrev; /* Previous on the list */

sqlite3_stmt *pStmt; /* The prepared statement */

int nSql; /* chars in zSql[] */

const char *zSql; /* Text of the SQL statement */

int nParm; /* Size of apParm array */

Tcl_Obj **apParm; /* Array of referenced object pointers */

};

typedef struct IncrblobChannel IncrblobChannel;

/*

** There is one instance of this structure for each SQLite database

** that has been opened by the SQLite TCL interface.

**

** If this module is built with SQLITE_TEST defined (to create the SQLite

** testfixture executable), then it may be configured to use either

** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.

** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.

*/

struct SqliteDb {

sqlite3 *db; /* The "real" database structure. MUST BE FIRST */

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 *zTraceV2; /* The trace_v2 callback routine */

char *zProfile; /* The profile callback routine */

char *zProgress; /* The progress callback routine */

char *zAuth; /* The authorization callback routine */

int disableAuth; /* Disable the authorizer if it exists */

char *zNull; /* Text to substitute for an SQL NULL value */

SqlFunc *pFunc; /* List of SQL functions */

Tcl_Obj *pUpdateHook; /* Update hook script (if any) */

Tcl_Obj *pPreUpdateHook; /* Pre-update hook script (if any) */

Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */

Tcl_Obj *pWalHook; /* WAL hook script (if any) */

Tcl_Obj *pUnlockNotify; /* Unlock notify script (if any) */

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 */

IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */

int nStep, nSort, nIndex; /* Statistics for most recent operation */

int nVMStep; /* Another statistic for most recent operation */

int nTransaction; /* Number of nested [transaction] methods */

int openFlags; /* Flags used to open. (SQLITE_OPEN_URI) */

#ifdef SQLITE_TEST

int bLegacyPrepare; /* True to use sqlite3_prepare() */

#endif

};

struct IncrblobChannel {

sqlite3_blob *pBlob; /* sqlite3 blob handle */

SqliteDb *pDb; /* Associated database connection */

int iSeek; /* Current seek offset */

Tcl_Channel channel; /* Channel identifier */

IncrblobChannel *pNext; /* Linked list of all open incrblob channels */

IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */

};

/*

** Compute a string length that is limited to what can be stored in

** lower 30 bits of a 32-bit signed integer.

*/

static int strlen30(const char *z){

const char *z2 = z;

while( *z2 ){ z2++; }

return 0x3fffffff & (int)(z2 - z);

}

#ifndef SQLITE_OMIT_INCRBLOB

/*

** Close all incrblob channels opened using database connection pDb.

** This is called when shutting down the database connection.

*/

static void closeIncrblobChannels(SqliteDb *pDb){

IncrblobChannel *p;

IncrblobChannel *pNext;

for(p=pDb->pIncrblob; p; p=pNext){

pNext = p->pNext;

/* Note: Calling unregister here call Tcl_Close on the incrblob channel,

** which deletes the IncrblobChannel structure at *p. So do not

** call Tcl_Free() here.

*/

Tcl_UnregisterChannel(pDb->interp, p->channel);

}

}

/*

** Close an incremental blob channel.

*/

static int SQLITE_TCLAPI incrblobClose(

ClientData instanceData,

Tcl_Interp *interp

){

IncrblobChannel *p = (IncrblobChannel *)instanceData;

int rc = sqlite3_blob_close(p->pBlob);

sqlite3 *db = p->pDb->db;

/* Remove the channel from the SqliteDb.pIncrblob list. */

if( p->pNext ){

p->pNext->pPrev = p->pPrev;

}

if( p->pPrev ){

p->pPrev->pNext = p->pNext;

}

if( p->pDb->pIncrblob==p ){

p->pDb->pIncrblob = p->pNext;

}

/* Free the IncrblobChannel structure */

Tcl_Free((char *)p);

if( rc!=SQLITE_OK ){

Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);

return TCL_ERROR;

}

return TCL_OK;

}

/*

** Read data from an incremental blob channel.

*/

static int SQLITE_TCLAPI incrblobInput(

ClientData instanceData,

char *buf,

int bufSize,

int *errorCodePtr

){

IncrblobChannel *p = (IncrblobChannel *)instanceData;

int nRead = bufSize; /* Number of bytes to read */

int nBlob; /* Total size of the blob */

int rc; /* sqlite error code */

nBlob = sqlite3_blob_bytes(p->pBlob);

if( (p->iSeek+nRead)>nBlob ){

nRead = nBlob-p->iSeek;

}

if( nRead<=0 ){

return 0;

}

rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);

if( rc!=SQLITE_OK ){

*errorCodePtr = rc;

return -1;

}

p->iSeek += nRead;

return nRead;

}

/*

** Write data to an incremental blob channel.

*/

static int SQLITE_TCLAPI incrblobOutput(

ClientData instanceData,

CONST char *buf,

int toWrite,

int *errorCodePtr

){

IncrblobChannel *p = (IncrblobChannel *)instanceData;

int nWrite = toWrite; /* Number of bytes to write */

int nBlob; /* Total size of the blob */

int rc; /* sqlite error code */

nBlob = sqlite3_blob_bytes(p->pBlob);

if( (p->iSeek+nWrite)>nBlob ){

*errorCodePtr = EINVAL;

return -1;

}

if( nWrite<=0 ){

return 0;

}

rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);

if( rc!=SQLITE_OK ){

*errorCodePtr = EIO;

return -1;

}

p->iSeek += nWrite;

return nWrite;

}

/*

** Seek an incremental blob channel.

*/

static int SQLITE_TCLAPI incrblobSeek(

ClientData instanceData,

long offset,

int seekMode,

int *errorCodePtr

){

IncrblobChannel *p = (IncrblobChannel *)instanceData;

switch( seekMode ){

case SEEK_SET:

p->iSeek = offset;

break;

case SEEK_CUR:

p->iSeek += offset;

break;

case SEEK_END:

p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;

break;

default: assert(!"Bad seekMode");

}

return p->iSeek;

}

static void SQLITE_TCLAPI incrblobWatch(

ClientData instanceData,

int mode

){

/* NO-OP */

}

static int SQLITE_TCLAPI incrblobHandle(

ClientData instanceData,

int dir,

ClientData *hPtr

){

return TCL_ERROR;

}

static Tcl_ChannelType IncrblobChannelType = {

"incrblob", /* typeName */

TCL_CHANNEL_VERSION_2, /* version */

incrblobClose, /* closeProc */

incrblobInput, /* inputProc */

incrblobOutput, /* outputProc */

incrblobSeek, /* seekProc */

0, /* setOptionProc */

0, /* getOptionProc */

incrblobWatch, /* watchProc (this is a no-op) */

incrblobHandle, /* getHandleProc (always returns error) */

0, /* close2Proc */

0, /* blockModeProc */

0, /* flushProc */

0, /* handlerProc */

0, /* wideSeekProc */

};

/*

** Create a new incrblob channel.

*/

static int createIncrblobChannel(

Tcl_Interp *interp,

SqliteDb *pDb,

const char *zDb,

const char *zTable,

const char *zColumn,

sqlite_int64 iRow,

int isReadonly

){

IncrblobChannel *p;

sqlite3 *db = pDb->db;

sqlite3_blob *pBlob;

int rc;

int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);

/* This variable is used to name the channels: "incrblob_[incr count]" */

static int count = 0;

char zChannel[64];

rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);

if( rc!=SQLITE_OK ){

Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);

return TCL_ERROR;

}

p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));

p->iSeek = 0;

p->pBlob = pBlob;

sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);

p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);

Tcl_RegisterChannel(interp, p->channel);

/* Link the new channel into the SqliteDb.pIncrblob list. */

p->pNext = pDb->pIncrblob;

p->pPrev = 0;

if( p->pNext ){

p->pNext->pPrev = p;

}

pDb->pIncrblob = p;

p->pDb = pDb;

Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);

return TCL_OK;

}

#else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */

#define closeIncrblobChannels(pDb)

#endif

/*

** 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 nName = strlen30(zName);

pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );

pNew->zName = (char*)&pNew[1];

memcpy(pNew->zName, zName, nName+1);

for(p=pDb->pFunc; p; p=p->pNext){

if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){

Tcl_Free((char*)pNew);

return p;

}

}

pNew->interp = pDb->interp;

pNew->pDb = pDb;

pNew->pScript = 0;

pNew->pNext = pDb->pFunc;

pDb->pFunc = pNew;

return pNew;

}

/*

** Free a single SqlPreparedStmt object.

*/

static void dbFreeStmt(SqlPreparedStmt *pStmt){

#ifdef SQLITE_TEST

if( sqlite3_sql(pStmt->pStmt)==0 ){

Tcl_Free((char *)pStmt->zSql);

}

#endif

sqlite3_finalize(pStmt->pStmt);

Tcl_Free((char *)pStmt);

}

/*

** Finalize and free a list of prepared statements

*/

static void flushStmtCache(SqliteDb *pDb){

SqlPreparedStmt *pPreStmt;

SqlPreparedStmt *pNext;

for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){

pNext = pPreStmt->pNext;

dbFreeStmt(pPreStmt);

}

pDb->nStmt = 0;

pDb->stmtLast = 0;

pDb->stmtList = 0;

}

/*

** TCL calls this procedure when an sqlite3 database command is

** deleted.

*/

static void SQLITE_TCLAPI DbDeleteCmd(void *db){

SqliteDb *pDb = (SqliteDb*)db;

flushStmtCache(pDb);

closeIncrblobChannels(pDb);

sqlite3_close(pDb->db);

while( pDb->pFunc ){

SqlFunc *pFunc = pDb->pFunc;

pDb->pFunc = pFunc->pNext;

assert( pFunc->pDb==pDb );

Tcl_DecrRefCount(pFunc->pScript);

Tcl_Free((char*)pFunc);

}

while( pDb->pCollate ){

SqlCollate *pCollate = pDb->pCollate;

pDb->pCollate = pCollate->pNext;

Tcl_Free((char*)pCollate);

}

if( pDb->zBusy ){

Tcl_Free(pDb->zBusy);

}

if( pDb->zTrace ){

Tcl_Free(pDb->zTrace);

}

if( pDb->zTraceV2 ){

Tcl_Free(pDb->zTraceV2);

}

if( pDb->zProfile ){

Tcl_Free(pDb->zProfile);

}

if( pDb->zAuth ){

Tcl_Free(pDb->zAuth);

}

if( pDb->zNull ){

Tcl_Free(pDb->zNull);

}

if( pDb->pUpdateHook ){

Tcl_DecrRefCount(pDb->pUpdateHook);

}

if( pDb->pPreUpdateHook ){

Tcl_DecrRefCount(pDb->pPreUpdateHook);

}

if( pDb->pRollbackHook ){

Tcl_DecrRefCount(pDb->pRollbackHook);

}

if( pDb->pWalHook ){

Tcl_DecrRefCount(pDb->pWalHook);

}

if( pDb->pCollateNeeded ){

Tcl_DecrRefCount(pDb->pCollateNeeded);

}

Tcl_Free((char*)pDb);

}

/*

** This routine is called when a database file is locked while trying

** to execute SQL.

*/

static int DbBusyHandler(void *cd, int nTries){

SqliteDb *pDb = (SqliteDb*)cd;

int rc;

char zVal[30];

sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);

rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);

if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){

return 0;

}

return 1;

}

#ifndef SQLITE_OMIT_PROGRESS_CALLBACK

/*

** This routine is invoked as the 'progress callback' for the database.

*/

static int DbProgressHandler(void *cd){

SqliteDb *pDb = (SqliteDb*)cd;

int rc;

assert( pDb->zProgress );

rc = Tcl_Eval(pDb->interp, pDb->zProgress);

if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){

return 1;

}

return 0;

}

#endif

#if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \

!defined(SQLITE_OMIT_DEPRECATED)

/*

** This routine is called by the SQLite trace handler whenever a new

** block of SQL is executed. The TCL script in pDb->zTrace is executed.

*/

static void DbTraceHandler(void *cd, const char *zSql){

SqliteDb *pDb = (SqliteDb*)cd;

Tcl_DString str;

Tcl_DStringInit(&str);

Tcl_DStringAppend(&str, pDb->zTrace, -1);

Tcl_DStringAppendElement(&str, zSql);

Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));

Tcl_DStringFree(&str);

Tcl_ResetResult(pDb->interp);

}

#endif

#ifndef SQLITE_OMIT_TRACE

/*

** This routine is called by the SQLite trace_v2 handler whenever a new

** supported event is generated. Unsupported event types are ignored.

** The TCL script in pDb->zTraceV2 is executed, with the arguments for

** the event appended to it (as list elements).

*/

static int DbTraceV2Handler(

unsigned type, /* One of the SQLITE_TRACE_* event types. */

void *cd, /* The original context data pointer. */

void *pd, /* Primary event data, depends on event type. */

void *xd /* Extra event data, depends on event type. */

){

SqliteDb *pDb = (SqliteDb*)cd;

Tcl_Obj *pCmd;

switch( type ){

case SQLITE_TRACE_STMT: {

sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;

char *zSql = (char *)xd;

pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewWideIntObj((Tcl_WideInt)pStmt));

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewStringObj(zSql, -1));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

Tcl_ResetResult(pDb->interp);

break;

}

case SQLITE_TRACE_PROFILE: {

sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;

sqlite3_int64 ns = (sqlite3_int64)xd;

pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewWideIntObj((Tcl_WideInt)pStmt));

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewWideIntObj((Tcl_WideInt)ns));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

Tcl_ResetResult(pDb->interp);

break;

}

case SQLITE_TRACE_ROW: {

sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;

pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewWideIntObj((Tcl_WideInt)pStmt));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

Tcl_ResetResult(pDb->interp);

break;

}

case SQLITE_TRACE_CLOSE: {

sqlite3 *db = (sqlite3 *)pd;

pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(pDb->interp, pCmd,

Tcl_NewWideIntObj((Tcl_WideInt)db));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

Tcl_ResetResult(pDb->interp);

break;

}

}

return SQLITE_OK;

}

#endif

#if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \

!defined(SQLITE_OMIT_DEPRECATED)

/*

** This routine is called by the SQLite profile handler after a statement

** SQL has executed. The TCL script in pDb->zProfile is evaluated.

*/

static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){

SqliteDb *pDb = (SqliteDb*)cd;

Tcl_DString str;

char zTm[100];

sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);

Tcl_DStringInit(&str);

Tcl_DStringAppend(&str, pDb->zProfile, -1);

Tcl_DStringAppendElement(&str, zSql);

Tcl_DStringAppendElement(&str, zTm);

Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));

Tcl_DStringFree(&str);

Tcl_ResetResult(pDb->interp);

}

#endif

/*

** This routine is called when a transaction is committed. The

** TCL script in pDb->zCommit is executed. If it returns non-zero or

** if it throws an exception, the transaction is rolled back instead

** of being committed.

*/

static int DbCommitHandler(void *cd){

SqliteDb *pDb = (SqliteDb*)cd;

int rc;

rc = Tcl_Eval(pDb->interp, pDb->zCommit);

if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){

return 1;

}

return 0;

}

static void DbRollbackHandler(void *clientData){

SqliteDb *pDb = (SqliteDb*)clientData;

assert(pDb->pRollbackHook);

if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){

Tcl_BackgroundError(pDb->interp);

}

}

/*

** This procedure handles wal_hook callbacks.

*/

static int DbWalHandler(

void *clientData,

sqlite3 *db,

const char *zDb,

int nEntry

){

int ret = SQLITE_OK;

Tcl_Obj *p;

SqliteDb *pDb = (SqliteDb*)clientData;

Tcl_Interp *interp = pDb->interp;

assert(pDb->pWalHook);

assert( db==pDb->db );

p = Tcl_DuplicateObj(pDb->pWalHook);

Tcl_IncrRefCount(p);

Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));

Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));

if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)

|| TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)

){

Tcl_BackgroundError(interp);

}

Tcl_DecrRefCount(p);

return ret;

}

#if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)

static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){

char zBuf[64];

sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);

Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);

sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);

Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);

}

#else

# define setTestUnlockNotifyVars(x,y,z)

#endif

#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY

static void DbUnlockNotify(void **apArg, int nArg){

int i;

for(i=0; i<nArg; i++){

const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);

SqliteDb *pDb = (SqliteDb *)apArg[i];

setTestUnlockNotifyVars(pDb->interp, i, nArg);

assert( pDb->pUnlockNotify);

Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);

Tcl_DecrRefCount(pDb->pUnlockNotify);

pDb->pUnlockNotify = 0;

}

}

#endif

#ifdef SQLITE_ENABLE_PREUPDATE_HOOK

/*

** Pre-update hook callback.

*/

static void DbPreUpdateHandler(

void *p,

sqlite3 *db,

int op,

const char *zDb,

const char *zTbl,

sqlite_int64 iKey1,

sqlite_int64 iKey2

){

SqliteDb *pDb = (SqliteDb *)p;

Tcl_Obj *pCmd;

static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};

assert( (SQLITE_DELETE-1)/9 == 0 );

assert( (SQLITE_INSERT-1)/9 == 1 );

assert( (SQLITE_UPDATE-1)/9 == 2 );

assert( pDb->pPreUpdateHook );

assert( db==pDb->db );

assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );

pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

}

#endif /* SQLITE_ENABLE_PREUPDATE_HOOK */

static void DbUpdateHandler(

void *p,

int op,

const char *zDb,

const char *zTbl,

sqlite_int64 rowid

){

SqliteDb *pDb = (SqliteDb *)p;

Tcl_Obj *pCmd;

static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};

assert( (SQLITE_DELETE-1)/9 == 0 );

assert( (SQLITE_INSERT-1)/9 == 1 );

assert( (SQLITE_UPDATE-1)/9 == 2 );

assert( pDb->pUpdateHook );

assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );

pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);

Tcl_IncrRefCount(pCmd);

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));

Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));

Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

}

static void tclCollateNeeded(

void *pCtx,

sqlite3 *db,

int enc,

const char *zName

){

SqliteDb *pDb = (SqliteDb *)pCtx;

Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);

Tcl_IncrRefCount(pScript);

Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));

Tcl_EvalObjEx(pDb->interp, pScript, 0);

Tcl_DecrRefCount(pScript);

}

/*

** This routine is called to evaluate an SQL collation function implemented

** using TCL script.

*/

static int tclSqlCollate(

void *pCtx,

int nA,

const void *zA,

int nB,

const void *zB

){

SqlCollate *p = (SqlCollate *)pCtx;

Tcl_Obj *pCmd;

pCmd = Tcl_NewStringObj(p->zScript, -1);

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, TCL_EVAL_DIRECT);

Tcl_DecrRefCount(pCmd);

return (atoi(Tcl_GetStringResult(p->interp)));

}

/*

** This routine is called to evaluate an SQL function implemented

** using TCL script.

*/

static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){

SqlFunc *p = sqlite3_user_data(context);

Tcl_Obj *pCmd;

int i;

int rc;

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 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((int)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(p->pDb->zNull, -1);

break;

}

default: {

int bytes = sqlite3_value_bytes(pIn);

pVal = Tcl_NewStringObj((char *)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);

}

if( rc && rc!=TCL_RETURN ){

sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);

}else{

Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);

int n;

u8 *data;

const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");

char c = zType[0];

if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){

/* 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);

}else if( c=='b' && strcmp(zType,"boolean")==0 ){