diff options
Diffstat (limited to 'kexi/3rdparty/kexisql/src/tclsqlite.c')
| -rw-r--r-- | kexi/3rdparty/kexisql/src/tclsqlite.c | 1293 |
1 files changed, 1293 insertions, 0 deletions
diff --git a/kexi/3rdparty/kexisql/src/tclsqlite.c b/kexi/3rdparty/kexisql/src/tclsqlite.c new file mode 100644 index 00000000..fdc2f5e8 --- /dev/null +++ b/kexi/3rdparty/kexisql/src/tclsqlite.c @@ -0,0 +1,1293 @@ +/* +** 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 +** +** $Id: tclsqlite.c 410099 2005-05-06 17:52:07Z staniek $ +*/ +#ifndef NO_TCL /* Omit this whole file if TCL is unavailable */ + +#include "sqliteInt.h" +#include "tcl.h" +#include <stdlib.h> +#include <string.h> +#include <assert.h> + +/* +** 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 */ + char *zScript; /* The script to be run */ + SqlFunc *pNext; /* Next function on the list of them all */ +}; + +/* +** 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 { + sqlite *db; /* The "real" database structure */ + Tcl_Interp *interp; /* The interpreter used for this database */ + char *zBusy; /* The busy callback routine */ + char *zCommit; /* The commit hook callback routine */ + char *zTrace; /* The trace callback routine */ + char *zProgress; /* The progress callback routine */ + char *zAuth; /* The authorization callback routine */ + SqlFunc *pFunc; /* List of SQL functions */ + int rc; /* Return code of most recent sqlite_exec() */ +}; + +/* +** An instance of this structure passes information thru the sqlite +** logic from the original TCL command into the callback routine. +*/ +typedef struct CallbackData CallbackData; +struct CallbackData { + Tcl_Interp *interp; /* The TCL interpreter */ + char *zArray; /* The array into which data is written */ + Tcl_Obj *pCode; /* The code to execute for each row */ + int once; /* Set for first callback only */ + int tcl_rc; /* Return code from TCL script */ + int nColName; /* Number of entries in the azColName[] array */ + char **azColName; /* Column names translated to UTF-8 */ +}; + +#ifdef UTF_TRANSLATION_NEEDED +/* +** Called for each row of the result. +** +** This version is used when TCL expects UTF-8 data but the database +** uses the ISO8859 format. A translation must occur from ISO8859 into +** UTF-8. +*/ +static int DbEvalCallback( + void *clientData, /* An instance of CallbackData */ + int nCol, /* Number of columns in the result */ + char ** azCol, /* Data for each column */ + char ** azN /* Name for each column */ +){ + CallbackData *cbData = (CallbackData*)clientData; + int i, rc; + Tcl_DString dCol; + Tcl_DStringInit(&dCol); + if( cbData->azColName==0 ){ + assert( cbData->once ); + cbData->once = 0; + if( cbData->zArray[0] ){ + Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0); + } + cbData->azColName = malloc( nCol*sizeof(char*) ); + if( cbData->azColName==0 ){ return 1; } + cbData->nColName = nCol; + for(i=0; i<nCol; i++){ + Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol); + cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 ); + if( cbData->azColName[i] ){ + strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol)); + }else{ + return 1; + } + if( cbData->zArray[0] ){ + Tcl_SetVar2(cbData->interp, cbData->zArray, "*", + Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE); + if( azN[nCol]!=0 ){ + Tcl_DString dType; + Tcl_DStringInit(&dType); + Tcl_DStringAppend(&dType, "typeof:", -1); + Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1); + Tcl_DStringFree(&dCol); + Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol); + Tcl_SetVar2(cbData->interp, cbData->zArray, + Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol), + TCL_LIST_ELEMENT|TCL_APPEND_VALUE); + Tcl_DStringFree(&dType); + } + } + + Tcl_DStringFree(&dCol); + } + } + if( azCol!=0 ){ + if( cbData->zArray[0] ){ + for(i=0; i<nCol; i++){ + char *z = azCol[i]; + if( z==0 ) z = ""; + Tcl_DStringInit(&dCol); + Tcl_ExternalToUtfDString(NULL, z, -1, &dCol); + Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i], + Tcl_DStringValue(&dCol), 0); + Tcl_DStringFree(&dCol); + } + }else{ + for(i=0; i<nCol; i++){ + char *z = azCol[i]; + if( z==0 ) z = ""; + Tcl_DStringInit(&dCol); + Tcl_ExternalToUtfDString(NULL, z, -1, &dCol); + Tcl_SetVar(cbData->interp, cbData->azColName[i], + Tcl_DStringValue(&dCol), 0); + Tcl_DStringFree(&dCol); + } + } + } + rc = Tcl_EvalObj(cbData->interp, cbData->pCode); + if( rc==TCL_CONTINUE ) rc = TCL_OK; + cbData->tcl_rc = rc; + return rc!=TCL_OK; +} +#endif /* UTF_TRANSLATION_NEEDED */ + +#ifndef UTF_TRANSLATION_NEEDED +/* +** Called for each row of the result. +** +** This version is used when either of the following is true: +** +** (1) This version of TCL uses UTF-8 and the data in the +** SQLite database is already in the UTF-8 format. +** +** (2) This version of TCL uses ISO8859 and the data in the +** SQLite database is already in the ISO8859 format. +*/ +static int DbEvalCallback( + void *clientData, /* An instance of CallbackData */ + int nCol, /* Number of columns in the result */ + char ** azCol, /* Data for each column */ + char ** azN /* Name for each column */ +){ + CallbackData *cbData = (CallbackData*)clientData; + int i, rc; + if( azCol==0 || (cbData->once && cbData->zArray[0]) ){ + Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0); + for(i=0; i<nCol; i++){ + Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i], + TCL_LIST_ELEMENT|TCL_APPEND_VALUE); + if( azN[nCol] ){ + char *z = sqlite_mprintf("typeof:%s", azN[i]); + Tcl_SetVar2(cbData->interp, cbData->zArray, z, azN[i+nCol], + TCL_LIST_ELEMENT|TCL_APPEND_VALUE); + sqlite_freemem(z); + } + } + cbData->once = 0; + } + if( azCol!=0 ){ + if( cbData->zArray[0] ){ + for(i=0; i<nCol; i++){ + char *z = azCol[i]; + if( z==0 ) z = ""; + Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0); + } + }else{ + for(i=0; i<nCol; i++){ + char *z = azCol[i]; + if( z==0 ) z = ""; + Tcl_SetVar(cbData->interp, azN[i], z, 0); + } + } + } + rc = Tcl_EvalObj(cbData->interp, cbData->pCode); + if( rc==TCL_CONTINUE ) rc = TCL_OK; + cbData->tcl_rc = rc; + return rc!=TCL_OK; +} +#endif + +/* +** This is an alternative callback for database queries. Instead +** of invoking a TCL script to handle the result, this callback just +** appends each column of the result to a list. After the query +** is complete, the list is returned. +*/ +static int DbEvalCallback2( + void *clientData, /* An instance of CallbackData */ + int nCol, /* Number of columns in the result */ + char ** azCol, /* Data for each column */ + char ** azN /* Name for each column */ +){ + Tcl_Obj *pList = (Tcl_Obj*)clientData; + int i; + if( azCol==0 ) return 0; + for(i=0; i<nCol; i++){ + Tcl_Obj *pElem; + if( azCol[i] && *azCol[i] ){ +#ifdef UTF_TRANSLATION_NEEDED + Tcl_DString dCol; + Tcl_DStringInit(&dCol); + Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol); + pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); + Tcl_DStringFree(&dCol); +#else + pElem = Tcl_NewStringObj(azCol[i], -1); +#endif + }else{ + pElem = Tcl_NewObj(); + } + Tcl_ListObjAppendElement(0, pList, pElem); + } + return 0; +} + +/* +** This is a second alternative callback for database queries. A the +** first column of the first row of the result is made the TCL result. +*/ +static int DbEvalCallback3( + void *clientData, /* An instance of CallbackData */ + int nCol, /* Number of columns in the result */ + char ** azCol, /* Data for each column */ + char ** azN /* Name for each column */ +){ + Tcl_Interp *interp = (Tcl_Interp*)clientData; + Tcl_Obj *pElem; + if( azCol==0 ) return 1; + if( nCol==0 ) return 1; +#ifdef UTF_TRANSLATION_NEEDED + { + Tcl_DString dCol; + Tcl_DStringInit(&dCol); + Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol); + pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); + Tcl_DStringFree(&dCol); + } +#else + pElem = Tcl_NewStringObj(azCol[0], -1); +#endif + Tcl_SetObjResult(interp, pElem); + return 1; +} + +/* +** Called when the command is deleted. +*/ +static void DbDeleteCmd(void *db){ + SqliteDb *pDb = (SqliteDb*)db; + sqlite_close(pDb->db); + while( pDb->pFunc ){ + SqlFunc *pFunc = pDb->pFunc; + pDb->pFunc = pFunc->pNext; + Tcl_Free((char*)pFunc); + } + if( pDb->zBusy ){ + Tcl_Free(pDb->zBusy); + } + if( pDb->zTrace ){ + Tcl_Free(pDb->zTrace); + } + if( pDb->zAuth ){ + Tcl_Free(pDb->zAuth); + } + Tcl_Free((char*)pDb); +} + +/* +** This routine is called when a database file is locked while trying +** to execute SQL. +*/ +static int DbBusyHandler(void *cd, const char *zTable, int nTries){ + SqliteDb *pDb = (SqliteDb*)cd; + int rc; + char zVal[30]; + char *zCmd; + Tcl_DString cmd; + + Tcl_DStringInit(&cmd); + Tcl_DStringAppend(&cmd, pDb->zBusy, -1); + Tcl_DStringAppendElement(&cmd, zTable); + sprintf(zVal, " %d", nTries); + Tcl_DStringAppend(&cmd, zVal, -1); + zCmd = Tcl_DStringValue(&cmd); + rc = Tcl_Eval(pDb->interp, zCmd); + Tcl_DStringFree(&cmd); + if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ + return 0; + } + return 1; +} + +/* +** This routine is invoked as the 'progress callback' for the database. +*/ +static int DbProgressHandler(void *cd){ + SqliteDb *pDb = (SqliteDb*)cd; + int rc; + + assert( pDb->zProgress ); + rc = Tcl_Eval(pDb->interp, pDb->zProgress); + if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ + return 1; + } + return 0; +} + +/* +** 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); +} + +/* +** 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; +} + +/* +** This routine is called to evaluate an SQL function implemented +** using TCL script. +*/ +static void tclSqlFunc(sqlite_func *context, int argc, const char **argv){ + SqlFunc *p = sqlite_user_data(context); + Tcl_DString cmd; + int i; + int rc; + + Tcl_DStringInit(&cmd); + Tcl_DStringAppend(&cmd, p->zScript, -1); + for(i=0; i<argc; i++){ + Tcl_DStringAppendElement(&cmd, argv[i] ? argv[i] : ""); + } + rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd)); + if( rc ){ + sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1); + }else{ + sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1); + } +} +#ifndef SQLITE_OMIT_AUTHORIZATION +/* +** This is the authentication function. It appends the authentication +** type code and the two arguments to zCmd[] then invokes the result +** on the interpreter. The reply is examined to determine if the +** authentication fails or succeeds. +*/ +static int auth_callback( + void *pArg, + int code, + const char *zArg1, + const char *zArg2, + const char *zArg3, + const char *zArg4 +){ + char *zCode; + Tcl_DString str; + int rc; + const char *zReply; + SqliteDb *pDb = (SqliteDb*)pArg; + + switch( code ){ + case SQLITE_COPY : zCode="SQLITE_COPY"; break; + case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; + case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; + case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; + case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; + case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; + case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; + case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; + case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; + case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; + case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; + case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; + case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; + case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; + case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; + case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; + case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; + case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; + case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; + case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; + case SQLITE_READ : zCode="SQLITE_READ"; break; + case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; + case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; + case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; + case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; + case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; + 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 */ + +/* +** 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: +** +** sqlite db1 "my_database" +** db1 close +** +** The first command opens a connection to the "my_database" database +** and calls that connection "db1". The second command causes this +** subroutine to be invoked. +*/ +static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ + SqliteDb *pDb = (SqliteDb*)cd; + int choice; + int rc = TCL_OK; + static const char *DB_strs[] = { + "authorizer", "busy", "changes", + "close", "commit_hook", "complete", + "errorcode", "eval", "function", + "last_insert_rowid", "last_statement_changes", "onecolumn", + "progress", "rekey", "timeout", + "trace", + 0 + }; + enum DB_enum { + DB_AUTHORIZER, DB_BUSY, DB_CHANGES, + DB_CLOSE, DB_COMMIT_HOOK, DB_COMPLETE, + DB_ERRORCODE, DB_EVAL, DB_FUNCTION, + DB_LAST_INSERT_ROWID, DB_LAST_STATEMENT_CHANGES, DB_ONECOLUMN, + DB_PROGRESS, DB_REKEY, DB_TIMEOUT, + DB_TRACE + }; + + 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: { + if( objc>3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); + }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 ); + strcpy(pDb->zAuth, zAuth); + }else{ + pDb->zAuth = 0; + } +#ifndef SQLITE_OMIT_AUTHORIZATION + if( pDb->zAuth ){ + pDb->interp = interp; + sqlite_set_authorizer(pDb->db, auth_callback, pDb); + }else{ + sqlite_set_authorizer(pDb->db, 0, 0); + } +#endif + } + break; + } + + /* $db busy ?CALLBACK? + ** + ** Invoke the given callback if an SQL statement attempts to open + ** a locked database file. + */ + case DB_BUSY: { + if( objc>3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK"); + return TCL_ERROR; + }else if( objc==2 ){ + if( pDb->zBusy ){ + Tcl_AppendResult(interp, pDb->zBusy, 0); + } + }else{ + char *zBusy; + int len; + if( pDb->zBusy ){ + Tcl_Free(pDb->zBusy); + } + zBusy = Tcl_GetStringFromObj(objv[2], &len); + if( zBusy && len>0 ){ + pDb->zBusy = Tcl_Alloc( len + 1 ); + strcpy(pDb->zBusy, zBusy); + }else{ + pDb->zBusy = 0; + } + if( pDb->zBusy ){ + pDb->interp = interp; + sqlite_busy_handler(pDb->db, DbBusyHandler, pDb); + }else{ + sqlite_busy_handler(pDb->db, 0, 0); + } + } + break; + } + + /* $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 ); + strcpy(pDb->zProgress, zProgress); + }else{ + pDb->zProgress = 0; + } +#ifndef SQLITE_OMIT_PROGRESS_CALLBACK + if( pDb->zProgress ){ + pDb->interp = interp; + sqlite_progress_handler(pDb->db, N, DbProgressHandler, pDb); + }else{ + sqlite_progress_handler(pDb->db, 0, 0, 0); + } +#endif + }else{ + Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); + return TCL_ERROR; + } + break; + } + + /* + ** $db changes + ** + ** Return the number of rows that were modified, inserted, or deleted by + ** the most recent "eval". + */ + case DB_CHANGES: { + Tcl_Obj *pResult; + int nChange; + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + nChange = sqlite_changes(pDb->db); + pResult = Tcl_GetObjResult(interp); + Tcl_SetIntObj(pResult, nChange); + break; + } + + /* + ** $db last_statement_changes + ** + ** Return the number of rows that were modified, inserted, or deleted by + ** the last statment to complete execution (excluding changes due to + ** triggers) + */ + case DB_LAST_STATEMENT_CHANGES: { + Tcl_Obj *pResult; + int lsChange; + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + lsChange = sqlite_last_statement_changes(pDb->db); + pResult = Tcl_GetObjResult(interp); + Tcl_SetIntObj(pResult, lsChange); + break; + } + + /* $db close + ** + ** Shutdown the database + */ + case DB_CLOSE: { + Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0)); + 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?"); + }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 ); + strcpy(pDb->zCommit, zCommit); + }else{ + pDb->zCommit = 0; + } + if( pDb->zCommit ){ + pDb->interp = interp; + sqlite_commit_hook(pDb->db, DbCommitHandler, pDb); + }else{ + sqlite_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: { + Tcl_Obj *pResult; + int isComplete; + if( objc!=3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "SQL"); + return TCL_ERROR; + } + isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) ); + pResult = Tcl_GetObjResult(interp); + Tcl_SetBooleanObj(pResult, isComplete); + break; + } + + /* + ** $db errorcode + ** + ** Return the numeric error code that was returned by the most recent + ** call to sqlite_exec(). + */ + case DB_ERRORCODE: { + Tcl_SetObjResult(interp, Tcl_NewIntObj(pDb->rc)); + 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: { + CallbackData cbData; + char *zErrMsg; + char *zSql; +#ifdef UTF_TRANSLATION_NEEDED + Tcl_DString dSql; + int i; +#endif + + if( objc!=5 && objc!=3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?"); + return TCL_ERROR; + } + pDb->interp = interp; + zSql = Tcl_GetStringFromObj(objv[2], 0); +#ifdef UTF_TRANSLATION_NEEDED + Tcl_DStringInit(&dSql); + Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql); + zSql = Tcl_DStringValue(&dSql); +#endif + Tcl_IncrRefCount(objv[2]); + if( objc==5 ){ + cbData.interp = interp; + cbData.once = 1; + cbData.zArray = Tcl_GetStringFromObj(objv[3], 0); + cbData.pCode = objv[4]; + cbData.tcl_rc = TCL_OK; + cbData.nColName = 0; + cbData.azColName = 0; + zErrMsg = 0; + Tcl_IncrRefCount(objv[3]); + Tcl_IncrRefCount(objv[4]); + rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg); + Tcl_DecrRefCount(objv[4]); + Tcl_DecrRefCount(objv[3]); + if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; } + }else{ + Tcl_Obj *pList = Tcl_NewObj(); + cbData.tcl_rc = TCL_OK; + rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg); + Tcl_SetObjResult(interp, pList); + } + pDb->rc = rc; + if( rc==SQLITE_ABORT ){ + if( zErrMsg ) free(zErrMsg); + rc = cbData.tcl_rc; + }else if( zErrMsg ){ + Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); + free(zErrMsg); + rc = TCL_ERROR; + }else if( rc!=SQLITE_OK ){ + Tcl_AppendResult(interp, sqlite_error_string(rc), 0); + rc = TCL_ERROR; + }else{ + } + Tcl_DecrRefCount(objv[2]); +#ifdef UTF_TRANSLATION_NEEDED + Tcl_DStringFree(&dSql); + if( objc==5 && cbData.azColName ){ + for(i=0; i<cbData.nColName; i++){ + if( cbData.azColName[i] ) free(cbData.azColName[i]); + } + free(cbData.azColName); + cbData.azColName = 0; + } +#endif + return rc; + } + + /* + ** $db function NAME SCRIPT + ** + ** Create a new SQL function called NAME. Whenever that function is + ** called, invoke SCRIPT to evaluate the function. + */ + case DB_FUNCTION: { + SqlFunc *pFunc; + char *zName; + char *zScript; + int nScript; + if( objc!=4 ){ + Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); + return TCL_ERROR; + } + zName = Tcl_GetStringFromObj(objv[2], 0); + zScript = Tcl_GetStringFromObj(objv[3], &nScript); + pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 ); + if( pFunc==0 ) return TCL_ERROR; + pFunc->interp = interp; + pFunc->pNext = pDb->pFunc; + pFunc->zScript = (char*)&pFunc[1]; + strcpy(pFunc->zScript, zScript); + sqlite_create_function(pDb->db, zName, -1, tclSqlFunc, pFunc); + sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC); + 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; + int rowid; + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + rowid = sqlite_last_insert_rowid(pDb->db); + pResult = Tcl_GetObjResult(interp); + Tcl_SetIntObj(pResult, rowid); + break; + } + + /* + ** $db onecolumn SQL + ** + ** Return a single column from a single row of the given SQL query. + */ + case DB_ONECOLUMN: { + char *zSql; + char *zErrMsg = 0; + if( objc!=3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "SQL"); + return TCL_ERROR; + } + zSql = Tcl_GetStringFromObj(objv[2], 0); + rc = sqlite_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg); + if( rc==SQLITE_ABORT ){ + rc = SQLITE_OK; + }else if( zErrMsg ){ + Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); + free(zErrMsg); + rc = TCL_ERROR; + }else if( rc!=SQLITE_OK ){ + Tcl_AppendResult(interp, sqlite_error_string(rc), 0); + rc = TCL_ERROR; + } + 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 = sqlite_rekey(pDb->db, pKey, nKey); + if( rc ){ + Tcl_AppendResult(interp, sqlite_error_string(rc), 0); + rc = TCL_ERROR; + } +#endif + break; + } + + /* + ** $db timeout MILLESECONDS + ** + ** Delay for the number of milliseconds specified when a file is locked. + */ + case DB_TIMEOUT: { + int ms; + if( objc!=3 ){ + Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); + return TCL_ERROR; + } + if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; + sqlite_busy_timeout(pDb->db, ms); + 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?"); + }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 ); + strcpy(pDb->zTrace, zTrace); + }else{ + pDb->zTrace = 0; + } + if( pDb->zTrace ){ + pDb->interp = interp; + sqlite_trace(pDb->db, DbTraceHandler, pDb); + }else{ + sqlite_trace(pDb->db, 0, 0); + } + } + break; + } + + } /* End of the SWITCH statement */ + return rc; +} + +/* +** sqlite DBNAME FILENAME ?MODE? ?-key KEY? +** +** 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 directory that contains +** the sqlite database that is to be accessed. +** +** For testing purposes, we also support the following: +** +** sqlite -encoding +** +** Return the encoding used by LIKE and GLOB operators. Choices +** are UTF-8 and iso8859. +** +** sqlite -version +** +** Return the version number of the SQLite library. +** +** sqlite -tcl-uses-utf +** +** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if +** not. Used by tests to make sure the library was compiled +** correctly. +*/ +static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ + int mode; + SqliteDb *p; + void *pKey = 0; + int nKey = 0; + const char *zArg; + char *zErrMsg; + const char *zFile; + char zBuf[80]; + if( objc==2 ){ + zArg = Tcl_GetStringFromObj(objv[1], 0); + if( strcmp(zArg,"-encoding")==0 ){ + Tcl_AppendResult(interp,sqlite_encoding,0); + return TCL_OK; + } + if( strcmp(zArg,"-version")==0 ){ + Tcl_AppendResult(interp,sqlite_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; + } + if( strcmp(zArg,"-tcl-uses-utf")==0 ){ +#ifdef TCL_UTF_MAX + Tcl_AppendResult(interp,"1",0); +#else + Tcl_AppendResult(interp,"0",0); +#endif + return TCL_OK; + } + } + if( objc==5 || objc==6 ){ + zArg = Tcl_GetStringFromObj(objv[objc-2], 0); + if( strcmp(zArg,"-key")==0 ){ + pKey = Tcl_GetByteArrayFromObj(objv[objc-1], &nKey); + objc -= 2; + } + } + if( objc!=3 && objc!=4 ){ + Tcl_WrongNumArgs(interp, 1, objv, +#ifdef SQLITE_HAS_CODEC + "HANDLE FILENAME ?-key CODEC-KEY?" +#else + "HANDLE FILENAME ?MODE?" +#endif + ); + return TCL_ERROR; + } + if( objc==3 ){ + mode = 0666; + }else if( Tcl_GetIntFromObj(interp, objv[3], &mode)!=TCL_OK ){ + 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); +#ifdef SQLITE_HAS_CODEC + p->db = sqlite_open_encrypted(zFile, pKey, nKey, 0, &zErrMsg); +#else + p->db = sqlite_open(zFile, mode, &zErrMsg); +#endif + if( p->db==0 ){ + Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); + Tcl_Free((char*)p); + free(zErrMsg); + return TCL_ERROR; + } + zArg = Tcl_GetStringFromObj(objv[1], 0); + Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); + + /* The return value is the value of the sqlite* pointer + */ + sprintf(zBuf, "%p", p->db); + if( strncmp(zBuf,"0x",2) ){ + sprintf(zBuf, "0x%p", p->db); + } + Tcl_AppendResult(interp, zBuf, 0); + + /* If compiled with SQLITE_TEST turned on, then register the "md5sum" + ** SQL function. + */ +#ifdef SQLITE_TEST + { + extern void Md5_Register(sqlite*); + Md5_Register(p->db); + } +#endif + 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 + +/* +** 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. +*/ +int Sqlite_Init(Tcl_Interp *interp){ + Tcl_InitStubs(interp, "8.0", 0); + Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); + Tcl_PkgProvide(interp, "sqlite", "2.0"); + return TCL_OK; +} +int Tclsqlite_Init(Tcl_Interp *interp){ + Tcl_InitStubs(interp, "8.0", 0); + Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); + Tcl_PkgProvide(interp, "sqlite", "2.0"); + return TCL_OK; +} +int Sqlite_SafeInit(Tcl_Interp *interp){ + return TCL_OK; +} +int Tclsqlite_SafeInit(Tcl_Interp *interp){ + return TCL_OK; +} + +#if 0 +/* +** If compiled using mktclapp, this routine runs to initialize +** everything. +*/ +int Et_AppInit(Tcl_Interp *interp){ + return Sqlite_Init(interp); +} +#endif +/*************************************************************************** +** The remaining code is only included if the TCLSH macro is defined to +** be an integer greater than 0 +*/ +#if defined(TCLSH) && TCLSH>0 + +/* +** If the macro TCLSH is defined and is one, then put in code for the +** "main" routine that implement a interactive shell into which the user +** can type TCL commands. +*/ +#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 /* TCLSH==1 */ + +int Libsqlite_Init( Tcl_Interp *interp) { +#ifdef TCL_THREADS + if (Thread_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } +#endif + Sqlite_Init(interp); +#ifdef SQLITE_TEST + { + extern int Sqlitetest1_Init(Tcl_Interp*); + extern int Sqlitetest2_Init(Tcl_Interp*); + extern int Sqlitetest3_Init(Tcl_Interp*); + extern int Md5_Init(Tcl_Interp*); + Sqlitetest1_Init(interp); + Sqlitetest2_Init(interp); + Sqlitetest3_Init(interp); + Md5_Init(interp); + Tcl_StaticPackage(interp, "sqlite", Libsqlite_Init, Libsqlite_Init); + } +#endif + return TCL_OK; +} + +#define TCLSH_MAIN main /* Needed to fake out mktclapp */ +#if TCLSH==1 +int TCLSH_MAIN(int argc, char **argv){ +#ifndef TCL_THREADS + Tcl_Interp *interp; + Tcl_FindExecutable(argv[0]); + interp = Tcl_CreateInterp(); + Libsqlite_Init(interp); + if( argc>=2 ){ + int i; + Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); + Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); + for(i=2; i<argc; i++){ + Tcl_SetVar(interp, "argv", argv[i], + TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); + } + if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ + const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if( zInfo==0 ) zInfo = interp->result; + fprintf(stderr,"%s: %s\n", *argv, zInfo); + return TCL_ERROR; + } + }else{ + Tcl_GlobalEval(interp, zMainloop); + } + return 0; +#else + Tcl_Main(argc, argv, Libsqlite_Init); +#endif /* TCL_THREADS */ + return 0; +} +#endif /* TCLSH==1 */ + + +/* +** If the macro TCLSH is set to 2, then implement a space analysis tool. +*/ +#if TCLSH==2 +static char zAnalysis[] = +#include "spaceanal_tcl.h" +; + +int main(int argc, char **argv){ + Tcl_Interp *interp; + int i; + Tcl_FindExecutable(argv[0]); + interp = Tcl_CreateInterp(); + Libsqlite_Init(interp); + Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY); + Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); + for(i=1; i<argc; i++){ + Tcl_SetVar(interp, "argv", argv[i], + TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); + } + if( Tcl_GlobalEval(interp, zAnalysis)!=TCL_OK ){ + const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if( zInfo==0 ) zInfo = interp->result; + fprintf(stderr,"%s: %s\n", *argv, zInfo); + return TCL_ERROR; + } + return 0; +} +#endif /* TCLSH==2 */ + +#endif /* TCLSH */ + +#endif /* NO_TCL */ |