| /* |
| ** 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> |
| |
| /* |
| * 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[] */ |
| 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. |
| */ |
| 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 */ |
| 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 */ |
| }; |
| |
| 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->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->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(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; |
| 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 = 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; |
| } |
| |
| |
| /* |
| ** 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 */ |
| ){ |
| static const char *azEnd[] = { |
| "RELEASE _tcl_transaction", /* rc==TCL_ERROR, nTransaction!=0 */ |
| "COMMIT", /* rc!=TCL_ERROR, nTransaction==0 */ |
| "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction", |
| "ROLLBACK" /* rc==TCL_ERROR, nTransaction==0 */ |
| }; |
| SqliteDb *pDb = (SqliteDb*)data[0]; |
| int rc = result; |
| const char *zEnd; |
| |
| pDb->nTransaction--; |
| zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)]; |
| |
| pDb->disableAuth++; |
| if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ |
| /* This is a tricky scenario to handle. The most likely cause of an |
| ** error is that the exec() above was an attempt to commit the |
| ** top-level transaction that returned SQLITE_BUSY. Or, less likely, |
| ** that an IO-error has occured. In either case, throw a Tcl exception |
| ** and try to rollback the transaction. |
| ** |
| ** But it could also be that the user executed one or more BEGIN, |
| ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing |
| ** this method's logic. Not clear how this would be best handled. |
| */ |
| if( rc!=TCL_ERROR ){ |
| Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); |
| rc = TCL_ERROR; |
| } |
| sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); |
| } |
| pDb->disableAuth--; |
| |
| return rc; |
| } |
| |
| /* |
| ** Search the cache for a prepared-statement object that implements the |
| ** first SQL statement in the buffer pointed to by parameter zIn. If |
| ** no such prepared-statement can be found, allocate and prepare a new |
| ** one. In either case, bind the current values of the relevant Tcl |
| ** variables to any $var, :var or @var variables in the statement. Before |
| ** returning, set *ppPreStmt to point to the prepared-statement object. |
| ** |
| ** Output parameter *pzOut is set to point to the next SQL statement in |
| ** buffer zIn, or to the '\0' byte at the end of zIn if there is no |
| ** next statement. |
| ** |
| ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned |
| ** and an error message loaded into interpreter pDb->interp. |
| */ |
| static int dbPrepareAndBind( |
| SqliteDb *pDb, /* Database object */ |
| char const *zIn, /* SQL to compile */ |
| char const **pzOut, /* OUT: Pointer to next SQL statement */ |
| SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */ |
| ){ |
| const char *zSql = zIn; /* Pointer to first SQL statement in zIn */ |
| sqlite3_stmt *pStmt; /* Prepared statement object */ |
| SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */ |
| int nSql; /* Length of zSql in bytes */ |
| int nVar; /* Number of variables in statement */ |
| int iParm = 0; /* Next free entry in apParm */ |
| int i; |
| Tcl_Interp *interp = pDb->interp; |
| |
| *ppPreStmt = 0; |
| |
| /* Trim spaces from the start of zSql and calculate the remaining length. */ |
| while( isspace(zSql[0]) ){ zSql++; } |
| nSql = strlen30(zSql); |
| |
| for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ |
| int n = pPreStmt->nSql; |
| if( nSql>=n |
| && memcmp(pPreStmt->zSql, zSql, n)==0 |
| && (zSql[n]==0 || zSql[n-1]==';') |
| ){ |
| pStmt = pPreStmt->pStmt; |
| *pzOut = &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--; |
| nVar = sqlite3_bind_parameter_count(pStmt); |
| break; |
| } |
| } |
| |
| /* If no prepared statement was found. Compile the SQL text. Also allocate |
| ** a new SqlPreparedStmt structure. */ |
| if( pPreStmt==0 ){ |
| int nByte; |
| |
| if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){ |
| Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); |
| return TCL_ERROR; |
| } |
| 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))); |
| return TCL_ERROR; |
| }else{ |
| /* The statement was a no-op. Continue to the next statement |
| ** in the SQL string. |
| */ |
| return TCL_OK; |
| } |
| } |
| |
| assert( pPreStmt==0 ); |
| nVar = sqlite3_bind_parameter_count(pStmt); |
| nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *); |
| pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte); |
| memset(pPreStmt, 0, nByte); |
| |
| pPreStmt->pStmt = pStmt; |
| pPreStmt->nSql = (*pzOut - zSql); |
| pPreStmt->zSql = sqlite3_sql(pStmt); |
| pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1]; |
| } |
| assert( pPreStmt ); |
| assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql ); |
| assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) ); |
| |
| /* Bind values to parameters that begin with $ or : */ |
| 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; |
| const 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); |
| pPreStmt->apParm[iParm++] = 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); |
| pPreStmt->apParm[iParm++] = pVar; |
| } |
| }else{ |
| sqlite3_bind_null(pStmt, i); |
| } |
| } |
| } |
| pPreStmt->nParm = iParm; |
| *ppPreStmt = pPreStmt; |
| |
| return TCL_OK; |
| } |
| |
| |
| /* |
| ** Release a statement reference obtained by calling dbPrepareAndBind(). |
| ** There should be exactly one call to this function for each call to |
| ** dbPrepareAndBind(). |
| ** |
| ** If the discard parameter is non-zero, then the statement is deleted |
| ** immediately. Otherwise it is added to the LRU list and may be returned |
| ** by a subsequent call to dbPrepareAndBind(). |
| */ |
| static void dbReleaseStmt( |
| SqliteDb *pDb, /* Database handle */ |
| SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */ |
| int discard /* True to delete (not cache) the pPreStmt */ |
| ){ |
| int i; |
| |
| /* Free the bound string and blob parameters */ |
| for(i=0; i<pPreStmt->nParm; i++){ |
| Tcl_DecrRefCount(pPreStmt->apParm[i]); |
| } |
| pPreStmt->nParm = 0; |
| |
| if( pDb->maxStmt<=0 || discard ){ |
| /* If the cache is turned off, deallocated the statement */ |
| sqlite3_finalize(pPreStmt->pStmt); |
| Tcl_Free((char *)pPreStmt); |
| }else{ |
| /* 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--; |
| } |
| } |
| } |
| |
| /* |
| ** Structure used with dbEvalXXX() functions: |
| ** |
| ** dbEvalInit() |
| ** dbEvalStep() |
| ** dbEvalFinalize() |
| ** dbEvalRowInfo() |
| ** dbEvalColumnValue() |
| */ |
| typedef struct DbEvalContext DbEvalContext; |
| struct DbEvalContext { |
| SqliteDb *pDb; /* Database handle */ |
| Tcl_Obj *pSql; /* Object holding string zSql */ |
| const char *zSql; /* Remaining SQL to execute */ |
| SqlPreparedStmt *pPreStmt; /* Current statement */ |
| int nCol; /* Number of columns returned by pStmt */ |
| Tcl_Obj *pArray; /* Name of array variable */ |
| Tcl_Obj **apColName; /* Array of column names */ |
| }; |
| |
| /* |
| ** Release any cache of column names currently held as part of |
| ** the DbEvalContext structure passed as the first argument. |
| */ |
| static void dbReleaseColumnNames(DbEvalContext *p){ |
| if( p->apColName ){ |
| int i; |
| for(i=0; i<p->nCol; i++){ |
| Tcl_DecrRefCount(p->apColName[i]); |
| } |
| Tcl_Free((char *)p->apColName); |
| p->apColName = 0; |
| } |
| p->nCol = 0; |
| } |
| |
| /* |
| ** Initialize a DbEvalContext structure. |
| ** |
| ** If pArray is not NULL, then it contains the name of a Tcl array |
| ** variable. The "*" member of this array is set to a list containing |
| ** the names of the columns returned by the statement as part of each |
| ** call to dbEvalStep(), in order from left to right. e.g. if the names |
| ** of the returned columns are a, b and c, it does the equivalent of the |
| ** tcl command: |
| ** |
| ** set ${pArray}(*) {a b c} |
| */ |
| static void dbEvalInit( |
| DbEvalContext *p, /* Pointer to structure to initialize */ |
| SqliteDb *pDb, /* Database handle */ |
| Tcl_Obj *pSql, /* Object containing SQL script */ |
| Tcl_Obj *pArray /* Name of Tcl array to set (*) element of */ |
| ){ |
| memset(p, 0, sizeof(DbEvalContext)); |
| p->pDb = pDb; |
| p->zSql = Tcl_GetString(pSql); |
| p->pSql = pSql; |
| Tcl_IncrRefCount(pSql); |
| if( pArray ){ |
| p->pArray = pArray; |
| Tcl_IncrRefCount(pArray); |
| } |
| } |
| |
| /* |
| ** Obtain information about the row that the DbEvalContext passed as the |
| ** first argument currently points to. |
| */ |
| static void dbEvalRowInfo( |
| DbEvalContext *p, /* Evaluation context */ |
| int *pnCol, /* OUT: Number of column names */ |
| Tcl_Obj ***papColName /* OUT: Array of column names */ |
| ){ |
| /* Compute column names */ |
| if( 0==p->apColName ){ |
| sqlite3_stmt *pStmt = p->pPreStmt->pStmt; |
| int i; /* Iterator variable */ |
| int nCol; /* Number of columns returned by pStmt */ |
| Tcl_Obj **apColName = 0; /* Array of column names */ |
| |
| p->nCol = nCol = sqlite3_column_count(pStmt); |
| if( nCol>0 && (papColName || p->pArray) ){ |
| apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol ); |
| for(i=0; i<nCol; i++){ |
| apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i)); |
| Tcl_IncrRefCount(apColName[i]); |
| } |
| p->apColName = apColName; |
| } |
| |
| /* If results are being stored in an array variable, then create |
| ** the array(*) entry for that array |
| */ |
| if( p->pArray ){ |
| Tcl_Interp *interp = p->pDb->interp; |
| Tcl_Obj *pColList = Tcl_NewObj(); |
| Tcl_Obj *pStar = Tcl_NewStringObj("*", -1); |
| |
| for(i=0; i<nCol; i++){ |
| Tcl_ListObjAppendElement(interp, pColList, apColName[i]); |
| } |
| Tcl_IncrRefCount(pStar); |
| Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0); |
| Tcl_DecrRefCount(pStar); |
| } |
| } |
| |
| if( papColName ){ |
| *papColName = p->apColName; |
| } |
| if( pnCol ){ |
| *pnCol = p->nCol; |
| } |
| } |
| |
| /* |
| ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is |
| ** returned, then an error message is stored in the interpreter before |
| ** returning. |
| ** |
| ** A return value of TCL_OK means there is a row of data available. The |
| ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This |
| ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK |
| ** is returned, then the SQL script has finished executing and there are |
| ** no further rows available. This is similar to SQLITE_DONE. |
| */ |
| static int dbEvalStep(DbEvalContext *p){ |
| while( p->zSql[0] || p->pPreStmt ){ |
| int rc; |
| if( p->pPreStmt==0 ){ |
| rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt); |
| if( rc!=TCL_OK ) return rc; |
| }else{ |
| int rcs; |
| SqliteDb *pDb = p->pDb; |
| SqlPreparedStmt *pPreStmt = p->pPreStmt; |
| sqlite3_stmt *pStmt = pPreStmt->pStmt; |
| |
| rcs = sqlite3_step(pStmt); |
| if( rcs==SQLITE_ROW ){ |
| return TCL_OK; |
| } |
| if( p->pArray ){ |
| dbEvalRowInfo(p, 0, 0); |
| } |
| rcs = sqlite3_reset(pStmt); |
| |
| pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1); |
| pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1); |
| pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1); |
| dbReleaseColumnNames(p); |
| p->pPreStmt = 0; |
| |
| if( rcs!=SQLITE_OK ){ |
| /* If a run-time error occurs, report the error and stop reading |
| ** the SQL. */ |
| Tcl_SetObjResult(pDb->interp, dbTextToObj(sqlite3_errmsg(pDb->db))); |
| dbReleaseStmt(pDb, pPreStmt, 1); |
| return TCL_ERROR; |
| }else{ |
| dbReleaseStmt(pDb, pPreStmt, 0); |
| } |
| } |
| } |
| |
| /* Finished */ |
| return TCL_BREAK; |
| } |
| |
| /* |
| ** Free all resources currently held by the DbEvalContext structure passed |
| ** as the first argument. There should be exactly one call to this function |
| ** for each call to dbEvalInit(). |
| */ |
| static void dbEvalFinalize(DbEvalContext *p){ |
| if( p->pPreStmt ){ |
| sqlite3_reset(p->pPreStmt->pStmt); |
| dbReleaseStmt(p->pDb, p->pPreStmt, 0); |
| p->pPreStmt = 0; |
| } |
| if( p->pArray ){ |
| Tcl_DecrRefCount(p->pArray); |
| p->pArray = 0; |
| } |
| Tcl_DecrRefCount(p->pSql); |
| dbReleaseColumnNames(p); |
| } |
| |
| /* |
| ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains |
| ** the value for the iCol'th column of the row currently pointed to by |
| ** the DbEvalContext structure passed as the first argument. |
| */ |
| static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){ |
| sqlite3_stmt *pStmt = p->pPreStmt->pStmt; |
| switch( sqlite3_column_type(pStmt, iCol) ){ |
| case SQLITE_BLOB: { |
| int bytes = sqlite3_column_bytes(pStmt, iCol); |
| const char *zBlob = sqlite3_column_blob(pStmt, iCol); |
| if( !zBlob ) bytes = 0; |
| return Tcl_NewByteArrayObj((u8*)zBlob, bytes); |
| } |
| case SQLITE_INTEGER: { |
| sqlite_int64 v = sqlite3_column_int64(pStmt, iCol); |
| if( v>=-2147483647 && v<=2147483647 ){ |
| return Tcl_NewIntObj(v); |
| }else{ |
| return Tcl_NewWideIntObj(v); |
| } |
| } |
| case SQLITE_FLOAT: { |
| return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol)); |
| } |
| case SQLITE_NULL: { |
| return dbTextToObj(p->pDb->zNull); |
| } |
| } |
| |
| return dbTextToObj((char *)sqlite3_column_text(pStmt, iCol)); |
| } |
| |
| /* |
| ** If using Tcl version 8.6 or greater, use the NR functions to avoid |
| ** recursive evalution of scripts by the [db eval] and [db trans] |
| ** commands. Even if the headers used while compiling the extension |
| ** are 8.6 or newer, the code still tests the Tcl version at runtime. |
| ** This allows stubs-enabled builds to be used with older Tcl libraries. |
| */ |
| #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6) |
| # define SQLITE_TCL_NRE 1 |
| static int DbUseNre(void){ |
| int major, minor; |
| Tcl_GetVersion(&major, &minor, 0, 0); |
| return( (major==8 && minor>=6) || major>8 ); |
| } |
| #else |
| /* |
| ** Compiling using headers earlier than 8.6. In this case NR cannot be |
| ** used, so DbUseNre() to always return zero. Add #defines for the other |
| ** Tcl_NRxxx() functions to prevent them from causing compilation errors, |
| ** even though the only invocations of them are within conditional blocks |
| ** of the form: |
| ** |
| ** if( DbUseNre() ) { ... } |
| */ |
| # define SQLITE_TCL_NRE 0 |
| # define DbUseNre() 0 |
| # define Tcl_NRAddCallback(a,b,c,d,e,f) 0 |
| # define Tcl_NREvalObj(a,b,c) 0 |
| # define Tcl_NRCreateCommand(a,b,c,d,e,f) 0 |
| #endif |
| |
| /* |
| ** This function is part of the implementation of the command: |
| ** |
| ** $db eval SQL ?ARRAYNAME? SCRIPT |
| */ |
| static int DbEvalNextCmd( |
| ClientData data[], /* data[0] is the (DbEvalContext*) */ |
| Tcl_Interp *interp, /* Tcl interpreter */ |
| int result /* Result so far */ |
| ){ |
| int rc = result; /* Return code */ |
| |
| /* The first element of the data[] array is a pointer to a DbEvalContext |
| ** structure allocated using Tcl_Alloc(). The second element of data[] |
| ** is a pointer to a Tcl_Obj containing the script to run for each row |
| ** returned by the queries encapsulated in data[0]. */ |
| DbEvalContext *p = (DbEvalContext *)data[0]; |
| Tcl_Obj *pScript = (Tcl_Obj *)data[1]; |
| Tcl_Obj *pArray = p->pArray; |
| |
| while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){ |
| int i; |
| int nCol; |
| Tcl_Obj **apColName; |
| dbEvalRowInfo(p, &nCol, &apColName); |
| for(i=0; i<nCol; i++){ |
| Tcl_Obj *pVal = dbEvalColumnValue(p, i); |
| if( pArray==0 ){ |
| Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); |
| }else{ |
| Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); |
| } |
| } |
| |
| /* The required interpreter variables are now populated with the data |
| ** from the current row. If using NRE, schedule callbacks to evaluate |
| ** script pScript, then to invoke this function again to fetch the next |
| ** row (or clean up if there is no next row or the script throws an |
| ** exception). After scheduling the callbacks, return control to the |
| ** caller. |
| ** |
| ** If not using NRE, evaluate pScript directly and continue with the |
| ** next iteration of this while(...) loop. */ |
| if( DbUseNre() ){ |
| Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0); |
| return Tcl_NREvalObj(interp, pScript, 0); |
| }else{ |
| rc = Tcl_EvalObjEx(interp, pScript, 0); |
| } |
| } |
| |
| Tcl_DecrRefCount(pScript); |
| dbEvalFinalize(p); |
| Tcl_Free((char *)p); |
| |
| if( rc==TCL_OK || rc==TCL_BREAK ){ |
| Tcl_ResetResult(interp); |
| rc = TCL_OK; |
| } |
| return rc; |
| } |
| |
| /* |
| ** 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", "backup", "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", |
| "restore", "rollback_hook", "status", |
| "timeout", "total_changes", "trace", |
| "transaction", "unlock_notify", "update_hook", |
| "version", "wal_hook", 0 |
| }; |
| enum DB_enum { |
| DB_AUTHORIZER, DB_BACKUP, 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_RESTORE, DB_ROLLBACK_HOOK, DB_STATUS, |
| DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE, |
| DB_TRANSACTION, DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK, |
| DB_VERSION, DB_WAL_HOOK |
| }; |
| /* 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 backup ?DATABASE? FILENAME |
| ** |
| ** Open or create a database file named FILENAME. Transfer the |
| ** content of local database DATABASE (default: "main") into the |
| ** FILENAME database. |
| */ |
| case DB_BACKUP: { |
| const char *zDestFile; |
| const char *zSrcDb; |
| sqlite3 *pDest; |
| sqlite3_backup *pBackup; |
| |
| if( objc==3 ){ |
| zSrcDb = "main"; |
| zDestFile = Tcl_GetString(objv[2]); |
| }else if( objc==4 ){ |
| zSrcDb = Tcl_GetString(objv[2]); |
| zDestFile = Tcl_GetString(objv[3]); |
| }else{ |
| Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); |
| return TCL_ERROR; |
| } |
| rc = sqlite3_open(zDestFile, &pDest); |
| if( rc!=SQLITE_OK ){ |
| Tcl_AppendResult(interp, "cannot open target database: ", |
| sqlite3_errmsg(pDest), (char*)0); |
| sqlite3_close(pDest); |
| return TCL_ERROR; |
| } |
| pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb); |
| if( pBackup==0 ){ |
| Tcl_AppendResult(interp, "backup failed: ", |
| sqlite3_errmsg(pDest), (char*)0); |
| sqlite3_close(pDest); |
| return TCL_ERROR; |
| } |
| while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){} |
| sqlite3_backup_finish(pBackup); |
| if( rc==SQLITE_DONE ){ |
| rc = TCL_OK; |
| }else{ |
| Tcl_AppendResult(interp, "backup failed: ", |
| sqlite3_errmsg(pDest), (char*)0); |
| rc = TCL_ERROR; |
| } |
| sqlite3_close(pDest); |
| 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[2],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 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 = strlen30(zSep); |
| nNull = strlen30(zNull); |
| if( nSep==0 ){ |
| Tcl_AppendResult(interp,"Error: non-null separator required for copy",0); |
| return TCL_ERROR; |
| } |
| if(strcmp(zConflict, "rollback") != 0 && |
| strcmp(zConflict, "abort" ) != 0 && |
| strcmp(zConflict, "fail" ) != 0 && |
| strcmp(zConflict, "ignore" ) != 0 && |
| strcmp(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 = strlen30(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 = strlen30(zSql); |
| for(i=1; i<nCol; i++){ |
| zSql[j++] = ','; |
| zSql[j++] = '?'; |
| } |
| zSql[j++] = ')'; |
| zSql[j] = 0; |
| rc = sqlite3_prepare(pDb->db, 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( i<nCol ){ |
| azCol[i] = &z[nSep]; |
| z += nSep-1; |
| } |
| } |
| } |
| if( i+1!=nCol ){ |
| char *zErr; |
| int nErr = strlen30(zFile) + 200; |
| zErr = malloc(nErr); |
| if( zErr ){ |
| sqlite3_snprintf(nErr, zErr, |
| "Error: %s line %d: expected %d columns of data but found %d", |
| zFile, lineno, nCol, i+1); |
| Tcl_AppendResult(interp, zErr, 0); |
| free(zErr); |
| } |
| zCommit = "ROLLBACK"; |
| break; |
| } |
| for(i=0; i<nCol; i++){ |
| /* check for null data, if so, bind as null */ |
| if( (nNull>0 && strcmp(azCol[i], zNull)==0) |
| || strlen30(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 exists $sql |
| ** $db onecolumn $sql |
| ** |
| ** The onecolumn method is the equivalent of: |
| ** lindex [$db eval $sql] 0 |
| */ |
| case DB_EXISTS: |
| case DB_ONECOLUMN: { |
| DbEvalContext sEval; |
| if( objc!=3 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "SQL"); |
| return TCL_ERROR; |
| } |
| |
| dbEvalInit(&sEval, pDb, objv[2], 0); |
| rc = dbEvalStep(&sEval); |
| if( choice==DB_ONECOLUMN ){ |
| if( rc==TCL_OK ){ |
| Tcl_SetObjResult(interp, dbEvalColumnValue(&sEval, 0)); |
| } |
| }else if( rc==TCL_BREAK || rc==TCL_OK ){ |
| Tcl_SetObjResult(interp, Tcl_NewBooleanObj(rc==TCL_OK)); |
| } |
| dbEvalFinalize(&sEval); |
| |
| if( rc==TCL_BREAK ){ |
| rc = TCL_OK; |
| } |
| break; |
| } |
| |
| /* |
| ** $db eval $sql ?array? ?{ ...code... }? |
| ** |
| ** 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. |
| */ |
| case DB_EVAL: { |
| if( objc<3 || objc>5 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); |
| return TCL_ERROR; |
| } |
| |
| if( objc==3 ){ |
| DbEvalContext sEval; |
| Tcl_Obj *pRet = Tcl_NewObj(); |
| Tcl_IncrRefCount(pRet); |
| dbEvalInit(&sEval, pDb, objv[2], 0); |
| while( TCL_OK==(rc = dbEvalStep(&sEval)) ){ |
| int i; |
| int nCol; |
| dbEvalRowInfo(&sEval, &nCol, 0); |
| for(i=0; i<nCol; i++){ |
| Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i)); |
| } |
| } |
| dbEvalFinalize(&sEval); |
| if( rc==TCL_BREAK ){ |
| Tcl_SetObjResult(interp, pRet); |
| rc = TCL_OK; |
| } |
| Tcl_DecrRefCount(pRet); |
| }else{ |
| ClientData cd[2]; |
| DbEvalContext *p; |
| Tcl_Obj *pArray = 0; |
| Tcl_Obj *pScript; |
| |
| if( objc==5 && *(char *)Tcl_GetString(objv[3]) ){ |
| pArray = objv[3]; |
| } |
| pScript = objv[objc-1]; |
| Tcl_IncrRefCount(pScript); |
| |
| p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext)); |
| dbEvalInit(p, pDb, objv[2], pArray); |
| |
| cd[0] = (void *)p; |
| cd[1] = (void *)pScript; |
| rc = DbEvalNextCmd(cd, interp, TCL_OK); |
| } |
| break; |
| } |
| |
| /* |
| ** $db function NAME [-argcount N] 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; |
| int nArg = -1; |
| if( objc==6 ){ |
| const char *z = Tcl_GetString(objv[3]); |
| int n = strlen30(z); |
| if( n>2 && strncmp(z, "-argcount",n)==0 ){ |
| if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR; |
| if( nArg<0 ){ |
| Tcl_AppendResult(interp, "number of arguments must be non-negative", |
| (char*)0); |
| return TCL_ERROR; |
| } |
| } |
| pScript = objv[5]; |
| }else if( objc!=4 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT"); |
| return TCL_ERROR; |
| }else{ |
| pScript = objv[3]; |
| } |
| zName = Tcl_GetStringFromObj(objv[2], 0); |
| 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, nArg, SQLITE_UTF8, |
| pFunc, tclSqlFunc, 0, 0); |
| if( rc!=SQLITE_OK ){ |
| rc = TCL_ERROR; |
| Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); |
| } |
| 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_EXISTS. |
| */ |
| |
| /* $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; |
| } |
| #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) |
| 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 restore ?DATABASE? FILENAME |
| ** |
| ** Open a database file named FILENAME. Transfer the content |
| ** of FILENAME into the local database DATABASE (default: "main"). |
| */ |
| case DB_RESTORE: { |
| const char *zSrcFile; |
| const char *zDestDb; |
| sqlite3 *pSrc; |
| sqlite3_backup *pBackup; |
| int nTimeout = 0; |
| |
| if( objc==3 ){ |
| zDestDb = "main"; |
| zSrcFile = Tcl_GetString(objv[2]); |
| }else if( objc==4 ){ |
| zDestDb = Tcl_GetString(objv[2]); |
| zSrcFile = Tcl_GetString(objv[3]); |
| }else{ |
| Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); |
| return TCL_ERROR; |
| } |
| rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0); |
| if( rc!=SQLITE_OK ){ |
| Tcl_AppendResult(interp, "cannot open source database: ", |
| sqlite3_errmsg(pSrc), (char*)0); |
| sqlite3_close(pSrc); |
| return TCL_ERROR; |
| } |
| pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main"); |
| if( pBackup==0 ){ |
| Tcl_AppendResult(interp, "restore failed: ", |
| sqlite3_errmsg(pDb->db), (char*)0); |
| sqlite3_close(pSrc); |
| return TCL_ERROR; |
| } |
| while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK |
| || rc==SQLITE_BUSY ){ |
| if( rc==SQLITE_BUSY ){ |
| if( nTimeout++ >= 3 ) break; |
| sqlite3_sleep(100); |
| } |
| } |
| sqlite3_backup_finish(pBackup); |
| if( rc==SQLITE_DONE ){ |
| rc = TCL_OK; |
| }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){ |
| Tcl_AppendResult(interp, "restore failed: source database busy", |
| (char*)0); |
| rc = TCL_ERROR; |
| }else{ |
| Tcl_AppendResult(interp, "restore failed: ", |
| sqlite3_errmsg(pDb->db), (char*)0); |
| rc = TCL_ERROR; |
| } |
| sqlite3_close(pSrc); |
| break; |
| } |
| |
| /* |
| ** $db status (step|sort|autoindex) |
| ** |
| ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or |
| ** SQLITE_STMTSTATUS_SORT for the most recent eval. |
| */ |
| case DB_STATUS: { |
| int v; |
| const char *zOp; |
| if( objc!=3 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)"); |
| return TCL_ERROR; |
| } |
| zOp = Tcl_GetString(objv[2]); |
| if( strcmp(zOp, "step")==0 ){ |
| v = pDb->nStep; |
| }else if( strcmp(zOp, "sort")==0 ){ |
| v = pDb->nSort; |
| }else if( strcmp(zOp, "autoindex")==0 ){ |
| v = pDb->nIndex; |
| }else{ |
| Tcl_AppendResult(interp, |
| "bad argument: should be autoindex, step, or sort", |
| (char*)0); |
| return TCL_ERROR; |
| } |
| Tcl_SetObjResult(interp, Tcl_NewIntObj(v)); |
| 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; |
| } |
| #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) |
| 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: { |
| Tcl_Obj *pScript; |
| const char *zBegin = "SAVEPOINT _tcl_transaction"; |
| if( objc!=3 && objc!=4 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); |
| return TCL_ERROR; |
| } |
| |
| if( pDb->nTransaction==0 && objc==4 ){ |
| 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[objc-1]; |
| |
| /* Run the SQLite BEGIN command to open a transaction or savepoint. */ |
| pDb->disableAuth++; |
| rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0); |
| pDb->disableAuth--; |
| if( rc!=SQLITE_OK ){ |
| Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); |
| return TCL_ERROR; |
| } |
| pDb->nTransaction++; |
| |
| /* If using NRE, schedule a callback to invoke the script pScript, then |
| ** a second callback to commit (or rollback) the transaction or savepoint |
| ** opened above. If not using NRE, evaluate the script directly, then |
| ** call function DbTransPostCmd() to commit (or rollback) the transaction |
| ** or savepoint. */ |
| if( DbUseNre() ){ |
| Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0); |
| Tcl_NREvalObj(interp, pScript, 0); |
| }else{ |
| rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0)); |
| } |
| break; |
| } |
| |
| /* |
| ** $db unlock_notify ?script? |
| */ |
| case DB_UNLOCK_NOTIFY: { |
| #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY |
| Tcl_AppendResult(interp, "unlock_notify not available in this build", 0); |
| rc = TCL_ERROR; |
| #else |
| if( objc!=2 && objc!=3 ){ |
| Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); |
| rc = TCL_ERROR; |
| }else{ |
| void (*xNotify)(void **, int) = 0; |
| void *pNotifyArg = 0; |
| |
| if( pDb->pUnlockNotify ){ |
| Tcl_DecrRefCount(pDb->pUnlockNotify); |
| pDb->pUnlockNotify = 0; |
| } |
| |
| if( objc==3 ){ |
| xNotify = DbUnlockNotify; |
| pNotifyArg = (void *)pDb; |
| pDb->pUnlockNotify = objv[2]; |
| Tcl_IncrRefCount(pDb->pUnlockNotify); |
| } |
| |
| if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){ |
| Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); |
| rc = TCL_ERROR; |
| } |
| } |
| #endif |
| break; |
| } |
| |
| /* |
| ** $db wal_hook ?script? |
| ** $db update_hook ?script? |
| ** $db rollback_hook ?script? |
| */ |
| case DB_WAL_HOOK: |
| 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 if( choice==DB_WAL_HOOK ){ |
| ppHook = &pDb->pWalHook; |
| }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); |
| sqlite3_wal_hook(pDb->db,(pDb->pWalHook?DbWalHandler: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; |
| } |
| |
| #if SQLITE_TCL_NRE |
| /* |
| ** Adaptor that provides an objCmd interface to the NRE-enabled |
| ** interface implementation. |
| */ |
| static int DbObjCmdAdaptor( |
| void *cd, |
| Tcl_Interp *interp, |
| int objc, |
| Tcl_Obj *const*objv |
| ){ |
| return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv); |
| } |
| #endif /* SQLITE_TCL_NRE */ |
| |
| /* |
| ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? |
| ** ?-create BOOLEAN? ?-nomutex 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; |
| Tcl_DString translatedFilename; |
| |
| /* In normal use, each TCL interpreter runs in a single thread. So |
| ** by default, we can turn of mutexing on SQLite database connections. |
| ** However, for testing purposes it is useful to have mutexes turned |
| ** on. So, by default, mutexes default off. But if compiled with |
| ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on. |
| */ |
| #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX |
| flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX; |
| #else |
| flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; |
| #endif |
| |
| 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+1<objc; i+=2){ |
| zArg = Tcl_GetString(objv[i]); |
| if( strcmp(zArg,"-key")==0 ){ |
| pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey); |
| }else if( strcmp(zArg, "-vfs")==0 ){ |
| zVfs = Tcl_GetString(objv[i+1]); |
| }else if( strcmp(zArg, "-readonly")==0 ){ |
| int b; |
| if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; |
| if( b ){ |
| flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE); |
| flags |= SQLITE_OPEN_READONLY; |
| }else{ |
| flags &= ~SQLITE_OPEN_READONLY; |
| flags |= SQLITE_OPEN_READWRITE; |
| } |
| }else if( strcmp(zArg, "-create")==0 ){ |
| int b; |
| if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; |
| if( b && (flags & SQLITE_OPEN_READONLY)==0 ){ |
| flags |= SQLITE_OPEN_CREATE; |
| }else{ |
| flags &= ~SQLITE_OPEN_CREATE; |
| } |
| }else if( strcmp(zArg, "-nomutex")==0 ){ |
| int b; |
| if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; |
| if( b ){ |
| flags |= SQLITE_OPEN_NOMUTEX; |
| flags &= ~SQLITE_OPEN_FULLMUTEX; |
| }else{ |
| flags &= ~SQLITE_OPEN_NOMUTEX; |
| } |
| }else if( strcmp(zArg, "-fullmutex")==0 ){ |
| int b; |
| if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; |
| if( b ){ |
| flags |= SQLITE_OPEN_FULLMUTEX; |
| flags &= ~SQLITE_OPEN_NOMUTEX; |
| }else{ |
| flags &= ~SQLITE_OPEN_FULLMUTEX; |
| } |
| }else{ |
| Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0); |
| return TCL_ERROR; |
| } |
| } |
| if( objc<3 || (objc&1)!=1 ){ |
| Tcl_WrongNumArgs(interp, 1, objv, |
| "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" |
| " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" |
| #ifdef SQLITE_HAS_CODEC |
| " ?-key CODECKEY?" |
| #endif |
| ); |
| return TCL_ERROR; |
| } |
| zErrMsg = 0; |
| p = (SqliteDb*)Tcl_Alloc( sizeof(*p) ); |
| if( p==0 ){ |
| Tcl_SetResult(interp, "malloc failed", TCL_STATIC); |
| return TCL_ERROR; |
| } |
| memset(p, 0, sizeof(*p)); |
| zFile = Tcl_GetStringFromObj(objv[2], 0); |
| zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename); |
| sqlite3_open_v2(zFile, &p->db, 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_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); |
| if( DbUseNre() ){ |
| Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd, |
| (char*)p, DbDeleteCmd); |
| }else{ |
| 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. |
| ** |
| ** The EXTERN macros are required by TCL in order to work on windows. |
| */ |
| 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); |
| |
| #ifndef SQLITE_3_SUFFIX_ONLY |
| /* The "sqlite" alias is undocumented. It is here only to support |
| ** legacy scripts. All new scripts should use only the "sqlite3" |
| ** command. |
| */ |
| Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); |
| #endif |
| |
| 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; } |
| EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} |
| |
| |
| #ifndef SQLITE_3_SUFFIX_ONLY |
| int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } |
| int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } |
| int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } |
| int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } |
| int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } |
| int Tclsqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} |
| #endif |
| |
| #ifdef TCLSH |
| /***************************************************************************** |
| ** All of the code that follows is used to build standalone TCL interpreters |
| ** that are statically linked with SQLite. Enable these by compiling |
| ** with -DTCLSH=n where n can be 1 or 2. An n of 1 generates a standard |
| ** tclsh but with SQLite built in. An n of 2 generates the SQLite space |
| ** analysis program. |
| */ |
| |
| #if defined(SQLITE_TEST) || defined(SQLITE_TCLMD5) |
| /* |
| * This code implements the MD5 message-digest algorithm. |
| * The algorithm is due to Ron Rivest. This code was |
| * written by Colin Plumb in 1993, no copyright is claimed. |
| * This code is in the public domain; do with it what you wish. |
| * |
| * Equivalent code is available from RSA Data Security, Inc. |
| * This code has been tested against that, and is equivalent, |
| * except that you don't need to include two pages of legalese |
| * with every copy. |
| * |
| * To compute the message digest of a chunk of bytes, declare an |
| * MD5Context structure, pass it to MD5Init, call MD5Update as |
| * needed on buffers full of bytes, and then call MD5Final, which |
| * will fill a supplied 16-byte array with the digest. |
| */ |
| |
| /* |
| * If compiled on a machine that doesn't have a 32-bit integer, |
| * you just set "uint32" to the appropriate datatype for an |
| * unsigned 32-bit integer. For example: |
| * |
| * cc -Duint32='unsigned long' md5.c |
| * |
| */ |
| #ifndef uint32 |
| # define uint32 unsigned int |
| #endif |
| |
| struct MD5Context { |
| int isInit; |
| uint32 buf[4]; |
| uint32 bits[2]; |
| unsigned char in[64]; |
| }; |
| typedef struct MD5Context MD5Context; |
| |
| /* |
| * Note: this code is harmless on little-endian machines. |
| */ |
| static void byteReverse (unsigned char *buf, unsigned longs){ |
| uint32 t; |
| do { |
| t = (uint32)((unsigned)buf[3]<<8 | buf[2]) << 16 | |
| ((unsigned)buf[1]<<8 | buf[0]); |
| *(uint32 *)buf = t; |
| buf += 4; |
| } while (--longs); |
| } |
| /* The four core functions - F1 is optimized somewhat */ |
| |
| /* #define F1(x, y, z) (x & y | ~x & z) */ |
| #define F1(x, y, z) (z ^ (x & (y ^ z))) |
| #define F2(x, y, z) F1(z, x, y) |
| #define F3(x, y, z) (x ^ y ^ z) |
| #define F4(x, y, z) (y ^ (x | ~z)) |
| |
| /* This is the central step in the MD5 algorithm. */ |
| #define MD5STEP(f, w, x, y, z, data, s) \ |
| ( w += f(x, y, z) + data, w = w<<s | w>>(32-s), w += x ) |
| |
| /* |
| * The core of the MD5 algorithm, this alters an existing MD5 hash to |
| * reflect the addition of 16 longwords of new data. MD5Update blocks |
| * the data and converts bytes into longwords for this routine. |
| */ |
| static void MD5Transform(uint32 buf[4], const uint32 in[16]){ |
| register uint32 a, b, c, d; |
| |
| a = buf[0]; |
| b = buf[1]; |
| c = buf[2]; |
| d = buf[3]; |
| |
| MD5STEP(F1, a, b, c, d, in[ 0]+0xd76aa478, 7); |
| MD5STEP(F1, d, a, b, c, in[ 1]+0xe8c7b756, 12); |
| MD5STEP(F1, c, d, a, b, in[ 2]+0x242070db, 17); |
| MD5STEP(F1, b, c, d, a, in[ 3]+0xc1bdceee, 22); |
| MD5STEP(F1, a, b, c, d, in[ 4]+0xf57c0faf, 7); |
| MD5STEP(F1, d, a, b, c, in[ 5]+0x4787c62a, 12); |
| MD5STEP(F1, c, d, a, b, in[ 6]+0xa8304613, 17); |
| MD5STEP(F1, b, c, d, a, in[ 7]+0xfd469501, 22); |
| MD5STEP(F1, a, b, c, d, in[ 8]+0x698098d8, 7); |
| MD5STEP(F1, d, a, b, c, in[ 9]+0x8b44f7af, 12); |
| MD5STEP(F1, c, d, a, b, in[10]+0xffff5bb1, 17); |
| MD5STEP(F1, b, c, d, a, in[11]+0x895cd7be, 22); |
| MD5STEP(F1, a, b, c, d, in[12]+0x6b901122, 7); |
| MD5STEP(F1, d, a, b, c, in[13]+0xfd987193, 12); |
| MD5STEP(F1, c, d, a, b, in[14]+0xa679438e, 17); |
| MD5STEP(F1, b, c, d, a, in[15]+0x49b40821, 22); |
| |
| MD5STEP(F2, a, b, c, d, in[ 1]+0xf61e2562, 5); |
| MD5STEP(F2, d, a, b, c, in[ 6]+0xc040b340, 9); |
| MD5STEP(F2, c, d, a, b, in[11]+0x265e5a51, 14); |
| MD5STEP(F2, b, c, d, a, in[ 0]+0xe9b6c7aa, 20); |
| MD5STEP(F2, a, b, c, d, in[ 5]+0xd62f105d, 5); |
| MD5STEP(F2, d, a, b, c, in[10]+0x02441453, 9); |
| MD5STEP(F2, c, d, a, b, in[15]+0xd8a1e681, 14); |
| MD5STEP(F2, b, c, d, a, in[ 4]+0xe7d3fbc8, 20); |
| MD5STEP(F2, a, b, c, d, in[ 9]+0x21e1cde6, 5); |
| MD5STEP(F2, d, a, b, c, in[14]+0xc33707d6, 9); |
| MD5STEP(F2, c, d, a, b, in[ 3]+0xf4d50d87, 14); |
| MD5STEP(F2, b, c, d, a, in[ 8]+0x455a14ed, 20); |
| MD5STEP(F2, a, b, c, d, in[13]+0xa9e3e905, 5); |
| MD5STEP(F2, d, a, b, c, in[ 2]+0xfcefa3f8, 9); |
| MD5STEP(F2, c, d, a, b, in[ 7]+0x676f02d9, 14); |
| MD5STEP(F2, b, c, d, a, in[12]+0x8d2a4c8a, 20); |
| |
| MD5STEP(F3, a, b, c, d, in[ 5]+0xfffa3942, 4); |
| MD5STEP(F3, d, a, b, c, in[ 8]+0x8771f681, 11); |
| MD5STEP(F3, c, d, a, b, in[11]+0x6d9d6122, 16); |
| MD5STEP(F3, b, c, d, a, in[14]+0xfde5380c, 23); |
| MD5STEP(F3, a, b, c, d, in[ 1]+0xa4beea44, 4); |
| MD5STEP(F3, d, a, b, c, in[ 4]+0x4bdecfa9, 11); |
| MD5STEP(F3, c, d, a, b, in[ 7]+0xf6bb4b60, 16); |
| MD5STEP(F3, b, c, d, a, in[10]+0xbebfbc70, 23); |
| MD5STEP(F3, a, b, c, d, in[13]+0x289b7ec6, 4); |
| MD5STEP(F3, d, a, b, c, in[ 0]+0xeaa127fa, 11); |
| MD5STEP(F3, c, d, a, b, in[ 3]+0xd4ef3085, 16); |
| MD5STEP(F3, b, c, d, a, in[ 6]+0x04881d05, 23); |
| MD5STEP(F3, a, b, c, d, in[ 9]+0xd9d4d039, 4); |
| MD5STEP(F3, d, a, b, c, in[12]+0xe6db99e5, 11); |
| MD5STEP(F3, c, d, a, b, in[15]+0x1fa27cf8, 16); |
| MD5STEP(F3, b, c, d, a, in[ 2]+0xc4ac5665, 23); |
| |
| MD5STEP(F4, a, b, c, d, in[ 0]+0xf4292244, 6); |
| MD5STEP(F4, d, a, b, c, in[ 7]+0x432aff97, 10); |
| MD5STEP(F4, c, d, a, b, in[14]+0xab9423a7, 15); |
| MD5STEP(F4, b, c, d, a, in[ 5]+0xfc93a039, 21); |
| MD5STEP(F4, a, b, c, d, in[12]+0x655b59c3, 6); |
| MD5STEP(F4, d, a, b, c, in[ 3]+0x8f0ccc92, 10); |
| MD5STEP(F4, c, d, a, b, in[10]+0xffeff47d, 15); |
| MD5STEP(F4, b, c, d, a, in[ 1]+0x85845dd1, 21); |
| MD5STEP(F4, a, b, c, d, in[ 8]+0x6fa87e4f, 6); |
| MD5STEP(F4, d, a, b, c, in[15]+0xfe2ce6e0, 10); |
| MD5STEP(F4, c, d, a, b, in[ 6]+0xa3014314, 15); |
| MD5STEP(F4, b, c, d, a, in[13]+0x4e0811a1, 21); |
| MD5STEP(F4, a, b, c, d, in[ 4]+0xf7537e82, 6); |
| MD5STEP(F4, d, a, b, c, in[11]+0xbd3af235, 10); |
| MD5STEP(F4, c, d, a, b, in[ 2]+0x2ad7d2bb, 15); |
| MD5STEP(F4, b, c, d, a, in[ 9]+0xeb86d391, 21); |
| |
| buf[0] += a; |
| buf[1] += b; |
| buf[2] += c; |
| buf[3] += d; |
| } |
| |
| /* |
| * Start MD5 accumulation. Set bit count to 0 and buffer to mysterious |
| * initialization constants. |
| */ |
| static void MD5Init(MD5Context *ctx){ |
| ctx->isInit = 1; |
| ctx->buf[0] = 0x67452301; |
| ctx->buf[1] = 0xefcdab89; |
| ctx->buf[2] = 0x98badcfe; |
| ctx->buf[3] = 0x10325476; |
| ctx->bits[0] = 0; |
| ctx->bits[1] = 0; |
| } |
| |
| /* |
| * Update context to reflect the concatenation of another buffer full |
| * of bytes. |
| */ |
| static |
| void MD5Update(MD5Context *ctx, const unsigned char *buf, unsigned int len){ |
| uint32 t; |
| |
| /* Update bitcount */ |
| |
| t = ctx->bits[0]; |
| if ((ctx->bits[0] = t + ((uint32)len << 3)) < t) |
| ctx->bits[1]++; /* Carry from low to high */ |
| ctx->bits[1] += len >> 29; |
| |
| t = (t >> 3) & 0x3f; /* Bytes already in shsInfo->data */ |
| |
| /* Handle any leading odd-sized chunks */ |
| |
| if ( t ) { |
| unsigned char *p = (unsigned char *)ctx->in + t; |
| |
| t = 64-t; |
| if (len < t) { |
| memcpy(p, buf, len); |
| return; |
| } |
| memcpy(p, buf, t); |
| byteReverse(ctx->in, 16); |
| MD5Transform(ctx->buf, (uint32 *)ctx->in); |
| buf += t; |
| len -= t; |
| } |
| |
| /* Process data in 64-byte chunks */ |
| |
| while (len >= 64) { |
| memcpy(ctx->in, buf, 64); |
| byteReverse(ctx->in, 16); |
| MD5Transform(ctx->buf, (uint32 *)ctx->in); |
| buf += 64; |
| len -= 64; |
| } |
| |
| /* Handle any remaining bytes of data. */ |
| |
| memcpy(ctx->in, buf, len); |
| } |
| |
| /* |
| * Final wrapup - pad to 64-byte boundary with the bit pattern |
| * 1 0* (64-bit count of bits processed, MSB-first) |
| */ |
| static void MD5Final(unsigned char digest[16], MD5Context *ctx){ |
| unsigned count; |
| unsigned char *p; |
| |
| /* Compute number of bytes mod 64 */ |
| count = (ctx->bits[0] >> 3) & 0x3F; |
| |
| /* Set the first char of padding to 0x80. This is safe since there is |
| always at least one byte free */ |
| p = ctx->in + count; |
| *p++ = 0x80; |
| |
| /* Bytes of padding needed to make 64 bytes */ |
| count = 64 - 1 - count; |
| |
| /* Pad out to 56 mod 64 */ |
| if (count < 8) { |
| /* Two lots of padding: Pad the first block to 64 bytes */ |
| memset(p, 0, count); |
| byteReverse(ctx->in, 16); |
| MD5Transform(ctx->buf, (uint32 *)ctx->in); |
| |
| /* Now fill the next block with 56 bytes */ |
| memset(ctx->in, 0, 56); |
| } else { |
| /* Pad block to 56 bytes */ |
| memset(p, 0, count-8); |
| } |
| byteReverse(ctx->in, 14); |
| |
| /* Append length in bits and transform */ |
| ((uint32 *)ctx->in)[ 14 ] = ctx->bits[0]; |
| ((uint32 *)ctx->in)[ 15 ] = ctx->bits[1]; |
| |
| MD5Transform(ctx->buf, (uint32 *)ctx->in); |
| byteReverse((unsigned char *)ctx->buf, 4); |
| memcpy(digest, ctx->buf, 16); |
| memset(ctx, 0, sizeof(ctx)); /* In case it is sensitive */ |
| } |
| |
| /* |
| ** Convert a 128-bit MD5 digest into a 32-digit base-16 number. |
| */ |
| static void MD5DigestToBase16(unsigned char *digest, char *zBuf){ |
| static char const zEncode[] = "0123456789abcdef"; |
| int i, j; |
| |
| for(j=i=0; i<16; i++){ |
| int a = digest[i]; |
| zBuf[j++] = zEncode[(a>>4)&0xf]; |
| zBuf[j++] = zEncode[a & 0xf]; |
| } |
| zBuf[j] = 0; |
| } |
| |
| |
| /* |
| ** Convert a 128-bit MD5 digest into sequency of eight 5-digit integers |
| ** each representing 16 bits of the digest and separated from each |
| ** other by a "-" character. |
| */ |
| static void MD5DigestToBase10x8(unsigned char digest[16], char zDigest[50]){ |
| int i, j; |
| unsigned int x; |
| for(i=j=0; i<16; i+=2){ |
| x = digest[i]*256 + digest[i+1]; |
| if( i>0 ) zDigest[j++] = '-'; |
| sprintf(&zDigest[j], "%05u", x); |
| j += 5; |
| } |
| zDigest[j] = 0; |
| } |
| |
| /* |
| ** A TCL command for md5. The argument is the text to be hashed. The |
| ** Result is the hash in base64. |
| */ |
| static int md5_cmd(void*cd, Tcl_Interp *interp, int argc, const char **argv){ |
| MD5Context ctx; |
| unsigned char digest[16]; |
| char zBuf[50]; |
| void (*converter)(unsigned char*, char*); |
| |
| if( argc!=2 ){ |
| Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0], |
| " TEXT\"", 0); |
| return TCL_ERROR; |
| } |
| MD5Init(&ctx); |
| MD5Update(&ctx, (unsigned char*)argv[1], (unsigned)strlen(argv[1])); |
| MD5Final(digest, &ctx); |
| converter = (void(*)(unsigned char*,char*))cd; |
| converter(digest, zBuf); |
| Tcl_AppendResult(interp, zBuf, (char*)0); |
| return TCL_OK; |
| } |
| |
| /* |
| ** A TCL command to take the md5 hash of a file. The argument is the |
| ** name of the file. |
| */ |
| static int md5file_cmd(void*cd, Tcl_Interp*interp, int argc, const char **argv){ |
| FILE *in; |
| MD5Context ctx; |
| void (*converter)(unsigned char*, char*); |
| unsigned char digest[16]; |
| char zBuf[10240]; |
| |
| if( argc!=2 ){ |
| Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0], |
| " FILENAME\"", 0); |
| return TCL_ERROR; |
| } |
| in = fopen(argv[1],"rb"); |
| if( in==0 ){ |
| Tcl_AppendResult(interp,"unable to open file \"", argv[1], |
| "\" for reading", 0); |
| return TCL_ERROR; |
| } |
| MD5Init(&ctx); |
| for(;;){ |
| int n; |
| n = fread(zBuf, 1, sizeof(zBuf), in); |
| if( n<=0 ) break; |
| MD5Update(&ctx, (unsigned char*)zBuf, (unsigned)n); |
| } |
| fclose(in); |
| MD5Final(digest, &ctx); |
| converter = (void(*)(unsigned char*,char*))cd; |
| converter(digest, zBuf); |
| Tcl_AppendResult(interp, zBuf, (char*)0); |
| return TCL_OK; |
| } |
| |
| /* |
| ** Register the four new TCL commands for generating MD5 checksums |
| ** with the TCL interpreter. |
| */ |
| int Md5_Init(Tcl_Interp *interp){ |
| Tcl_CreateCommand(interp, "md5", (Tcl_CmdProc*)md5_cmd, |
| MD5DigestToBase16, 0); |
| Tcl_CreateCommand(interp, "md5-10x8", (Tcl_CmdProc*)md5_cmd, |
| MD5DigestToBase10x8, 0); |
| Tcl_CreateCommand(interp, "md5file", (Tcl_CmdProc*)md5file_cmd, |
| MD5DigestToBase16, 0); |
| Tcl_CreateCommand(interp, "md5file-10x8", (Tcl_CmdProc*)md5file_cmd, |
| MD5DigestToBase10x8, 0); |
| return TCL_OK; |
| } |
| #endif /* defined(SQLITE_TEST) || defined(SQLITE_TCLMD5) */ |
| |
| #if defined(SQLITE_TEST) |
| /* |
| ** During testing, the special md5sum() aggregate function is available. |
| ** inside SQLite. The following routines implement that function. |
| */ |
| static void md5step(sqlite3_context *context, int argc, sqlite3_value **argv){ |
| MD5Context *p; |
| int i; |
| if( argc<1 ) return; |
| p = sqlite3_aggregate_context(context, sizeof(*p)); |
| if( p==0 ) return; |
| if( !p->isInit ){ |
| MD5Init(p); |
| } |
| for(i=0; i<argc; i++){ |
| const char *zData = (char*)sqlite3_value_text(argv[i]); |
| if( zData ){ |
| MD5Update(p, (unsigned char*)zData, strlen(zData)); |
| } |
| } |
| } |
| static void md5finalize(sqlite3_context *context){ |
| MD5Context *p; |
| unsigned char digest[16]; |
| char zBuf[33]; |
| p = sqlite3_aggregate_context(context, sizeof(*p)); |
| MD5Final(digest,p); |
| MD5DigestToBase16(digest, zBuf); |
| sqlite3_result_text(context, zBuf, -1, SQLITE_TRANSIENT); |
| } |
| int Md5_Register(sqlite3 *db){ |
| int rc = sqlite3_create_function(db, "md5sum", -1, SQLITE_UTF8, 0, 0, |
| md5step, md5finalize); |
| sqlite3_overload_function(db, "md5sum", -1); /* To exercise this API */ |
| return rc; |
| } |
| #endif /* defined(SQLITE_TEST) */ |
| |
| |
| /* |
| ** 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 TCLSH==2 |
| static char zMainloop[] = |
| #include "spaceanal_tcl.h" |
| ; |
| #endif |
| |
| #ifdef SQLITE_TEST |
| static void init_all(Tcl_Interp *); |
| static int init_all_cmd( |
| ClientData cd, |
| Tcl_Interp *interp, |
| int objc, |
| Tcl_Obj *CONST objv[] |
| ){ |
| |
| Tcl_Interp *slave; |
| if( objc!=2 ){ |
| Tcl_WrongNumArgs(interp, 1, objv, "SLAVE"); |
| return TCL_ERROR; |
| } |
| |
| slave = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); |
| if( !slave ){ |
| return TCL_ERROR; |
| } |
| |
| init_all(slave); |
| return TCL_OK; |
| } |
| #endif |
| |
| /* |
| ** Configure the interpreter passed as the first argument to have access |
| ** to the commands and linked variables that make up: |
| ** |
| ** * the [sqlite3] extension itself, |
| ** |
| ** * If SQLITE_TCLMD5 or SQLITE_TEST is defined, the Md5 commands, and |
| ** |
| ** * If SQLITE_TEST is set, the various test interfaces used by the Tcl |
| ** test suite. |
| */ |
| static void init_all(Tcl_Interp *interp){ |
| Sqlite3_Init(interp); |
| |
| #if defined(SQLITE_TEST) || defined(SQLITE_TCLMD5) |
| Md5_Init(interp); |
| #endif |
| |
| #ifdef SQLITE_TEST |
| { |
| 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_demovfs_Init(Tcl_Interp *); |
| extern int Sqlitetest_func_Init(Tcl_Interp*); |
| extern int Sqlitetest_hexio_Init(Tcl_Interp*); |
| extern int Sqlitetest_init_Init(Tcl_Interp*); |
| extern int Sqlitetest_malloc_Init(Tcl_Interp*); |
| extern int Sqlitetest_mutex_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(); |
| extern int SqlitetestOsinst_Init(Tcl_Interp*); |
| extern int Sqlitetestbackup_Init(Tcl_Interp*); |
| extern int Sqlitetestintarray_Init(Tcl_Interp*); |
| extern int Sqlitetestvfs_Init(Tcl_Interp *); |
| extern int SqlitetestStat_Init(Tcl_Interp*); |
| extern int Sqlitetestrtree_Init(Tcl_Interp*); |
| extern int Sqlitequota_Init(Tcl_Interp*); |
| extern int Sqlitemultiplex_Init(Tcl_Interp*); |
| extern int SqliteSuperlock_Init(Tcl_Interp*); |
| extern int SqlitetestSyscall_Init(Tcl_Interp*); |
| extern int Sqlitetestfuzzer_Init(Tcl_Interp*); |
| extern int Sqlitetestwholenumber_Init(Tcl_Interp*); |
| |
| #ifdef SQLITE_ENABLE_ZIPVFS |
| extern int Zipvfs_Init(Tcl_Interp*); |
| Zipvfs_Init(interp); |
| #endif |
| |
| 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_demovfs_Init(interp); |
| Sqlitetest_func_Init(interp); |
| Sqlitetest_hexio_Init(interp); |
| Sqlitetest_init_Init(interp); |
| Sqlitetest_malloc_Init(interp); |
| Sqlitetest_mutex_Init(interp); |
| Sqlitetestschema_Init(interp); |
| Sqlitetesttclvar_Init(interp); |
| SqlitetestThread_Init(interp); |
| SqlitetestOnefile_Init(interp); |
| SqlitetestOsinst_Init(interp); |
| Sqlitetestbackup_Init(interp); |
| Sqlitetestintarray_Init(interp); |
| Sqlitetestvfs_Init(interp); |
| SqlitetestStat_Init(interp); |
| Sqlitetestrtree_Init(interp); |
| Sqlitequota_Init(interp); |
| Sqlitemultiplex_Init(interp); |
| SqliteSuperlock_Init(interp); |
| SqlitetestSyscall_Init(interp); |
| Sqlitetestfuzzer_Init(interp); |
| Sqlitetestwholenumber_Init(interp); |
| |
| Tcl_CreateObjCommand(interp,"load_testfixture_extensions",init_all_cmd,0,0); |
| |
| #ifdef SQLITE_SSE |
| Sqlitetestsse_Init(interp); |
| #endif |
| } |
| #endif |
| } |
| |
| #define TCLSH_MAIN main /* Needed to fake out mktclapp */ |
| int TCLSH_MAIN(int argc, char **argv){ |
| Tcl_Interp *interp; |
| |
| /* Call sqlite3_shutdown() once before doing anything else. This is to |
| ** test that sqlite3_shutdown() can be safely called by a process before |
| ** sqlite3_initialize() is. */ |
| sqlite3_shutdown(); |
| |
| #if TCLSH==2 |
| sqlite3_config(SQLITE_CONFIG_SINGLETHREAD); |
| #endif |
| Tcl_FindExecutable(argv[0]); |
| |
| interp = Tcl_CreateInterp(); |
| init_all(interp); |
| if( argc>=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; i<argc; i++){ |
| Tcl_SetVar(interp, "argv", argv[i], |
| TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); |
| } |
| if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ |
| const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); |
| if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp); |
| fprintf(stderr,"%s: %s\n", *argv, zInfo); |
| return 1; |
| } |
| } |
| if( TCLSH==2 || argc<=1 ){ |
| Tcl_GlobalEval(interp, zMainloop); |
| } |
| return 0; |
| } |
| #endif /* TCLSH */ |