From 2f8d7092bc2c9609fa98d6888106b96f38b22828 Mon Sep 17 00:00:00 2001 From: dan miller Date: Sun, 21 Oct 2007 08:36:32 +0000 Subject: libraries moved to opensim-libs, a new repository --- libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c | 2551 -------------------- 1 file changed, 2551 deletions(-) delete mode 100644 libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c (limited to 'libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c') diff --git a/libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c b/libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c deleted file mode 100644 index e81846e..0000000 --- a/libraries/sqlite/unix/sqlite-3.5.1/src/tclsqlite.c +++ /dev/null @@ -1,2551 +0,0 @@ -/* -** 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. -** -** $Id: tclsqlite.c,v 1.203 2007/09/14 16:20:01 danielk1977 Exp $ -*/ -#include "tcl.h" -#include - -/* -** Some additional include files are needed if this file is not -** appended to the amalgamation. -*/ -#ifndef SQLITE_AMALGAMATION -# include "sqliteInt.h" -# include -# include -# include -# include -#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 - -/* -** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we -** have to do a translation when going between the two. Set the -** UTF_TRANSLATION_NEEDED macro to indicate that we need to do -** this translation. -*/ -#if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8) -# define UTF_TRANSLATION_NEEDED 1 -#endif - -/* -** 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 */ - 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[] */ - char zSql[1]; /* Text of the SQL statement */ -}; - -typedef struct IncrblobChannel IncrblobChannel; - -/* -** There is one instance of this structure for each SQLite database -** that has been opened by the SQLite TCL interface. -*/ -typedef struct SqliteDb SqliteDb; -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 */ - 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) */ - 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 */ -}; - -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 */ -}; - -#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) + 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 -*/ -static void flushStmtCache( SqliteDb *pDb ){ - SqlPreparedStmt *pPreStmt; - - while( pDb->stmtList ){ - sqlite3_finalize( pDb->stmtList->pStmt ); - pPreStmt = pDb->stmtList; - pDb->stmtList = pDb->stmtList->pNext; - Tcl_Free( (char*)pPreStmt ); - } - pDb->nStmt = 0; - pDb->stmtLast = 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; - 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->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; -} - -/* -** 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; -} - -#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); - } -} - -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); -} - -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=-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((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; - 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; - - 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; - 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 = Tcl_GetStringResult(pDb->interp); - 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 */ - -/* -** zText is a pointer to text obtained via an sqlite3_result_text() -** or similar interface. This routine returns a Tcl string object, -** reference count set to 0, containing the text. If a translation -** between iso8859 and UTF-8 is required, it is preformed. -*/ -static Tcl_Obj *dbTextToObj(char const *zText){ - Tcl_Obj *pVal; -#ifdef UTF_TRANSLATION_NEEDED - Tcl_DString dCol; - Tcl_DStringInit(&dCol); - Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol); - pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); - Tcl_DStringFree(&dCol); -#else - pVal = Tcl_NewStringObj(zText, -1); -#endif - return pVal; -} - -/* -** 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; - int eol; - - nLine = 100; - zLine = malloc( nLine ); - if( zLine==0 ) return 0; - n = 0; - eol = 0; - while( !eol ){ - 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; - eol = 1; - break; - } - while( zLine[n] ){ n++; } - if( n>0 && zLine[n-1]=='\n' ){ - n--; - zLine[n] = 0; - eol = 1; - } - } - zLine = realloc( zLine, n+1 ); - return zLine; -} - -/* -** The "sqlite" command below creates a new Tcl command for each -** connection it opens to an SQLite database. This routine is invoked -** whenever one of those connection-specific commands is executed -** in Tcl. For example, if you run Tcl code like this: -** -** sqlite3 db1 "my_database" -** db1 close -** -** The first command opens a connection to the "my_database" database -** and calls that connection "db1". The second command causes this -** subroutine to be invoked. -*/ -static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ - SqliteDb *pDb = (SqliteDb*)cd; - int choice; - int rc = TCL_OK; - static const char *DB_strs[] = { - "authorizer", "busy", "cache", - "changes", "close", "collate", - "collation_needed", "commit_hook", "complete", - "copy", "enable_load_extension","errorcode", - "eval", "exists", "function", - "incrblob", "interrupt", "last_insert_rowid", - "nullvalue", "onecolumn", "profile", - "progress", "rekey", "rollback_hook", - "timeout", "total_changes", "trace", - "transaction", "update_hook", "version", - 0 - }; - enum DB_enum { - DB_AUTHORIZER, DB_BUSY, DB_CACHE, - DB_CHANGES, DB_CLOSE, DB_COLLATE, - DB_COLLATION_NEEDED, DB_COMMIT_HOOK, DB_COMPLETE, - DB_COPY, DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE, - DB_EVAL, DB_EXISTS, DB_FUNCTION, - DB_INCRBLOB, DB_INTERRUPT, DB_LAST_INSERT_ROWID, - DB_NULLVALUE, DB_ONECOLUMN, DB_PROFILE, - DB_PROGRESS, DB_REKEY, DB_ROLLBACK_HOOK, - DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE, - DB_TRANSACTION, DB_UPDATE_HOOK, DB_VERSION - }; - /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */ - - if( objc<2 ){ - Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ..."); - return TCL_ERROR; - } - if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){ - return TCL_ERROR; - } - - switch( (enum DB_enum)choice ){ - - /* $db authorizer ?CALLBACK? - ** - ** Invoke the given callback to authorize each SQL operation as it is - ** compiled. 5 arguments are appended to the callback before it is - ** invoked: - ** - ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...) - ** (2) First descriptive name (depends on authorization type) - ** (3) Second descriptive name - ** (4) Name of the database (ex: "main", "temp") - ** (5) Name of trigger that is doing the access - ** - ** The callback should return on of the following strings: SQLITE_OK, - ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error. - ** - ** If this method is invoked with no arguments, the current authorization - ** callback string is returned. - */ - case DB_AUTHORIZER: { -#ifdef SQLITE_OMIT_AUTHORIZATION - Tcl_AppendResult(interp, "authorization not available in this build", 0); - return TCL_ERROR; -#else - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return TCL_ERROR; - }else if( objc==2 ){ - if( pDb->zAuth ){ - Tcl_AppendResult(interp, pDb->zAuth, 0); - } - }else{ - char *zAuth; - int len; - if( pDb->zAuth ){ - Tcl_Free(pDb->zAuth); - } - zAuth = Tcl_GetStringFromObj(objv[2], &len); - if( zAuth && len>0 ){ - pDb->zAuth = Tcl_Alloc( len + 1 ); - memcpy(pDb->zAuth, zAuth, len+1); - }else{ - pDb->zAuth = 0; - } - if( pDb->zAuth ){ - pDb->interp = interp; - sqlite3_set_authorizer(pDb->db, auth_callback, pDb); - }else{ - sqlite3_set_authorizer(pDb->db, 0, 0); - } - } -#endif - break; - } - - /* $db busy ?CALLBACK? - ** - ** Invoke the given callback if an SQL statement attempts to open - ** a locked database file. - */ - case DB_BUSY: { - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK"); - return TCL_ERROR; - }else if( objc==2 ){ - if( pDb->zBusy ){ - Tcl_AppendResult(interp, pDb->zBusy, 0); - } - }else{ - char *zBusy; - int len; - if( pDb->zBusy ){ - Tcl_Free(pDb->zBusy); - } - zBusy = Tcl_GetStringFromObj(objv[2], &len); - if( zBusy && len>0 ){ - pDb->zBusy = Tcl_Alloc( len + 1 ); - memcpy(pDb->zBusy, zBusy, len+1); - }else{ - pDb->zBusy = 0; - } - if( pDb->zBusy ){ - pDb->interp = interp; - sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); - }else{ - sqlite3_busy_handler(pDb->db, 0, 0); - } - } - break; - } - - /* $db cache flush - ** $db cache size n - ** - ** Flush the prepared statement cache, or set the maximum number of - ** cached statements. - */ - case DB_CACHE: { - char *subCmd; - int n; - - if( objc<=2 ){ - Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); - return TCL_ERROR; - } - subCmd = Tcl_GetStringFromObj( objv[2], 0 ); - if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "flush"); - return TCL_ERROR; - }else{ - flushStmtCache( pDb ); - } - }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ - if( objc!=4 ){ - Tcl_WrongNumArgs(interp, 2, objv, "size n"); - return TCL_ERROR; - }else{ - if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){ - Tcl_AppendResult( interp, "cannot convert \"", - Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0); - return TCL_ERROR; - }else{ - if( n<0 ){ - flushStmtCache( pDb ); - n = 0; - }else if( n>MAX_PREPARED_STMTS ){ - n = MAX_PREPARED_STMTS; - } - pDb->maxStmt = n; - } - } - }else{ - Tcl_AppendResult( interp, "bad option \"", - Tcl_GetStringFromObj(objv[0],0), "\": must be flush or size", 0); - return TCL_ERROR; - } - break; - } - - /* $db changes - ** - ** Return the number of rows that were modified, inserted, or deleted by - ** the most recent INSERT, UPDATE or DELETE statement, not including - ** any changes made by trigger programs. - */ - case DB_CHANGES: { - Tcl_Obj *pResult; - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - pResult = Tcl_GetObjResult(interp); - Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db)); - break; - } - - /* $db close - ** - ** Shutdown the database - */ - case DB_CLOSE: { - Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0)); - break; - } - - /* - ** $db collate NAME SCRIPT - ** - ** Create a new SQL collation function called NAME. Whenever - ** that function is called, invoke SCRIPT to evaluate the function. - */ - case DB_COLLATE: { - SqlCollate *pCollate; - 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); - pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 ); - if( pCollate==0 ) return TCL_ERROR; - pCollate->interp = interp; - pCollate->pNext = pDb->pCollate; - pCollate->zScript = (char*)&pCollate[1]; - pDb->pCollate = pCollate; - memcpy(pCollate->zScript, zScript, nScript+1); - if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, - pCollate, tclSqlCollate) ){ - Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); - return TCL_ERROR; - } - break; - } - - /* - ** $db collation_needed SCRIPT - ** - ** Create a new SQL collation function called NAME. Whenever - ** that function is called, invoke SCRIPT to evaluate the function. - */ - case DB_COLLATION_NEEDED: { - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT"); - return TCL_ERROR; - } - if( pDb->pCollateNeeded ){ - Tcl_DecrRefCount(pDb->pCollateNeeded); - } - pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]); - Tcl_IncrRefCount(pDb->pCollateNeeded); - sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); - break; - } - - /* $db commit_hook ?CALLBACK? - ** - ** Invoke the given callback just before committing every SQL transaction. - ** If the callback throws an exception or returns non-zero, then the - ** transaction is aborted. If CALLBACK is an empty string, the callback - ** is disabled. - */ - case DB_COMMIT_HOOK: { - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return TCL_ERROR; - }else if( objc==2 ){ - if( pDb->zCommit ){ - Tcl_AppendResult(interp, pDb->zCommit, 0); - } - }else{ - char *zCommit; - int len; - if( pDb->zCommit ){ - Tcl_Free(pDb->zCommit); - } - zCommit = Tcl_GetStringFromObj(objv[2], &len); - if( zCommit && len>0 ){ - pDb->zCommit = Tcl_Alloc( len + 1 ); - memcpy(pDb->zCommit, zCommit, len+1); - }else{ - pDb->zCommit = 0; - } - if( pDb->zCommit ){ - pDb->interp = interp; - sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); - }else{ - sqlite3_commit_hook(pDb->db, 0, 0); - } - } - break; - } - - /* $db complete SQL - ** - ** Return TRUE if SQL is a complete SQL statement. Return FALSE if - ** additional lines of input are needed. This is similar to the - ** built-in "info complete" command of Tcl. - */ - case DB_COMPLETE: { -#ifndef SQLITE_OMIT_COMPLETE - Tcl_Obj *pResult; - int isComplete; - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "SQL"); - return TCL_ERROR; - } - isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) ); - pResult = Tcl_GetObjResult(interp); - Tcl_SetBooleanObj(pResult, isComplete); -#endif - break; - } - - /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? - ** - ** Copy data into table from filename, optionally using SEPARATOR - ** as column separators. If a column contains a null string, or the - ** value of NULLINDICATOR, a NULL is inserted for the column. - ** conflict-algorithm is one of the sqlite conflict algorithms: - ** rollback, abort, fail, ignore, replace - ** On success, return the number of lines processed, not necessarily same - ** as 'db changes' due to conflict-algorithm selected. - ** - ** This code is basically an implementation/enhancement of - ** the sqlite3 shell.c ".import" command. - ** - ** This command usage is equivalent to the sqlite2.x COPY statement, - ** which imports file data into a table using the PostgreSQL COPY file format: - ** $db copy $conflit_algo $table_name $filename \t \\N - */ - case DB_COPY: { - char *zTable; /* Insert data into this table */ - char *zFile; /* The file from which to extract data */ - char *zConflict; /* The conflict algorithm to use */ - sqlite3_stmt *pStmt; /* A statement */ - int rc; /* Result code */ - int nCol; /* Number of columns in the table */ - int nByte; /* Number of bytes in an SQL string */ - int i, j; /* Loop counters */ - int nSep; /* Number of bytes in zSep[] */ - int nNull; /* Number of bytes in zNull[] */ - char *zSql; /* An SQL statement */ - char *zLine; /* A single line of input from the file */ - char **azCol; /* zLine[] broken up into columns */ - char *zCommit; /* How to commit changes */ - FILE *in; /* The input file */ - int lineno = 0; /* Line number of input file */ - char zLineNum[80]; /* Line number print buffer */ - Tcl_Obj *pResult; /* interp result */ - - char *zSep; - char *zNull; - if( objc<5 || objc>7 ){ - Tcl_WrongNumArgs(interp, 2, objv, - "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); - return TCL_ERROR; - } - if( objc>=6 ){ - zSep = Tcl_GetStringFromObj(objv[5], 0); - }else{ - zSep = "\t"; - } - if( objc>=7 ){ - zNull = Tcl_GetStringFromObj(objv[6], 0); - }else{ - zNull = ""; - } - zConflict = Tcl_GetStringFromObj(objv[2], 0); - zTable = Tcl_GetStringFromObj(objv[3], 0); - zFile = Tcl_GetStringFromObj(objv[4], 0); - nSep = strlen(zSep); - nNull = strlen(zNull); - if( nSep==0 ){ - Tcl_AppendResult(interp,"Error: non-null separator required for copy",0); - return TCL_ERROR; - } - if(sqlite3StrICmp(zConflict, "rollback") != 0 && - sqlite3StrICmp(zConflict, "abort" ) != 0 && - sqlite3StrICmp(zConflict, "fail" ) != 0 && - sqlite3StrICmp(zConflict, "ignore" ) != 0 && - sqlite3StrICmp(zConflict, "replace" ) != 0 ) { - Tcl_AppendResult(interp, "Error: \"", zConflict, - "\", conflict-algorithm must be one of: rollback, " - "abort, fail, ignore, or replace", 0); - return TCL_ERROR; - } - zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); - if( zSql==0 ){ - Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0); - return TCL_ERROR; - } - nByte = strlen(zSql); - rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); - sqlite3_free(zSql); - if( rc ){ - Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); - nCol = 0; - }else{ - nCol = sqlite3_column_count(pStmt); - } - sqlite3_finalize(pStmt); - if( nCol==0 ) { - return TCL_ERROR; - } - zSql = malloc( nByte + 50 + nCol*2 ); - if( zSql==0 ) { - Tcl_AppendResult(interp, "Error: can't malloc()", 0); - return TCL_ERROR; - } - sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", - zConflict, zTable); - j = strlen(zSql); - for(i=1; idb, zSql, -1, &pStmt, 0); - free(zSql); - if( rc ){ - Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); - sqlite3_finalize(pStmt); - return TCL_ERROR; - } - in = fopen(zFile, "rb"); - if( in==0 ){ - Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL); - sqlite3_finalize(pStmt); - return TCL_ERROR; - } - azCol = malloc( sizeof(azCol[0])*(nCol+1) ); - if( azCol==0 ) { - Tcl_AppendResult(interp, "Error: can't malloc()", 0); - fclose(in); - return TCL_ERROR; - } - (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); - zCommit = "COMMIT"; - while( (zLine = local_getline(0, in))!=0 ){ - char *z; - i = 0; - lineno++; - azCol[0] = zLine; - for(i=0, z=zLine; *z; z++){ - if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ - *z = 0; - i++; - if( i0 && strcmp(azCol[i], zNull)==0) || strlen(azCol[i])==0) { - sqlite3_bind_null(pStmt, i+1); - }else{ - sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); - } - } - sqlite3_step(pStmt); - rc = sqlite3_reset(pStmt); - free(zLine); - if( rc!=SQLITE_OK ){ - Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0); - zCommit = "ROLLBACK"; - break; - } - } - free(azCol); - fclose(in); - sqlite3_finalize(pStmt); - (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); - - if( zCommit[0] == 'C' ){ - /* success, set result as number of lines processed */ - pResult = Tcl_GetObjResult(interp); - Tcl_SetIntObj(pResult, lineno); - rc = TCL_OK; - }else{ - /* failure, append lineno where failed */ - sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno); - Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0); - rc = TCL_ERROR; - } - break; - } - - /* - ** $db enable_load_extension BOOLEAN - ** - ** Turn the extension loading feature on or off. It if off by - ** default. - */ - case DB_ENABLE_LOAD_EXTENSION: { -#ifndef SQLITE_OMIT_LOAD_EXTENSION - int onoff; - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN"); - return TCL_ERROR; - } - if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){ - return TCL_ERROR; - } - sqlite3_enable_load_extension(pDb->db, onoff); - break; -#else - Tcl_AppendResult(interp, "extension loading is turned off at compile-time", - 0); - return TCL_ERROR; -#endif - } - - /* - ** $db errorcode - ** - ** Return the numeric error code that was returned by the most recent - ** call to sqlite3_exec(). - */ - case DB_ERRORCODE: { - Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db))); - break; - } - - /* - ** $db eval $sql ?array? ?{ ...code... }? - ** $db onecolumn $sql - ** - ** The SQL statement in $sql is evaluated. For each row, the values are - ** placed in elements of the array named "array" and ...code... is executed. - ** If "array" and "code" are omitted, then no callback is every invoked. - ** If "array" is an empty string, then the values are placed in variables - ** that have the same name as the fields extracted by the query. - ** - ** The onecolumn method is the equivalent of: - ** lindex [$db eval $sql] 0 - */ - case DB_ONECOLUMN: - case DB_EVAL: - case DB_EXISTS: { - char const *zSql; /* Next SQL statement to execute */ - char const *zLeft; /* What is left after first stmt in zSql */ - sqlite3_stmt *pStmt; /* Compiled SQL statment */ - Tcl_Obj *pArray; /* Name of array into which results are written */ - Tcl_Obj *pScript; /* Script to run for each result set */ - Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */ - int nParm; /* Number of entries used in apParm[] */ - Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */ - Tcl_Obj *pRet; /* Value to be returned */ - SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */ - int rc2; - - if( choice==DB_EVAL ){ - if( objc<3 || objc>5 ){ - Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); - return TCL_ERROR; - } - pRet = Tcl_NewObj(); - Tcl_IncrRefCount(pRet); - }else{ - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "SQL"); - return TCL_ERROR; - } - if( choice==DB_EXISTS ){ - pRet = Tcl_NewBooleanObj(0); - Tcl_IncrRefCount(pRet); - }else{ - pRet = 0; - } - } - if( objc==3 ){ - pArray = pScript = 0; - }else if( objc==4 ){ - pArray = 0; - pScript = objv[3]; - }else{ - pArray = objv[3]; - if( Tcl_GetString(pArray)[0]==0 ) pArray = 0; - pScript = objv[4]; - } - - Tcl_IncrRefCount(objv[2]); - zSql = Tcl_GetStringFromObj(objv[2], 0); - while( rc==TCL_OK && zSql[0] ){ - int i; /* Loop counter */ - int nVar; /* Number of bind parameters in the pStmt */ - int nCol; /* Number of columns in the result set */ - Tcl_Obj **apColName = 0; /* Array of column names */ - int len; /* String length of zSql */ - - /* Try to find a SQL statement that has already been compiled and - ** which matches the next sequence of SQL. - */ - pStmt = 0; - pPreStmt = pDb->stmtList; - len = strlen(zSql); - if( pPreStmt && sqlite3_expired(pPreStmt->pStmt) ){ - flushStmtCache(pDb); - pPreStmt = 0; - } - for(; pPreStmt; pPreStmt=pPreStmt->pNext){ - int n = pPreStmt->nSql; - if( len>=n - && memcmp(pPreStmt->zSql, zSql, n)==0 - && (zSql[n]==0 || zSql[n-1]==';') - ){ - pStmt = pPreStmt->pStmt; - zLeft = &zSql[pPreStmt->nSql]; - - /* When a prepared statement is found, unlink it from the - ** cache list. It will later be added back to the beginning - ** of the cache list in order to implement LRU replacement. - */ - if( pPreStmt->pPrev ){ - pPreStmt->pPrev->pNext = pPreStmt->pNext; - }else{ - pDb->stmtList = pPreStmt->pNext; - } - if( pPreStmt->pNext ){ - pPreStmt->pNext->pPrev = pPreStmt->pPrev; - }else{ - pDb->stmtLast = pPreStmt->pPrev; - } - pDb->nStmt--; - break; - } - } - - /* If no prepared statement was found. Compile the SQL text - */ - if( pStmt==0 ){ - if( SQLITE_OK!=sqlite3_prepare(pDb->db, zSql, -1, &pStmt, &zLeft) ){ - Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); - rc = TCL_ERROR; - break; - } - if( pStmt==0 ){ - if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ - /* A compile-time error in the statement - */ - Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); - rc = TCL_ERROR; - break; - }else{ - /* The statement was a no-op. Continue to the next statement - ** in the SQL string. - */ - zSql = zLeft; - continue; - } - } - assert( pPreStmt==0 ); - } - - /* Bind values to parameters that begin with $ or : - */ - nVar = sqlite3_bind_parameter_count(pStmt); - nParm = 0; - if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){ - apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0])); - }else{ - apParm = aParm; - } - for(i=1; i<=nVar; i++){ - const char *zVar = sqlite3_bind_parameter_name(pStmt, i); - if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ - Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0); - if( pVar ){ - int n; - u8 *data; - char *zType = pVar->typePtr ? pVar->typePtr->name : ""; - char c = zType[0]; - if( zVar[0]=='@' || - (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ - /* Load a BLOB type if the Tcl variable is a bytearray and - ** it has no string representation or the host - ** parameter name begins with "@". */ - data = Tcl_GetByteArrayFromObj(pVar, &n); - sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); - Tcl_IncrRefCount(pVar); - apParm[nParm++] = pVar; - }else if( c=='b' && strcmp(zType,"boolean")==0 ){ - Tcl_GetIntFromObj(interp, pVar, &n); - sqlite3_bind_int(pStmt, i, n); - }else if( c=='d' && strcmp(zType,"double")==0 ){ - double r; - Tcl_GetDoubleFromObj(interp, pVar, &r); - sqlite3_bind_double(pStmt, i, r); - }else if( (c=='w' && strcmp(zType,"wideInt")==0) || - (c=='i' && strcmp(zType,"int")==0) ){ - Tcl_WideInt v; - Tcl_GetWideIntFromObj(interp, pVar, &v); - sqlite3_bind_int64(pStmt, i, v); - }else{ - data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); - sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); - Tcl_IncrRefCount(pVar); - apParm[nParm++] = pVar; - } - }else{ - sqlite3_bind_null( pStmt, i ); - } - } - } - - /* Compute column names */ - nCol = sqlite3_column_count(pStmt); - if( pScript ){ - apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol ); - if( apColName==0 ) break; - for(i=0; i=-2147483647 && v<=2147483647 ){ - pVal = Tcl_NewIntObj(v); - }else{ - pVal = Tcl_NewWideIntObj(v); - } - break; - } - case SQLITE_FLOAT: { - double r = sqlite3_column_double(pStmt, i); - pVal = Tcl_NewDoubleObj(r); - break; - } - case SQLITE_NULL: { - pVal = dbTextToObj(pDb->zNull); - break; - } - default: { - pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i)); - break; - } - } - - if( pScript ){ - if( pArray==0 ){ - Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); - }else{ - Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); - } - }else if( choice==DB_ONECOLUMN ){ - assert( pRet==0 ); - if( pRet==0 ){ - pRet = pVal; - Tcl_IncrRefCount(pRet); - } - rc = TCL_BREAK; - i = nCol; - }else if( choice==DB_EXISTS ){ - Tcl_DecrRefCount(pRet); - pRet = Tcl_NewBooleanObj(1); - Tcl_IncrRefCount(pRet); - rc = TCL_BREAK; - i = nCol; - }else{ - Tcl_ListObjAppendElement(interp, pRet, pVal); - } - } - - if( pScript ){ - rc = Tcl_EvalObjEx(interp, pScript, 0); - if( rc==TCL_CONTINUE ){ - rc = TCL_OK; - } - } - } - if( rc==TCL_BREAK ){ - rc = TCL_OK; - } - - /* Free the column name objects */ - if( pScript ){ - for(i=0; idb))); - sqlite3_finalize(pStmt); - rc = TCL_ERROR; - if( pPreStmt ) Tcl_Free((char*)pPreStmt); - break; - }else if( pDb->maxStmt<=0 ){ - /* If the cache is turned off, deallocated the statement */ - if( pPreStmt ) Tcl_Free((char*)pPreStmt); - sqlite3_finalize(pStmt); - }else{ - /* Everything worked and the cache is operational. - ** Create a new SqlPreparedStmt structure if we need one. - ** (If we already have one we can just reuse it.) - */ - if( pPreStmt==0 ){ - len = zLeft - zSql; - pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) + len ); - if( pPreStmt==0 ) return TCL_ERROR; - pPreStmt->pStmt = pStmt; - pPreStmt->nSql = len; - memcpy(pPreStmt->zSql, zSql, len); - pPreStmt->zSql[len] = 0; - } - - /* Add the prepared statement to the beginning of the cache list - */ - pPreStmt->pNext = pDb->stmtList; - pPreStmt->pPrev = 0; - if( pDb->stmtList ){ - pDb->stmtList->pPrev = pPreStmt; - } - pDb->stmtList = pPreStmt; - if( pDb->stmtLast==0 ){ - assert( pDb->nStmt==0 ); - pDb->stmtLast = pPreStmt; - }else{ - assert( pDb->nStmt>0 ); - } - pDb->nStmt++; - - /* If we have too many statement in cache, remove the surplus from the - ** end of the cache list. - */ - while( pDb->nStmt>pDb->maxStmt ){ - sqlite3_finalize(pDb->stmtLast->pStmt); - pDb->stmtLast = pDb->stmtLast->pPrev; - Tcl_Free((char*)pDb->stmtLast->pNext); - pDb->stmtLast->pNext = 0; - pDb->nStmt--; - } - } - - /* Proceed to the next statement */ - zSql = zLeft; - } - Tcl_DecrRefCount(objv[2]); - - if( pRet ){ - if( rc==TCL_OK ){ - Tcl_SetObjResult(interp, pRet); - } - Tcl_DecrRefCount(pRet); - }else if( rc==TCL_OK ){ - Tcl_ResetResult(interp); - } - break; - } - - /* - ** $db function NAME SCRIPT - ** - ** Create a new SQL function called NAME. Whenever that function is - ** called, invoke SCRIPT to evaluate the function. - */ - case DB_FUNCTION: { - SqlFunc *pFunc; - Tcl_Obj *pScript; - char *zName; - if( objc!=4 ){ - Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); - return TCL_ERROR; - } - zName = Tcl_GetStringFromObj(objv[2], 0); - pScript = objv[3]; - pFunc = findSqlFunc(pDb, zName); - if( pFunc==0 ) return TCL_ERROR; - 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 ){ - rc = TCL_ERROR; - Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); - }else{ - /* Must flush any cached statements */ - flushStmtCache( pDb ); - } - break; - } - - /* - ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID - */ - case DB_INCRBLOB: { -#ifdef SQLITE_OMIT_INCRBLOB - Tcl_AppendResult(interp, "incrblob not available in this build", 0); - return TCL_ERROR; -#else - int isReadonly = 0; - const char *zDb = "main"; - const char *zTable; - const char *zColumn; - sqlite_int64 iRow; - - /* Check for the -readonly option */ - if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){ - isReadonly = 1; - } - - if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ - Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); - return TCL_ERROR; - } - - if( objc==(6+isReadonly) ){ - zDb = Tcl_GetString(objv[2]); - } - zTable = Tcl_GetString(objv[objc-3]); - zColumn = Tcl_GetString(objv[objc-2]); - rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow); - - if( rc==TCL_OK ){ - rc = createIncrblobChannel( - interp, pDb, zDb, zTable, zColumn, iRow, isReadonly - ); - } -#endif - break; - } - - /* - ** $db interrupt - ** - ** Interrupt the execution of the inner-most SQL interpreter. This - ** causes the SQL statement to return an error of SQLITE_INTERRUPT. - */ - case DB_INTERRUPT: { - sqlite3_interrupt(pDb->db); - break; - } - - /* - ** $db nullvalue ?STRING? - ** - ** Change text used when a NULL comes back from the database. If ?STRING? - ** is not present, then the current string used for NULL is returned. - ** If STRING is present, then STRING is returned. - ** - */ - case DB_NULLVALUE: { - if( objc!=2 && objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE"); - return TCL_ERROR; - } - if( objc==3 ){ - int len; - char *zNull = Tcl_GetStringFromObj(objv[2], &len); - if( pDb->zNull ){ - Tcl_Free(pDb->zNull); - } - if( zNull && len>0 ){ - pDb->zNull = Tcl_Alloc( len + 1 ); - strncpy(pDb->zNull, zNull, len); - pDb->zNull[len] = '\0'; - }else{ - pDb->zNull = 0; - } - } - Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull)); - break; - } - - /* - ** $db last_insert_rowid - ** - ** Return an integer which is the ROWID for the most recent insert. - */ - case DB_LAST_INSERT_ROWID: { - Tcl_Obj *pResult; - Tcl_WideInt rowid; - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - rowid = sqlite3_last_insert_rowid(pDb->db); - pResult = Tcl_GetObjResult(interp); - Tcl_SetWideIntObj(pResult, rowid); - break; - } - - /* - ** The DB_ONECOLUMN method is implemented together with DB_EVAL. - */ - - /* $db progress ?N CALLBACK? - ** - ** Invoke the given callback every N virtual machine opcodes while executing - ** queries. - */ - case DB_PROGRESS: { - if( objc==2 ){ - if( pDb->zProgress ){ - Tcl_AppendResult(interp, pDb->zProgress, 0); - } - }else if( objc==4 ){ - char *zProgress; - int len; - int N; - if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ - return TCL_ERROR; - }; - if( pDb->zProgress ){ - Tcl_Free(pDb->zProgress); - } - zProgress = Tcl_GetStringFromObj(objv[3], &len); - if( zProgress && len>0 ){ - pDb->zProgress = Tcl_Alloc( len + 1 ); - memcpy(pDb->zProgress, zProgress, len+1); - }else{ - pDb->zProgress = 0; - } -#ifndef SQLITE_OMIT_PROGRESS_CALLBACK - if( pDb->zProgress ){ - pDb->interp = interp; - sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); - }else{ - sqlite3_progress_handler(pDb->db, 0, 0, 0); - } -#endif - }else{ - Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); - return TCL_ERROR; - } - break; - } - - /* $db profile ?CALLBACK? - ** - ** Make arrangements to invoke the CALLBACK routine after each SQL statement - ** that has run. The text of the SQL and the amount of elapse time are - ** appended to CALLBACK before the script is run. - */ - case DB_PROFILE: { - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return TCL_ERROR; - }else if( objc==2 ){ - if( pDb->zProfile ){ - Tcl_AppendResult(interp, pDb->zProfile, 0); - } - }else{ - char *zProfile; - int len; - if( pDb->zProfile ){ - Tcl_Free(pDb->zProfile); - } - zProfile = Tcl_GetStringFromObj(objv[2], &len); - if( zProfile && len>0 ){ - pDb->zProfile = Tcl_Alloc( len + 1 ); - memcpy(pDb->zProfile, zProfile, len+1); - }else{ - pDb->zProfile = 0; - } -#ifndef SQLITE_OMIT_TRACE - if( pDb->zProfile ){ - pDb->interp = interp; - sqlite3_profile(pDb->db, DbProfileHandler, pDb); - }else{ - sqlite3_profile(pDb->db, 0, 0); - } -#endif - } - break; - } - - /* - ** $db rekey KEY - ** - ** Change the encryption key on the currently open database. - */ - case DB_REKEY: { - int nKey; - void *pKey; - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "KEY"); - return TCL_ERROR; - } - pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey); -#ifdef SQLITE_HAS_CODEC - rc = sqlite3_rekey(pDb->db, pKey, nKey); - if( rc ){ - Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0); - rc = TCL_ERROR; - } -#endif - break; - } - - /* - ** $db timeout MILLESECONDS - ** - ** Delay for the number of milliseconds specified when a file is locked. - */ - case DB_TIMEOUT: { - int ms; - if( objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); - return TCL_ERROR; - } - if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; - sqlite3_busy_timeout(pDb->db, ms); - break; - } - - /* - ** $db total_changes - ** - ** Return the number of rows that were modified, inserted, or deleted - ** since the database handle was created. - */ - case DB_TOTAL_CHANGES: { - Tcl_Obj *pResult; - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - pResult = Tcl_GetObjResult(interp); - Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db)); - break; - } - - /* $db trace ?CALLBACK? - ** - ** Make arrangements to invoke the CALLBACK routine for each SQL statement - ** that is executed. The text of the SQL is appended to CALLBACK before - ** it is executed. - */ - case DB_TRACE: { - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return TCL_ERROR; - }else if( objc==2 ){ - if( pDb->zTrace ){ - Tcl_AppendResult(interp, pDb->zTrace, 0); - } - }else{ - char *zTrace; - int len; - if( pDb->zTrace ){ - Tcl_Free(pDb->zTrace); - } - zTrace = Tcl_GetStringFromObj(objv[2], &len); - if( zTrace && len>0 ){ - pDb->zTrace = Tcl_Alloc( len + 1 ); - memcpy(pDb->zTrace, zTrace, len+1); - }else{ - pDb->zTrace = 0; - } -#ifndef SQLITE_OMIT_TRACE - if( pDb->zTrace ){ - pDb->interp = interp; - sqlite3_trace(pDb->db, DbTraceHandler, pDb); - }else{ - sqlite3_trace(pDb->db, 0, 0); - } -#endif - } - break; - } - - /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT - ** - ** Start a new transaction (if we are not already in the midst of a - ** transaction) and execute the TCL script SCRIPT. After SCRIPT - ** completes, either commit the transaction or roll it back if SCRIPT - ** throws an exception. Or if no new transation was started, do nothing. - ** pass the exception on up the stack. - ** - ** This command was inspired by Dave Thomas's talk on Ruby at the - ** 2005 O'Reilly Open Source Convention (OSCON). - */ - case DB_TRANSACTION: { - int inTrans; - Tcl_Obj *pScript; - const char *zBegin = "BEGIN"; - if( objc!=3 && objc!=4 ){ - Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); - return TCL_ERROR; - } - if( objc==3 ){ - pScript = objv[2]; - } else { - static const char *TTYPE_strs[] = { - "deferred", "exclusive", "immediate", 0 - }; - enum TTYPE_enum { - TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE - }; - int ttype; - if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type", - 0, &ttype) ){ - return TCL_ERROR; - } - switch( (enum TTYPE_enum)ttype ){ - case TTYPE_DEFERRED: /* no-op */; break; - case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; - case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; - } - pScript = objv[3]; - } - inTrans = !sqlite3_get_autocommit(pDb->db); - if( !inTrans ){ - (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0); - } - rc = Tcl_EvalObjEx(interp, pScript, 0); - if( !inTrans ){ - const char *zEnd; - if( rc==TCL_ERROR ){ - zEnd = "ROLLBACK"; - } else { - zEnd = "COMMIT"; - } - if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ - sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); - } - } - break; - } - - /* - ** $db update_hook ?script? - ** $db rollback_hook ?script? - */ - case DB_UPDATE_HOOK: - case DB_ROLLBACK_HOOK: { - - /* set ppHook to point at pUpdateHook or pRollbackHook, depending on - ** whether [$db update_hook] or [$db rollback_hook] was invoked. - */ - Tcl_Obj **ppHook; - if( choice==DB_UPDATE_HOOK ){ - ppHook = &pDb->pUpdateHook; - }else{ - ppHook = &pDb->pRollbackHook; - } - - if( objc!=2 && objc!=3 ){ - Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); - return TCL_ERROR; - } - if( *ppHook ){ - Tcl_SetObjResult(interp, *ppHook); - if( objc==3 ){ - Tcl_DecrRefCount(*ppHook); - *ppHook = 0; - } - } - if( objc==3 ){ - assert( !(*ppHook) ); - if( Tcl_GetCharLength(objv[2])>0 ){ - *ppHook = objv[2]; - Tcl_IncrRefCount(*ppHook); - } - } - - sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); - sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); - - break; - } - - /* $db version - ** - ** Return the version string for this database. - */ - case DB_VERSION: { - Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC); - break; - } - - - } /* End of the SWITCH statement */ - return rc; -} - -/* -** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? -** ?-create BOOLEAN? -** -** This is the main Tcl command. When the "sqlite" Tcl command is -** invoked, this routine runs to process that command. -** -** The first argument, DBNAME, is an arbitrary name for a new -** database connection. This command creates a new command named -** DBNAME that is used to control that connection. The database -** connection is deleted when the DBNAME command is deleted. -** -** The second argument is the name of the database file. -** -*/ -static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ - SqliteDb *p; - void *pKey = 0; - int nKey = 0; - const char *zArg; - char *zErrMsg; - int i; - const char *zFile; - const char *zVfs = 0; - int flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE; - Tcl_DString translatedFilename; - if( objc==2 ){ - zArg = Tcl_GetStringFromObj(objv[1], 0); - if( strcmp(zArg,"-version")==0 ){ - Tcl_AppendResult(interp,sqlite3_version,0); - return TCL_OK; - } - if( strcmp(zArg,"-has-codec")==0 ){ -#ifdef SQLITE_HAS_CODEC - Tcl_AppendResult(interp,"1",0); -#else - Tcl_AppendResult(interp,"0",0); -#endif - return TCL_OK; - } - } - for(i=3; i+1db, flags, zVfs); - Tcl_DStringFree(&translatedFilename); - if( SQLITE_OK!=sqlite3_errcode(p->db) ){ - zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); - sqlite3_close(p->db); - p->db = 0; - } -#ifdef SQLITE_TEST - if( p->db ){ - extern int Md5_Register(sqlite3*); - if( Md5_Register(p->db)==SQLITE_NOMEM ){ - zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); - sqlite3_close(p->db); - p->db = 0; - } - } -#endif -#ifdef SQLITE_HAS_CODEC - if( p->db ){ - sqlite3_key(p->db, pKey, nKey); - } -#endif - if( p->db==0 ){ - Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); - Tcl_Free((char*)p); - sqlite3_free(zErrMsg); - return TCL_ERROR; - } - p->maxStmt = NUM_PREPARED_STMTS; - p->interp = interp; - zArg = Tcl_GetStringFromObj(objv[1], 0); - Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); - return TCL_OK; -} - -/* -** Provide a dummy Tcl_InitStubs if we are using this as a static -** library. -*/ -#ifndef USE_TCL_STUBS -# undef Tcl_InitStubs -# define Tcl_InitStubs(a,b,c) -#endif - -/* -** Make sure we have a PACKAGE_VERSION macro defined. This will be -** defined automatically by the TEA makefile. But other makefiles -** do not define it. -*/ -#ifndef PACKAGE_VERSION -# define PACKAGE_VERSION SQLITE_VERSION -#endif - -/* -** Initialize this module. -** -** This Tcl module contains only a single new Tcl command named "sqlite". -** (Hence there is no namespace. There is no point in using a namespace -** if the extension only supplies one new name!) The "sqlite" command is -** used to open a new SQLite database. See the DbMain() routine above -** for additional information. -*/ -EXTERN int Sqlite3_Init(Tcl_Interp *interp){ - Tcl_InitStubs(interp, "8.4", 0); - Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); - Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); - Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); - Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION); - return TCL_OK; -} -EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } -EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } -EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } - -#ifndef SQLITE_3_SUFFIX_ONLY -EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } -EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } -EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } -EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } -#endif - -#ifdef TCLSH -/***************************************************************************** -** The code that follows is used to build standalone TCL interpreters -** that are statically linked with SQLite. -*/ - -/* -** If the macro TCLSH is one, then put in code this for the -** "main" routine that will initialize Tcl and take input from -** standard input, or if a file is named on the command line -** the TCL interpreter reads and evaluates that file. -*/ -#if TCLSH==1 -static char zMainloop[] = - "set line {}\n" - "while {![eof stdin]} {\n" - "if {$line!=\"\"} {\n" - "puts -nonewline \"> \"\n" - "} else {\n" - "puts -nonewline \"% \"\n" - "}\n" - "flush stdout\n" - "append line [gets stdin]\n" - "if {[info complete $line]} {\n" - "if {[catch {uplevel #0 $line} result]} {\n" - "puts stderr \"Error: $result\"\n" - "} elseif {$result!=\"\"} {\n" - "puts $result\n" - "}\n" - "set line {}\n" - "} else {\n" - "append line \\n\n" - "}\n" - "}\n" -; -#endif - -/* -** If the macro TCLSH is two, then get the main loop code out of -** the separate file "spaceanal_tcl.h". -*/ -#if TCLSH==2 -static char zMainloop[] = -#include "spaceanal_tcl.h" -; -#endif - -#define TCLSH_MAIN main /* Needed to fake out mktclapp */ -int TCLSH_MAIN(int argc, char **argv){ - Tcl_Interp *interp; - Tcl_FindExecutable(argv[0]); - interp = Tcl_CreateInterp(); - Sqlite3_Init(interp); -#ifdef SQLITE_TEST - { - extern int Md5_Init(Tcl_Interp*); - extern int Sqliteconfig_Init(Tcl_Interp*); - extern int Sqlitetest1_Init(Tcl_Interp*); - extern int Sqlitetest2_Init(Tcl_Interp*); - extern int Sqlitetest3_Init(Tcl_Interp*); - extern int Sqlitetest4_Init(Tcl_Interp*); - extern int Sqlitetest5_Init(Tcl_Interp*); - extern int Sqlitetest6_Init(Tcl_Interp*); - extern int Sqlitetest7_Init(Tcl_Interp*); - extern int Sqlitetest8_Init(Tcl_Interp*); - extern int Sqlitetest9_Init(Tcl_Interp*); - extern int Sqlitetestasync_Init(Tcl_Interp*); - extern int Sqlitetest_autoext_Init(Tcl_Interp*); - extern int Sqlitetest_hexio_Init(Tcl_Interp*); - extern int Sqlitetest_malloc_Init(Tcl_Interp*); - extern int Sqlitetestschema_Init(Tcl_Interp*); - extern int Sqlitetestsse_Init(Tcl_Interp*); - extern int Sqlitetesttclvar_Init(Tcl_Interp*); - extern int SqlitetestThread_Init(Tcl_Interp*); - extern int SqlitetestOnefile_Init(); - - Md5_Init(interp); - Sqliteconfig_Init(interp); - Sqlitetest1_Init(interp); - Sqlitetest2_Init(interp); - Sqlitetest3_Init(interp); - Sqlitetest4_Init(interp); - Sqlitetest5_Init(interp); - Sqlitetest6_Init(interp); - Sqlitetest7_Init(interp); - Sqlitetest8_Init(interp); - Sqlitetest9_Init(interp); - Sqlitetestasync_Init(interp); - Sqlitetest_autoext_Init(interp); - Sqlitetest_hexio_Init(interp); - Sqlitetest_malloc_Init(interp); - Sqlitetestschema_Init(interp); - Sqlitetesttclvar_Init(interp); - SqlitetestThread_Init(interp); - SqlitetestOnefile_Init(interp); - -#ifdef SQLITE_SSE - Sqlitetestsse_Init(interp); -#endif - } -#endif - if( argc>=2 || TCLSH==2 ){ - int i; - char zArgc[32]; - sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH)); - Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); - Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); - for(i=3-TCLSH; iresult; - fprintf(stderr,"%s: %s\n", *argv, zInfo); - return 1; - } - } - if( argc<=1 || TCLSH==2 ){ - Tcl_GlobalEval(interp, zMainloop); - } - return 0; -} -#endif /* TCLSH */ -- cgit v1.1