/*

** 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=1 Add a "main()" routine that works as a tclsh.

**

** -DSQLITE_TCLMD5 When used in conjuction with -DTCLSH=1, add

** four new commands to the TCL interpreter for

** generating MD5 checksums: md5, md5file,

** md5-10x8, and md5file-10x8.

**

** -DSQLITE_TEST When used in conjuction with -DTCLSH=1, add

** hundreds of new commands used for testing

** SQLite. This option implies -DSQLITE_TCLMD5.

*/

#include "tcl.h"

#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

# define WIN32_LEAN_AND_MEAN

# 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 *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 *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 nTransaction; /* Number of nested [transaction] methods */

#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 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 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 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 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 incrblobWatch(ClientData instanceData, int mode){

/* NO-OP */

}

static int 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 i;

pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen30(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->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 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->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->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

#ifndef SQLITE_OMIT_TRACE

/*

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

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];

sprintf(zBuf, "%d", iArg);

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

sprintf(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

static void DbUpdateHandler(

void *p,

int op,

const char *zDb,

const char *zTbl,

sqlite_int64 rowid

){

SqliteDb *pDb = (SqliteDb *)p;

Tcl_Obj *pCmd;

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(

( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -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 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((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 ){

Tcl_GetIntFromObj(0, pVar, &n);

sqlite3_result_int(context, n);

}else if( c=='d' && strcmp(zType,"double")==0 ){

double r;

Tcl_GetDoubleFromObj(0, pVar, &r);

sqlite3_result_double(context, r);

}else if( (c=='w' && strcmp(zType,"wideInt")==0) ||

(c=='i' && strcmp(zType,"int")==0) ){

Tcl_WideInt v;

Tcl_GetWideIntFromObj(0, pVar, &v);

sqlite3_result_int64(context, v);

}else{

data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);

sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);

}

}

}

#ifndef SQLITE_OMIT_AUTHORIZATION

/*

** This is the authentication function. It appends the authentication

** type code and the two arguments to zCmd[] then invokes the result

** on the interpreter. The reply is examined to determine if the

** authentication fails or succeeds.

*/

static int auth_callback(

void *pArg,

int code,

const char *zArg1,

const char *zArg2,

const char *zArg3,

const char *zArg4

){

char *zCode;

Tcl_DString str;

int rc;

const char *zReply;

SqliteDb *pDb = (SqliteDb*)pArg;

if( pDb->disableAuth ) return SQLITE_OK;

switch( code ){

case SQLITE_COPY : zCode="SQLITE_COPY"; break;

case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;

case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;

case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;

case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;

case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;

case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;

case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;

case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;

case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;

case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;

case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;

case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;

case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;

case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;

case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;

case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;

case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;

case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;

case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;

case SQLITE_READ : zCode="SQLITE_READ"; break;

case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;

case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;

case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;

case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;

case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;

case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;

case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;

case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;

case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;

case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;

case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;

case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;

default : zCode="????"; break;

}

Tcl_DStringInit(&str);

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

Tcl_DStringAppendElement(&str, zCode);

Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");

Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");

Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");

Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");

rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));

Tcl_DStringFree(&str);

zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";

if( strcmp(zReply,"SQLITE_OK")==0 ){

rc = SQLITE_OK;

}else if( strcmp(zReply,"SQLITE_DENY")==0 ){

rc = SQLITE_DENY;

}else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){

rc = SQLITE_IGNORE;

}else{

rc = 999;

}

return rc;

}

#endif /* SQLITE_OMIT_AUTHORIZATION */

/*

** This routine reads a line of text from FILE in, stores

** the text in memory obtained from malloc() and returns a pointer

** to the text. NULL is returned at end of file, or if malloc()

** fails.

**

** The interface is like "readline" but no command-line editing

** is done.

**

** copied from shell.c from '.import' command

*/

static char *local_getline(char *zPrompt, FILE *in){

char *zLine;

int nLine;

int n;

nLine = 100;

zLine = malloc( nLine );

if( zLine==0 ) return 0;

n = 0;

while( 1 ){

if( n+100>nLine ){

nLine = nLine*2 + 100;

zLine = realloc(zLine, nLine);

if( zLine==0 ) return 0;

}

if( fgets(&zLine[n], nLine - n, in)==0 ){

if( n==0 ){

free(zLine);

return 0;

}

zLine[n] = 0;

break;

}

while( zLine[n] ){ n++; }

if( n>0 && zLine[n-1]=='\n' ){

n--;

zLine[n] = 0;

break;

}

}

zLine = realloc( zLine, n+1 );

return zLine;

}

/*

** This function is part of the implementation of the command:

**

** $db transaction [-deferred|-immediate|-exclusive] SCRIPT

**

** It is invoked after evaluating the script SCRIPT to commit or rollback

** the transaction or savepoint opened by the [transaction] command.

*/

static int DbTransPostCmd(

ClientData data[], /* data[0] is the Sqlite3Db* for $db */

Tcl_Interp *interp, /* Tcl interpreter */

int result /* Result of evaluating SCRIPT */