123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592 |
- /*
- ** 2001 September 15
- **
- ** The author disclaims copyright to this source code. In place of
- ** a legal notice, here is a blessing:
- **
- ** May you do good and not evil.
- ** May you find forgiveness for yourself and forgive others.
- ** May you share freely, never taking more than you give.
- **
- *************************************************************************
- ** A TCL Interface to SQLite. Append this file to sqlite3.c and
- ** compile the whole thing to build a TCL-enabled version of SQLite.
- **
- ** $Id: tclsqlite.c,v 1.207 2007/11/14 06:48:48 danielk1977 Exp $
- */
- #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 "sqliteInt.h"
- # include <stdlib.h>
- # include <string.h>
- # include <assert.h>
- # include <ctype.h>
- #endif
- /*
- * Windows needs to know which symbols to export. Unix does not.
- * BUILD_sqlite should be undefined for Unix.
- */
- #ifdef BUILD_sqlite
- #undef TCL_STORAGE_CLASS
- #define TCL_STORAGE_CLASS DLLEXPORT
- #endif /* BUILD_sqlite */
- #define NUM_PREPARED_STMTS 10
- #define MAX_PREPARED_STMTS 100
- /*
- ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
- ** have to do a translation when going between the two. Set the
- ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
- ** this translation.
- */
- #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
- # define UTF_TRANSLATION_NEEDED 1
- #endif
- /*
- ** New SQL functions can be created as TCL scripts. Each such function
- ** is described by an instance of the following structure.
- */
- typedef struct SqlFunc SqlFunc;
- struct SqlFunc {
- Tcl_Interp *interp; /* The TCL interpret to execute the function */
- Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
- int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
- char *zName; /* Name of this function */
- SqlFunc *pNext; /* Next function on the list of them all */
- };
- /*
- ** New collation sequences function can be created as TCL scripts. Each such
- ** function is described by an instance of the following structure.
- */
- typedef struct SqlCollate SqlCollate;
- struct SqlCollate {
- Tcl_Interp *interp; /* The TCL interpret to execute the function */
- char *zScript; /* The script to be run */
- SqlCollate *pNext; /* Next function on the list of them all */
- };
- /*
- ** Prepared statements are cached for faster execution. Each prepared
- ** statement is described by an instance of the following structure.
- */
- typedef struct SqlPreparedStmt SqlPreparedStmt;
- struct SqlPreparedStmt {
- SqlPreparedStmt *pNext; /* Next in linked list */
- SqlPreparedStmt *pPrev; /* Previous on the list */
- sqlite3_stmt *pStmt; /* The prepared statement */
- int nSql; /* chars in zSql[] */
- const char *zSql; /* Text of the SQL statement */
- };
- typedef struct IncrblobChannel IncrblobChannel;
- /*
- ** There is one instance of this structure for each SQLite database
- ** that has been opened by the SQLite TCL interface.
- */
- typedef struct SqliteDb SqliteDb;
- struct SqliteDb {
- sqlite3 *db; /* The "real" database structure. MUST BE FIRST */
- Tcl_Interp *interp; /* The interpreter used for this database */
- char *zBusy; /* The busy callback routine */
- char *zCommit; /* The commit hook callback routine */
- char *zTrace; /* The trace callback routine */
- char *zProfile; /* The profile callback routine */
- char *zProgress; /* The progress callback routine */
- char *zAuth; /* The authorization callback routine */
- char *zNull; /* Text to substitute for an SQL NULL value */
- SqlFunc *pFunc; /* List of SQL functions */
- Tcl_Obj *pUpdateHook; /* Update hook script (if any) */
- Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */
- SqlCollate *pCollate; /* List of SQL collation functions */
- int rc; /* Return code of most recent sqlite3_exec() */
- Tcl_Obj *pCollateNeeded; /* Collation needed script */
- SqlPreparedStmt *stmtList; /* List of prepared statements*/
- SqlPreparedStmt *stmtLast; /* Last statement in the list */
- int maxStmt; /* The next maximum number of stmtList */
- int nStmt; /* Number of statements in stmtList */
- IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
- };
- struct IncrblobChannel {
- sqlite3_blob *pBlob; /* sqlite3 blob handle */
- SqliteDb *pDb; /* Associated database connection */
- int iSeek; /* Current seek offset */
- Tcl_Channel channel; /* Channel identifier */
- IncrblobChannel *pNext; /* Linked list of all open incrblob channels */
- IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */
- };
- #ifndef SQLITE_OMIT_INCRBLOB
- /*
- ** Close all incrblob channels opened using database connection pDb.
- ** This is called when shutting down the database connection.
- */
- static void closeIncrblobChannels(SqliteDb *pDb){
- IncrblobChannel *p;
- IncrblobChannel *pNext;
- for(p=pDb->pIncrblob; p; p=pNext){
- pNext = p->pNext;
- /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
- ** which deletes the IncrblobChannel structure at *p. So do not
- ** call Tcl_Free() here.
- */
- Tcl_UnregisterChannel(pDb->interp, p->channel);
- }
- }
- /*
- ** Close an incremental blob channel.
- */
- static int incrblobClose(ClientData instanceData, Tcl_Interp *interp){
- IncrblobChannel *p = (IncrblobChannel *)instanceData;
- int rc = sqlite3_blob_close(p->pBlob);
- sqlite3 *db = p->pDb->db;
- /* Remove the channel from the SqliteDb.pIncrblob list. */
- if( p->pNext ){
- p->pNext->pPrev = p->pPrev;
- }
- if( p->pPrev ){
- p->pPrev->pNext = p->pNext;
- }
- if( p->pDb->pIncrblob==p ){
- p->pDb->pIncrblob = p->pNext;
- }
- /* Free the IncrblobChannel structure */
- Tcl_Free((char *)p);
- if( rc!=SQLITE_OK ){
- Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
- return TCL_ERROR;
- }
- return TCL_OK;
- }
- /*
- ** Read data from an incremental blob channel.
- */
- static int incrblobInput(
- ClientData instanceData,
- char *buf,
- int bufSize,
- int *errorCodePtr
- ){
- IncrblobChannel *p = (IncrblobChannel *)instanceData;
- int nRead = bufSize; /* Number of bytes to read */
- int nBlob; /* Total size of the blob */
- int rc; /* sqlite error code */
- nBlob = sqlite3_blob_bytes(p->pBlob);
- if( (p->iSeek+nRead)>nBlob ){
- nRead = nBlob-p->iSeek;
- }
- if( nRead<=0 ){
- return 0;
- }
- rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
- if( rc!=SQLITE_OK ){
- *errorCodePtr = rc;
- return -1;
- }
- p->iSeek += nRead;
- return nRead;
- }
- /*
- ** Write data to an incremental blob channel.
- */
- static int incrblobOutput(
- ClientData instanceData,
- CONST char *buf,
- int toWrite,
- int *errorCodePtr
- ){
- IncrblobChannel *p = (IncrblobChannel *)instanceData;
- int nWrite = toWrite; /* Number of bytes to write */
- int nBlob; /* Total size of the blob */
- int rc; /* sqlite error code */
- nBlob = sqlite3_blob_bytes(p->pBlob);
- if( (p->iSeek+nWrite)>nBlob ){
- *errorCodePtr = EINVAL;
- return -1;
- }
- if( nWrite<=0 ){
- return 0;
- }
- rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
- if( rc!=SQLITE_OK ){
- *errorCodePtr = EIO;
- return -1;
- }
- p->iSeek += nWrite;
- return nWrite;
- }
- /*
- ** Seek an incremental blob channel.
- */
- static int incrblobSeek(
- ClientData instanceData,
- long offset,
- int seekMode,
- int *errorCodePtr
- ){
- IncrblobChannel *p = (IncrblobChannel *)instanceData;
- switch( seekMode ){
- case SEEK_SET:
- p->iSeek = offset;
- break;
- case SEEK_CUR:
- p->iSeek += offset;
- break;
- case SEEK_END:
- p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
- break;
- default: assert(!"Bad seekMode");
- }
- return p->iSeek;
- }
- static void incrblobWatch(ClientData instanceData, int mode){
- /* NO-OP */
- }
- static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){
- return TCL_ERROR;
- }
- static Tcl_ChannelType IncrblobChannelType = {
- "incrblob", /* typeName */
- TCL_CHANNEL_VERSION_2, /* version */
- incrblobClose, /* closeProc */
- incrblobInput, /* inputProc */
- incrblobOutput, /* outputProc */
- incrblobSeek, /* seekProc */
- 0, /* setOptionProc */
- 0, /* getOptionProc */
- incrblobWatch, /* watchProc (this is a no-op) */
- incrblobHandle, /* getHandleProc (always returns error) */
- 0, /* close2Proc */
- 0, /* blockModeProc */
- 0, /* flushProc */
- 0, /* handlerProc */
- 0, /* wideSeekProc */
- };
- /*
- ** Create a new incrblob channel.
- */
- static int createIncrblobChannel(
- Tcl_Interp *interp,
- SqliteDb *pDb,
- const char *zDb,
- const char *zTable,
- const char *zColumn,
- sqlite_int64 iRow,
- int isReadonly
- ){
- IncrblobChannel *p;
- sqlite3 *db = pDb->db;
- sqlite3_blob *pBlob;
- int rc;
- int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
- /* This variable is used to name the channels: "incrblob_[incr count]" */
- static int count = 0;
- char zChannel[64];
- rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
- if( rc!=SQLITE_OK ){
- Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
- return TCL_ERROR;
- }
- p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
- p->iSeek = 0;
- p->pBlob = pBlob;
- sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
- p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
- Tcl_RegisterChannel(interp, p->channel);
- /* Link the new channel into the SqliteDb.pIncrblob list. */
- p->pNext = pDb->pIncrblob;
- p->pPrev = 0;
- if( p->pNext ){
- p->pNext->pPrev = p;
- }
- pDb->pIncrblob = p;
- p->pDb = pDb;
- Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
- return TCL_OK;
- }
- #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
- #define closeIncrblobChannels(pDb)
- #endif
- /*
- ** Look at the script prefix in pCmd. We will be executing this script
- ** after first appending one or more arguments. This routine analyzes
- ** the script to see if it is safe to use Tcl_EvalObjv() on the script
- ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
- ** faster.
- **
- ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
- ** command name followed by zero or more arguments with no [...] or $
- ** or {...} or ; to be seen anywhere. Most callback scripts consist
- ** of just a single procedure name and they meet this requirement.
- */
- static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
- /* We could try to do something with Tcl_Parse(). But we will instead
- ** just do a search for forbidden characters. If any of the forbidden
- ** characters appear in pCmd, we will report the string as unsafe.
- */
- const char *z;
- int n;
- z = Tcl_GetStringFromObj(pCmd, &n);
- while( n-- > 0 ){
- int c = *(z++);
- if( c=='$' || c=='[' || c==';' ) return 0;
- }
- return 1;
- }
- /*
- ** Find an SqlFunc structure with the given name. Or create a new
- ** one if an existing one cannot be found. Return a pointer to the
- ** structure.
- */
- static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
- SqlFunc *p, *pNew;
- int i;
- pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );
- pNew->zName = (char*)&pNew[1];
- for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
- pNew->zName[i] = 0;
- for(p=pDb->pFunc; p; p=p->pNext){
- if( strcmp(p->zName, pNew->zName)==0 ){
- Tcl_Free((char*)pNew);
- return p;
- }
- }
- pNew->interp = pDb->interp;
- pNew->pScript = 0;
- pNew->pNext = pDb->pFunc;
- pDb->pFunc = pNew;
- return pNew;
- }
- /*
- ** Finalize and free a list of prepared statements
- */
- static void flushStmtCache( SqliteDb *pDb ){
- SqlPreparedStmt *pPreStmt;
- while( pDb->stmtList ){
- sqlite3_finalize( pDb->stmtList->pStmt );
- pPreStmt = pDb->stmtList;
- pDb->stmtList = pDb->stmtList->pNext;
- Tcl_Free( (char*)pPreStmt );
- }
- pDb->nStmt = 0;
- pDb->stmtLast = 0;
- }
- /*
- ** TCL calls this procedure when an sqlite3 database command is
- ** deleted.
- */
- static void DbDeleteCmd(void *db){
- SqliteDb *pDb = (SqliteDb*)db;
- flushStmtCache(pDb);
- closeIncrblobChannels(pDb);
- sqlite3_close(pDb->db);
- while( pDb->pFunc ){
- SqlFunc *pFunc = pDb->pFunc;
- pDb->pFunc = pFunc->pNext;
- Tcl_DecrRefCount(pFunc->pScript);
- Tcl_Free((char*)pFunc);
- }
- while( pDb->pCollate ){
- SqlCollate *pCollate = pDb->pCollate;
- pDb->pCollate = pCollate->pNext;
- Tcl_Free((char*)pCollate);
- }
- if( pDb->zBusy ){
- Tcl_Free(pDb->zBusy);
- }
- if( pDb->zTrace ){
- Tcl_Free(pDb->zTrace);
- }
- if( pDb->zProfile ){
- Tcl_Free(pDb->zProfile);
- }
- if( pDb->zAuth ){
- Tcl_Free(pDb->zAuth);
- }
- if( pDb->zNull ){
- Tcl_Free(pDb->zNull);
- }
- if( pDb->pUpdateHook ){
- Tcl_DecrRefCount(pDb->pUpdateHook);
- }
- if( pDb->pRollbackHook ){
- Tcl_DecrRefCount(pDb->pRollbackHook);
- }
- if( pDb->pCollateNeeded ){
- Tcl_DecrRefCount(pDb->pCollateNeeded);
- }
- Tcl_Free((char*)pDb);
- }
- /*
- ** This routine is called when a database file is locked while trying
- ** to execute SQL.
- */
- static int DbBusyHandler(void *cd, int nTries){
- SqliteDb *pDb = (SqliteDb*)cd;
- int rc;
- char zVal[30];
- sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
- rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
- if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
- return 0;
- }
- return 1;
- }
- /*
- ** This routine is invoked as the 'progress callback' for the database.
- */
- static int DbProgressHandler(void *cd){
- SqliteDb *pDb = (SqliteDb*)cd;
- int rc;
- assert( pDb->zProgress );
- rc = Tcl_Eval(pDb->interp, pDb->zProgress);
- if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
- return 1;
- }
- return 0;
- }
- #ifndef SQLITE_OMIT_TRACE
- /*
- ** This routine is called by the SQLite trace handler whenever a new
- ** block of SQL is executed. The TCL script in pDb->zTrace is executed.
- */
- static void DbTraceHandler(void *cd, const char *zSql){
- SqliteDb *pDb = (SqliteDb*)cd;
- Tcl_DString str;
- Tcl_DStringInit(&str);
- Tcl_DStringAppend(&str, pDb->zTrace, -1);
- Tcl_DStringAppendElement(&str, zSql);
- Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
- Tcl_DStringFree(&str);
- Tcl_ResetResult(pDb->interp);
- }
- #endif
- #ifndef SQLITE_OMIT_TRACE
- /*
- ** This routine is called by the SQLite profile handler after a statement
- ** SQL has executed. The TCL script in pDb->zProfile is evaluated.
- */
- static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
- SqliteDb *pDb = (SqliteDb*)cd;
- Tcl_DString str;
- char zTm[100];
- sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
- Tcl_DStringInit(&str);
- Tcl_DStringAppend(&str, pDb->zProfile, -1);
- Tcl_DStringAppendElement(&str, zSql);
- Tcl_DStringAppendElement(&str, zTm);
- Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
- Tcl_DStringFree(&str);
- Tcl_ResetResult(pDb->interp);
- }
- #endif
- /*
- ** This routine is called when a transaction is committed. The
- ** TCL script in pDb->zCommit is executed. If it returns non-zero or
- ** if it throws an exception, the transaction is rolled back instead
- ** of being committed.
- */
- static int DbCommitHandler(void *cd){
- SqliteDb *pDb = (SqliteDb*)cd;
- int rc;
- rc = Tcl_Eval(pDb->interp, pDb->zCommit);
- if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
- return 1;
- }
- return 0;
- }
- static void DbRollbackHandler(void *clientData){
- SqliteDb *pDb = (SqliteDb*)clientData;
- assert(pDb->pRollbackHook);
- if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
- Tcl_BackgroundError(pDb->interp);
- }
- }
- static void DbUpdateHandler(
- void *p,
- int op,
- const char *zDb,
- const char *zTbl,
- sqlite_int64 rowid
- ){
- SqliteDb *pDb = (SqliteDb *)p;
- Tcl_Obj *pCmd;
- assert( pDb->pUpdateHook );
- assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
- pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
- Tcl_IncrRefCount(pCmd);
- Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(
- ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));
- Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
- Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
- Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
- Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
- }
- static void tclCollateNeeded(
- void *pCtx,
- sqlite3 *db,
- int enc,
- const char *zName
- ){
- SqliteDb *pDb = (SqliteDb *)pCtx;
- Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
- Tcl_IncrRefCount(pScript);
- Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
- Tcl_EvalObjEx(pDb->interp, pScript, 0);
- Tcl_DecrRefCount(pScript);
- }
- /*
- ** This routine is called to evaluate an SQL collation function implemented
- ** using TCL script.
- */
- static int tclSqlCollate(
- void *pCtx,
- int nA,
- const void *zA,
- int nB,
- const void *zB
- ){
- SqlCollate *p = (SqlCollate *)pCtx;
- Tcl_Obj *pCmd;
- pCmd = Tcl_NewStringObj(p->zScript, -1);
- Tcl_IncrRefCount(pCmd);
- Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
- Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
- Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
- Tcl_DecrRefCount(pCmd);
- return (atoi(Tcl_GetStringResult(p->interp)));
- }
- /*
- ** This routine is called to evaluate an SQL function implemented
- ** using TCL script.
- */
- static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
- SqlFunc *p = sqlite3_user_data(context);
- Tcl_Obj *pCmd;
- int i;
- int rc;
- if( argc==0 ){
- /* If there are no arguments to the function, call Tcl_EvalObjEx on the
- ** script object directly. This allows the TCL compiler to generate
- ** bytecode for the command on the first invocation and thus make
- ** subsequent invocations much faster. */
- pCmd = p->pScript;
- Tcl_IncrRefCount(pCmd);
- rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
- Tcl_DecrRefCount(pCmd);
- }else{
- /* If there are arguments to the function, make a shallow copy of the
- ** script object, lappend the arguments, then evaluate the copy.
- **
- ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
- ** The new Tcl_Obj contains pointers to the original list elements.
- ** That way, when Tcl_EvalObjv() is run and shimmers the first element
- ** of the list to tclCmdNameType, that alternate representation will
- ** be preserved and reused on the next invocation.
- */
- Tcl_Obj **aArg;
- int nArg;
- if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
- sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
- return;
- }
- pCmd = Tcl_NewListObj(nArg, aArg);
- Tcl_IncrRefCount(pCmd);
- for(i=0; i<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;
- char *zType = pVar->typePtr ? pVar->typePtr->name : "";
- char c = zType[0];
- if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
- /* Only return a BLOB type if the Tcl variable is a bytearray and
- ** has no string representation. */
- data = Tcl_GetByteArrayFromObj(pVar, &n);
- sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
- }else if( c=='b' && strcmp(zType,"boolean")==0 ){
- Tcl_GetIntFromObj(0, pVar, &n);
- sqlite3_result_int(context, n);
- }else if( c=='d' && strcmp(zType,"double")==0 ){
- double r;
- Tcl_GetDoubleFromObj(0, pVar, &r);
- sqlite3_result_double(context, r);
- }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
- (c=='i' && strcmp(zType,"int")==0) ){
- Tcl_WideInt v;
- Tcl_GetWideIntFromObj(0, pVar, &v);
- sqlite3_result_int64(context, v);
- }else{
- data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
- sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
- }
- }
- }
- #ifndef SQLITE_OMIT_AUTHORIZATION
- /*
- ** This is the authentication function. It appends the authentication
- ** type code and the two arguments to zCmd[] then invokes the result
- ** on the interpreter. The reply is examined to determine if the
- ** authentication fails or succeeds.
- */
- static int auth_callback(
- void *pArg,
- int code,
- const char *zArg1,
- const char *zArg2,
- const char *zArg3,
- const char *zArg4
- ){
- char *zCode;
- Tcl_DString str;
- int rc;
- const char *zReply;
- SqliteDb *pDb = (SqliteDb*)pArg;
- switch( code ){
- case SQLITE_COPY : zCode="SQLITE_COPY"; break;
- case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
- case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
- case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
- case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
- case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
- case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
- case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
- case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
- case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
- case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
- case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
- case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
- case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
- case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
- case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
- case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
- case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
- case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
- case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
- case SQLITE_READ : zCode="SQLITE_READ"; break;
- case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
- case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
- case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
- case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
- case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
- case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
- case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
- case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
- case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
- case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
- case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
- default : zCode="????"; break;
- }
- Tcl_DStringInit(&str);
- Tcl_DStringAppend(&str, pDb->zAuth, -1);
- Tcl_DStringAppendElement(&str, zCode);
- Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
- Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
- Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
- Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
- rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
- Tcl_DStringFree(&str);
- zReply = Tcl_GetStringResult(pDb->interp);
- if( strcmp(zReply,"SQLITE_OK")==0 ){
- rc = SQLITE_OK;
- }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
- rc = SQLITE_DENY;
- }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
- rc = SQLITE_IGNORE;
- }else{
- rc = 999;
- }
- return rc;
- }
- #endif /* SQLITE_OMIT_AUTHORIZATION */
- /*
- ** zText is a pointer to text obtained via an sqlite3_result_text()
- ** or similar interface. This routine returns a Tcl string object,
- ** reference count set to 0, containing the text. If a translation
- ** between iso8859 and UTF-8 is required, it is preformed.
- */
- static Tcl_Obj *dbTextToObj(char const *zText){
- Tcl_Obj *pVal;
- #ifdef UTF_TRANSLATION_NEEDED
- Tcl_DString dCol;
- Tcl_DStringInit(&dCol);
- Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol);
- pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
- Tcl_DStringFree(&dCol);
- #else
- pVal = Tcl_NewStringObj(zText, -1);
- #endif
- return pVal;
- }
- /*
- ** This routine reads a line of text from FILE in, stores
- ** the text in memory obtained from malloc() and returns a pointer
- ** to the text. NULL is returned at end of file, or if malloc()
- ** fails.
- **
- ** The interface is like "readline" but no command-line editing
- ** is done.
- **
- ** copied from shell.c from '.import' command
- */
- static char *local_getline(char *zPrompt, FILE *in){
- char *zLine;
- int nLine;
- int n;
- int eol;
- nLine = 100;
- zLine = malloc( nLine );
- if( zLine==0 ) return 0;
- n = 0;
- eol = 0;
- while( !eol ){
- if( n+100>nLine ){
- nLine = nLine*2 + 100;
- zLine = realloc(zLine, nLine);
- if( zLine==0 ) return 0;
- }
- if( fgets(&zLine[n], nLine - n, in)==0 ){
- if( n==0 ){
- free(zLine);
- return 0;
- }
- zLine[n] = 0;
- eol = 1;
- break;
- }
- while( zLine[n] ){ n++; }
- if( n>0 && zLine[n-1]=='\n' ){
- n--;
- zLine[n] = 0;
- eol = 1;
- }
- }
- zLine = realloc( zLine, n+1 );
- return zLine;
- }
- /*
- ** Figure out the column names for the data returned by the statement
- ** passed as the second argument.
- **
- ** If parameter papColName is not NULL, then *papColName is set to point
- ** at an array allocated using Tcl_Alloc(). It is the callers responsibility
- ** to free this array using Tcl_Free(), and to decrement the reference
- ** count of each Tcl_Obj* member of the array.
- **
- ** The return value of this function is the number of columns of data
- ** returned by pStmt (and hence the size of the *papColName array).
- **
- ** 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, 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 int
- computeColumnNames(
- Tcl_Interp *interp,
- sqlite3_stmt *pStmt, /* SQL statement */
- Tcl_Obj ***papColName, /* OUT: Array of column names */
- Tcl_Obj *pArray /* Name of array variable (may be null) */
- ){
- int nCol;
- /* Compute column names */
- nCol = sqlite3_column_count(pStmt);
- if( papColName ){
- int i;
- Tcl_Obj **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]);
- }
- /* If results are being stored in an array variable, then create
- ** the array(*) entry for that array
- */
- if( pArray ){
- Tcl_Obj *pColList = Tcl_NewObj();
- Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
- Tcl_IncrRefCount(pColList);
- for(i=0; i<nCol; i++){
- Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
- }
- Tcl_IncrRefCount(pStar);
- Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0);
- Tcl_DecrRefCount(pColList);
- Tcl_DecrRefCount(pStar);
- }
- *papColName = apColName;
- }
- return nCol;
- }
- /*
- ** The "sqlite" command below creates a new Tcl command for each
- ** connection it opens to an SQLite database. This routine is invoked
- ** whenever one of those connection-specific commands is executed
- ** in Tcl. For example, if you run Tcl code like this:
- **
- ** sqlite3 db1 "my_database"
- ** db1 close
- **
- ** The first command opens a connection to the "my_database" database
- ** and calls that connection "db1". The second command causes this
- ** subroutine to be invoked.
- */
- static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
- SqliteDb *pDb = (SqliteDb*)cd;
- int choice;
- int rc = TCL_OK;
- static const char *DB_strs[] = {
- "authorizer", "busy", "cache",
- "changes", "close", "collate",
- "collation_needed", "commit_hook", "complete",
- "copy", "enable_load_extension","errorcode",
- "eval", "exists", "function",
- "incrblob", "interrupt", "last_insert_rowid",
- "nullvalue", "onecolumn", "profile",
- "progress", "rekey", "rollback_hook",
- "timeout", "total_changes", "trace",
- "transaction", "update_hook", "version",
- 0
- };
- enum DB_enum {
- DB_AUTHORIZER, DB_BUSY, DB_CACHE,
- DB_CHANGES, DB_CLOSE, DB_COLLATE,
- DB_COLLATION_NEEDED, DB_COMMIT_HOOK, DB_COMPLETE,
- DB_COPY, DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE,
- DB_EVAL, DB_EXISTS, DB_FUNCTION,
- DB_INCRBLOB, DB_INTERRUPT, DB_LAST_INSERT_ROWID,
- DB_NULLVALUE, DB_ONECOLUMN, DB_PROFILE,
- DB_PROGRESS, DB_REKEY, DB_ROLLBACK_HOOK,
- DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE,
- DB_TRANSACTION, DB_UPDATE_HOOK, DB_VERSION
- };
- /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
- if( objc<2 ){
- Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
- return TCL_ERROR;
- }
- if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
- return TCL_ERROR;
- }
- switch( (enum DB_enum)choice ){
- /* $db authorizer ?CALLBACK?
- **
- ** Invoke the given callback to authorize each SQL operation as it is
- ** compiled. 5 arguments are appended to the callback before it is
- ** invoked:
- **
- ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
- ** (2) First descriptive name (depends on authorization type)
- ** (3) Second descriptive name
- ** (4) Name of the database (ex: "main", "temp")
- ** (5) Name of trigger that is doing the access
- **
- ** The callback should return on of the following strings: SQLITE_OK,
- ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
- **
- ** If this method is invoked with no arguments, the current authorization
- ** callback string is returned.
- */
- case DB_AUTHORIZER: {
- #ifdef SQLITE_OMIT_AUTHORIZATION
- Tcl_AppendResult(interp, "authorization not available in this build", 0);
- return TCL_ERROR;
- #else
- if( objc>3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
- return TCL_ERROR;
- }else if( objc==2 ){
- if( pDb->zAuth ){
- Tcl_AppendResult(interp, pDb->zAuth, 0);
- }
- }else{
- char *zAuth;
- int len;
- if( pDb->zAuth ){
- Tcl_Free(pDb->zAuth);
- }
- zAuth = Tcl_GetStringFromObj(objv[2], &len);
- if( zAuth && len>0 ){
- pDb->zAuth = Tcl_Alloc( len + 1 );
- memcpy(pDb->zAuth, zAuth, len+1);
- }else{
- pDb->zAuth = 0;
- }
- if( pDb->zAuth ){
- pDb->interp = interp;
- sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
- }else{
- sqlite3_set_authorizer(pDb->db, 0, 0);
- }
- }
- #endif
- break;
- }
- /* $db busy ?CALLBACK?
- **
- ** Invoke the given callback if an SQL statement attempts to open
- ** a locked database file.
- */
- case DB_BUSY: {
- if( objc>3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
- return TCL_ERROR;
- }else if( objc==2 ){
- if( pDb->zBusy ){
- Tcl_AppendResult(interp, pDb->zBusy, 0);
- }
- }else{
- char *zBusy;
- int len;
- if( pDb->zBusy ){
- Tcl_Free(pDb->zBusy);
- }
- zBusy = Tcl_GetStringFromObj(objv[2], &len);
- if( zBusy && len>0 ){
- pDb->zBusy = Tcl_Alloc( len + 1 );
- memcpy(pDb->zBusy, zBusy, len+1);
- }else{
- pDb->zBusy = 0;
- }
- if( pDb->zBusy ){
- pDb->interp = interp;
- sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
- }else{
- sqlite3_busy_handler(pDb->db, 0, 0);
- }
- }
- break;
- }
- /* $db cache flush
- ** $db cache size n
- **
- ** Flush the prepared statement cache, or set the maximum number of
- ** cached statements.
- */
- case DB_CACHE: {
- char *subCmd;
- int n;
- if( objc<=2 ){
- Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
- return TCL_ERROR;
- }
- subCmd = Tcl_GetStringFromObj( objv[2], 0 );
- if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
- if( objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "flush");
- return TCL_ERROR;
- }else{
- flushStmtCache( pDb );
- }
- }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
- if( objc!=4 ){
- Tcl_WrongNumArgs(interp, 2, objv, "size n");
- return TCL_ERROR;
- }else{
- if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
- Tcl_AppendResult( interp, "cannot convert \"",
- Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0);
- return TCL_ERROR;
- }else{
- if( n<0 ){
- flushStmtCache( pDb );
- n = 0;
- }else if( n>MAX_PREPARED_STMTS ){
- n = MAX_PREPARED_STMTS;
- }
- pDb->maxStmt = n;
- }
- }
- }else{
- Tcl_AppendResult( interp, "bad option \"",
- Tcl_GetStringFromObj(objv[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 rc; /* Result code */
- int nCol; /* Number of columns in the table */
- int nByte; /* Number of bytes in an SQL string */
- int i, j; /* Loop counters */
- int nSep; /* Number of bytes in zSep[] */
- int nNull; /* Number of bytes in zNull[] */
- char *zSql; /* An SQL statement */
- char *zLine; /* A single line of input from the file */
- char **azCol; /* zLine[] broken up into columns */
- char *zCommit; /* How to commit changes */
- FILE *in; /* The input file */
- int lineno = 0; /* Line number of input file */
- char zLineNum[80]; /* Line number print buffer */
- Tcl_Obj *pResult; /* interp result */
- char *zSep;
- char *zNull;
- if( objc<5 || objc>7 ){
- Tcl_WrongNumArgs(interp, 2, objv,
- "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
- return TCL_ERROR;
- }
- if( objc>=6 ){
- zSep = Tcl_GetStringFromObj(objv[5], 0);
- }else{
- zSep = "\t";
- }
- if( objc>=7 ){
- zNull = Tcl_GetStringFromObj(objv[6], 0);
- }else{
- zNull = "";
- }
- zConflict = Tcl_GetStringFromObj(objv[2], 0);
- zTable = Tcl_GetStringFromObj(objv[3], 0);
- zFile = Tcl_GetStringFromObj(objv[4], 0);
- nSep = strlen(zSep);
- nNull = strlen(zNull);
- if( nSep==0 ){
- Tcl_AppendResult(interp,"Error: non-null separator required for copy",0);
- return TCL_ERROR;
- }
- if(sqlite3StrICmp(zConflict, "rollback") != 0 &&
- sqlite3StrICmp(zConflict, "abort" ) != 0 &&
- sqlite3StrICmp(zConflict, "fail" ) != 0 &&
- sqlite3StrICmp(zConflict, "ignore" ) != 0 &&
- sqlite3StrICmp(zConflict, "replace" ) != 0 ) {
- Tcl_AppendResult(interp, "Error: \"", zConflict,
- "\", conflict-algorithm must be one of: rollback, "
- "abort, fail, ignore, or replace", 0);
- return TCL_ERROR;
- }
- zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
- if( zSql==0 ){
- Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0);
- return TCL_ERROR;
- }
- nByte = strlen(zSql);
- rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
- sqlite3_free(zSql);
- if( rc ){
- Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
- nCol = 0;
- }else{
- nCol = sqlite3_column_count(pStmt);
- }
- sqlite3_finalize(pStmt);
- if( nCol==0 ) {
- return TCL_ERROR;
- }
- zSql = malloc( nByte + 50 + nCol*2 );
- if( zSql==0 ) {
- Tcl_AppendResult(interp, "Error: can't malloc()", 0);
- return TCL_ERROR;
- }
- sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
- zConflict, zTable);
- j = strlen(zSql);
- for(i=1; 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 = strlen(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) || strlen(azCol[i])==0) {
- sqlite3_bind_null(pStmt, i+1);
- }else{
- sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
- }
- }
- sqlite3_step(pStmt);
- rc = sqlite3_reset(pStmt);
- free(zLine);
- if( rc!=SQLITE_OK ){
- Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0);
- zCommit = "ROLLBACK";
- break;
- }
- }
- free(azCol);
- fclose(in);
- sqlite3_finalize(pStmt);
- (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
- if( zCommit[0] == 'C' ){
- /* success, set result as number of lines processed */
- pResult = Tcl_GetObjResult(interp);
- Tcl_SetIntObj(pResult, lineno);
- rc = TCL_OK;
- }else{
- /* failure, append lineno where failed */
- sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
- Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0);
- rc = TCL_ERROR;
- }
- break;
- }
- /*
- ** $db enable_load_extension BOOLEAN
- **
- ** Turn the extension loading feature on or off. It if off by
- ** default.
- */
- case DB_ENABLE_LOAD_EXTENSION: {
- #ifndef SQLITE_OMIT_LOAD_EXTENSION
- int onoff;
- if( objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
- return TCL_ERROR;
- }
- if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
- return TCL_ERROR;
- }
- sqlite3_enable_load_extension(pDb->db, onoff);
- break;
- #else
- Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
- 0);
- return TCL_ERROR;
- #endif
- }
- /*
- ** $db errorcode
- **
- ** Return the numeric error code that was returned by the most recent
- ** call to sqlite3_exec().
- */
- case DB_ERRORCODE: {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
- break;
- }
-
- /*
- ** $db eval $sql ?array? ?{ ...code... }?
- ** $db onecolumn $sql
- **
- ** The SQL statement in $sql is evaluated. For each row, the values are
- ** placed in elements of the array named "array" and ...code... is executed.
- ** If "array" and "code" are omitted, then no callback is every invoked.
- ** If "array" is an empty string, then the values are placed in variables
- ** that have the same name as the fields extracted by the query.
- **
- ** The onecolumn method is the equivalent of:
- ** lindex [$db eval $sql] 0
- */
- case DB_ONECOLUMN:
- case DB_EVAL:
- case DB_EXISTS: {
- char const *zSql; /* Next SQL statement to execute */
- char const *zLeft; /* What is left after first stmt in zSql */
- sqlite3_stmt *pStmt; /* Compiled SQL statment */
- Tcl_Obj *pArray; /* Name of array into which results are written */
- Tcl_Obj *pScript; /* Script to run for each result set */
- Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */
- int nParm; /* Number of entries used in apParm[] */
- Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */
- Tcl_Obj *pRet; /* Value to be returned */
- SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */
- int rc2;
- if( choice==DB_EVAL ){
- if( objc<3 || objc>5 ){
- Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
- return TCL_ERROR;
- }
- pRet = Tcl_NewObj();
- Tcl_IncrRefCount(pRet);
- }else{
- if( objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "SQL");
- return TCL_ERROR;
- }
- if( choice==DB_EXISTS ){
- pRet = Tcl_NewBooleanObj(0);
- Tcl_IncrRefCount(pRet);
- }else{
- pRet = 0;
- }
- }
- if( objc==3 ){
- pArray = pScript = 0;
- }else if( objc==4 ){
- pArray = 0;
- pScript = objv[3];
- }else{
- pArray = objv[3];
- if( Tcl_GetString(pArray)[0]==0 ) pArray = 0;
- pScript = objv[4];
- }
- Tcl_IncrRefCount(objv[2]);
- zSql = Tcl_GetStringFromObj(objv[2], 0);
- while( rc==TCL_OK && zSql[0] ){
- int i; /* Loop counter */
- int nVar; /* Number of bind parameters in the pStmt */
- int nCol = -1; /* Number of columns in the result set */
- Tcl_Obj **apColName = 0; /* Array of column names */
- int len; /* String length of zSql */
-
- /* Try to find a SQL statement that has already been compiled and
- ** which matches the next sequence of SQL.
- */
- pStmt = 0;
- len = strlen(zSql);
- for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
- int n = pPreStmt->nSql;
- if( len>=n
- && memcmp(pPreStmt->zSql, zSql, n)==0
- && (zSql[n]==0 || zSql[n-1]==';')
- ){
- pStmt = pPreStmt->pStmt;
- zLeft = &zSql[pPreStmt->nSql];
- /* When a prepared statement is found, unlink it from the
- ** cache list. It will later be added back to the beginning
- ** of the cache list in order to implement LRU replacement.
- */
- if( pPreStmt->pPrev ){
- pPreStmt->pPrev->pNext = pPreStmt->pNext;
- }else{
- pDb->stmtList = pPreStmt->pNext;
- }
- if( pPreStmt->pNext ){
- pPreStmt->pNext->pPrev = pPreStmt->pPrev;
- }else{
- pDb->stmtLast = pPreStmt->pPrev;
- }
- pDb->nStmt--;
- break;
- }
- }
-
- /* If no prepared statement was found. Compile the SQL text
- */
- if( pStmt==0 ){
- if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, &zLeft) ){
- Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
- rc = TCL_ERROR;
- break;
- }
- if( pStmt==0 ){
- if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
- /* A compile-time error in the statement
- */
- Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
- rc = TCL_ERROR;
- break;
- }else{
- /* The statement was a no-op. Continue to the next statement
- ** in the SQL string.
- */
- zSql = zLeft;
- continue;
- }
- }
- assert( pPreStmt==0 );
- }
- /* Bind values to parameters that begin with $ or :
- */
- nVar = sqlite3_bind_parameter_count(pStmt);
- nParm = 0;
- if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){
- apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0]));
- }else{
- apParm = aParm;
- }
- for(i=1; i<=nVar; i++){
- const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
- if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
- Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
- if( pVar ){
- int n;
- u8 *data;
- char *zType = pVar->typePtr ? pVar->typePtr->name : "";
- char c = zType[0];
- if( zVar[0]=='@' ||
- (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
- /* Load a BLOB type if the Tcl variable is a bytearray and
- ** it has no string representation or the host
- ** parameter name begins with "@". */
- data = Tcl_GetByteArrayFromObj(pVar, &n);
- sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
- Tcl_IncrRefCount(pVar);
- apParm[nParm++] = pVar;
- }else if( c=='b' && strcmp(zType,"boolean")==0 ){
- Tcl_GetIntFromObj(interp, pVar, &n);
- sqlite3_bind_int(pStmt, i, n);
- }else if( c=='d' && strcmp(zType,"double")==0 ){
- double r;
- Tcl_GetDoubleFromObj(interp, pVar, &r);
- sqlite3_bind_double(pStmt, i, r);
- }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
- (c=='i' && strcmp(zType,"int")==0) ){
- Tcl_WideInt v;
- Tcl_GetWideIntFromObj(interp, pVar, &v);
- sqlite3_bind_int64(pStmt, i, v);
- }else{
- data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
- sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
- Tcl_IncrRefCount(pVar);
- apParm[nParm++] = pVar;
- }
- }else{
- sqlite3_bind_null( pStmt, i );
- }
- }
- }
- /* Execute the SQL
- */
- while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){
- /* Compute column names. This must be done after the first successful
- ** call to sqlite3_step(), in case the query is recompiled and the
- ** number or names of the returned columns changes.
- */
- assert(!pArray||pScript);
- if (nCol < 0) {
- Tcl_Obj ***ap = (pScript?&apColName:0);
- nCol = computeColumnNames(interp, pStmt, ap, pArray);
- }
- for(i=0; i<nCol; i++){
- Tcl_Obj *pVal;
-
- /* Set pVal to contain the i'th column of this row. */
- switch( sqlite3_column_type(pStmt, i) ){
- case SQLITE_BLOB: {
- int bytes = sqlite3_column_bytes(pStmt, i);
- pVal = Tcl_NewByteArrayObj(sqlite3_column_blob(pStmt, i), bytes);
- break;
- }
- case SQLITE_INTEGER: {
- sqlite_int64 v = sqlite3_column_int64(pStmt, i);
- if( v>=-2147483647 && v<=2147483647 ){
- pVal = Tcl_NewIntObj(v);
- }else{
- pVal = Tcl_NewWideIntObj(v);
- }
- break;
- }
- case SQLITE_FLOAT: {
- double r = sqlite3_column_double(pStmt, i);
- pVal = Tcl_NewDoubleObj(r);
- break;
- }
- case SQLITE_NULL: {
- pVal = dbTextToObj(pDb->zNull);
- break;
- }
- default: {
- pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i));
- break;
- }
- }
-
- if( pScript ){
- if( pArray==0 ){
- Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
- }else{
- Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
- }
- }else if( choice==DB_ONECOLUMN ){
- assert( pRet==0 );
- if( pRet==0 ){
- pRet = pVal;
- Tcl_IncrRefCount(pRet);
- }
- rc = TCL_BREAK;
- i = nCol;
- }else if( choice==DB_EXISTS ){
- Tcl_DecrRefCount(pRet);
- pRet = Tcl_NewBooleanObj(1);
- Tcl_IncrRefCount(pRet);
- rc = TCL_BREAK;
- i = nCol;
- }else{
- Tcl_ListObjAppendElement(interp, pRet, pVal);
- }
- }
-
- if( pScript ){
- rc = Tcl_EvalObjEx(interp, pScript, 0);
- if( rc==TCL_CONTINUE ){
- rc = TCL_OK;
- }
- }
- }
- if( rc==TCL_BREAK ){
- rc = TCL_OK;
- }
- /* Free the column name objects */
- if( pScript ){
- /* If the query returned no rows, but an array variable was
- ** specified, call computeColumnNames() now to populate the
- ** arrayname(*) variable.
- */
- if (pArray && nCol < 0) {
- Tcl_Obj ***ap = (pScript?&apColName:0);
- nCol = computeColumnNames(interp, pStmt, ap, pArray);
- }
- for(i=0; i<nCol; i++){
- Tcl_DecrRefCount(apColName[i]);
- }
- Tcl_Free((char*)apColName);
- }
- /* Free the bound string and blob parameters */
- for(i=0; i<nParm; i++){
- Tcl_DecrRefCount(apParm[i]);
- }
- if( apParm!=aParm ){
- Tcl_Free((char*)apParm);
- }
- /* Reset the statement. If the result code is SQLITE_SCHEMA, then
- ** flush the statement cache and try the statement again.
- */
- rc2 = sqlite3_reset(pStmt);
- if( SQLITE_OK!=rc2 ){
- /* If a run-time error occurs, report the error and stop reading
- ** the SQL
- */
- Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
- sqlite3_finalize(pStmt);
- rc = TCL_ERROR;
- if( pPreStmt ) Tcl_Free((char*)pPreStmt);
- break;
- }else if( pDb->maxStmt<=0 ){
- /* If the cache is turned off, deallocated the statement */
- if( pPreStmt ) Tcl_Free((char*)pPreStmt);
- sqlite3_finalize(pStmt);
- }else{
- /* Everything worked and the cache is operational.
- ** Create a new SqlPreparedStmt structure if we need one.
- ** (If we already have one we can just reuse it.)
- */
- if( pPreStmt==0 ){
- len = zLeft - zSql;
- pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) );
- if( pPreStmt==0 ) return TCL_ERROR;
- pPreStmt->pStmt = pStmt;
- pPreStmt->nSql = len;
- pPreStmt->zSql = sqlite3_sql(pStmt);
- assert( strlen(pPreStmt->zSql)==len );
- assert( 0==memcmp(pPreStmt->zSql, zSql, len) );
- }
- /* Add the prepared statement to the beginning of the cache list
- */
- pPreStmt->pNext = pDb->stmtList;
- pPreStmt->pPrev = 0;
- if( pDb->stmtList ){
- pDb->stmtList->pPrev = pPreStmt;
- }
- pDb->stmtList = pPreStmt;
- if( pDb->stmtLast==0 ){
- assert( pDb->nStmt==0 );
- pDb->stmtLast = pPreStmt;
- }else{
- assert( pDb->nStmt>0 );
- }
- pDb->nStmt++;
-
- /* If we have too many statement in cache, remove the surplus from the
- ** end of the cache list.
- */
- while( pDb->nStmt>pDb->maxStmt ){
- sqlite3_finalize(pDb->stmtLast->pStmt);
- pDb->stmtLast = pDb->stmtLast->pPrev;
- Tcl_Free((char*)pDb->stmtLast->pNext);
- pDb->stmtLast->pNext = 0;
- pDb->nStmt--;
- }
- }
- /* Proceed to the next statement */
- zSql = zLeft;
- }
- Tcl_DecrRefCount(objv[2]);
- if( pRet ){
- if( rc==TCL_OK ){
- Tcl_SetObjResult(interp, pRet);
- }
- Tcl_DecrRefCount(pRet);
- }else if( rc==TCL_OK ){
- Tcl_ResetResult(interp);
- }
- break;
- }
- /*
- ** $db function NAME SCRIPT
- **
- ** Create a new SQL function called NAME. Whenever that function is
- ** called, invoke SCRIPT to evaluate the function.
- */
- case DB_FUNCTION: {
- SqlFunc *pFunc;
- Tcl_Obj *pScript;
- char *zName;
- if( objc!=4 ){
- Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
- return TCL_ERROR;
- }
- zName = Tcl_GetStringFromObj(objv[2], 0);
- pScript = objv[3];
- pFunc = findSqlFunc(pDb, zName);
- if( pFunc==0 ) return TCL_ERROR;
- if( pFunc->pScript ){
- Tcl_DecrRefCount(pFunc->pScript);
- }
- pFunc->pScript = pScript;
- Tcl_IncrRefCount(pScript);
- pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
- rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
- pFunc, tclSqlFunc, 0, 0);
- if( rc!=SQLITE_OK ){
- rc = TCL_ERROR;
- Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
- }
- break;
- }
- /*
- ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
- */
- case DB_INCRBLOB: {
- #ifdef SQLITE_OMIT_INCRBLOB
- Tcl_AppendResult(interp, "incrblob not available in this build", 0);
- return TCL_ERROR;
- #else
- int isReadonly = 0;
- const char *zDb = "main";
- const char *zTable;
- const char *zColumn;
- sqlite_int64 iRow;
- /* Check for the -readonly option */
- if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
- isReadonly = 1;
- }
- if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
- Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
- return TCL_ERROR;
- }
- if( objc==(6+isReadonly) ){
- zDb = Tcl_GetString(objv[2]);
- }
- zTable = Tcl_GetString(objv[objc-3]);
- zColumn = Tcl_GetString(objv[objc-2]);
- rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
- if( rc==TCL_OK ){
- rc = createIncrblobChannel(
- interp, pDb, zDb, zTable, zColumn, iRow, isReadonly
- );
- }
- #endif
- break;
- }
- /*
- ** $db interrupt
- **
- ** Interrupt the execution of the inner-most SQL interpreter. This
- ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
- */
- case DB_INTERRUPT: {
- sqlite3_interrupt(pDb->db);
- break;
- }
- /*
- ** $db nullvalue ?STRING?
- **
- ** Change text used when a NULL comes back from the database. If ?STRING?
- ** is not present, then the current string used for NULL is returned.
- ** If STRING is present, then STRING is returned.
- **
- */
- case DB_NULLVALUE: {
- if( objc!=2 && objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
- return TCL_ERROR;
- }
- if( objc==3 ){
- int len;
- char *zNull = Tcl_GetStringFromObj(objv[2], &len);
- if( pDb->zNull ){
- Tcl_Free(pDb->zNull);
- }
- if( zNull && len>0 ){
- pDb->zNull = Tcl_Alloc( len + 1 );
- strncpy(pDb->zNull, zNull, len);
- pDb->zNull[len] = '\0';
- }else{
- pDb->zNull = 0;
- }
- }
- Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
- break;
- }
- /*
- ** $db last_insert_rowid
- **
- ** Return an integer which is the ROWID for the most recent insert.
- */
- case DB_LAST_INSERT_ROWID: {
- Tcl_Obj *pResult;
- Tcl_WideInt rowid;
- if( objc!=2 ){
- Tcl_WrongNumArgs(interp, 2, objv, "");
- return TCL_ERROR;
- }
- rowid = sqlite3_last_insert_rowid(pDb->db);
- pResult = Tcl_GetObjResult(interp);
- Tcl_SetWideIntObj(pResult, rowid);
- break;
- }
- /*
- ** The DB_ONECOLUMN method is implemented together with DB_EVAL.
- */
- /* $db progress ?N CALLBACK?
- **
- ** Invoke the given callback every N virtual machine opcodes while executing
- ** queries.
- */
- case DB_PROGRESS: {
- if( objc==2 ){
- if( pDb->zProgress ){
- Tcl_AppendResult(interp, pDb->zProgress, 0);
- }
- }else if( objc==4 ){
- char *zProgress;
- int len;
- int N;
- if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
- return TCL_ERROR;
- };
- if( pDb->zProgress ){
- Tcl_Free(pDb->zProgress);
- }
- zProgress = Tcl_GetStringFromObj(objv[3], &len);
- if( zProgress && len>0 ){
- pDb->zProgress = Tcl_Alloc( len + 1 );
- memcpy(pDb->zProgress, zProgress, len+1);
- }else{
- pDb->zProgress = 0;
- }
- #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
- if( pDb->zProgress ){
- pDb->interp = interp;
- sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
- }else{
- sqlite3_progress_handler(pDb->db, 0, 0, 0);
- }
- #endif
- }else{
- Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
- return TCL_ERROR;
- }
- break;
- }
- /* $db profile ?CALLBACK?
- **
- ** Make arrangements to invoke the CALLBACK routine after each SQL statement
- ** that has run. The text of the SQL and the amount of elapse time are
- ** appended to CALLBACK before the script is run.
- */
- case DB_PROFILE: {
- if( objc>3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
- return TCL_ERROR;
- }else if( objc==2 ){
- if( pDb->zProfile ){
- Tcl_AppendResult(interp, pDb->zProfile, 0);
- }
- }else{
- char *zProfile;
- int len;
- if( pDb->zProfile ){
- Tcl_Free(pDb->zProfile);
- }
- zProfile = Tcl_GetStringFromObj(objv[2], &len);
- if( zProfile && len>0 ){
- pDb->zProfile = Tcl_Alloc( len + 1 );
- memcpy(pDb->zProfile, zProfile, len+1);
- }else{
- pDb->zProfile = 0;
- }
- #ifndef SQLITE_OMIT_TRACE
- if( pDb->zProfile ){
- pDb->interp = interp;
- sqlite3_profile(pDb->db, DbProfileHandler, pDb);
- }else{
- sqlite3_profile(pDb->db, 0, 0);
- }
- #endif
- }
- break;
- }
- /*
- ** $db rekey KEY
- **
- ** Change the encryption key on the currently open database.
- */
- case DB_REKEY: {
- int nKey;
- void *pKey;
- if( objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "KEY");
- return TCL_ERROR;
- }
- pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
- #ifdef SQLITE_HAS_CODEC
- rc = sqlite3_rekey(pDb->db, pKey, nKey);
- if( rc ){
- Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
- rc = TCL_ERROR;
- }
- #endif
- break;
- }
- /*
- ** $db timeout MILLESECONDS
- **
- ** Delay for the number of milliseconds specified when a file is locked.
- */
- case DB_TIMEOUT: {
- int ms;
- if( objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
- return TCL_ERROR;
- }
- if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
- sqlite3_busy_timeout(pDb->db, ms);
- break;
- }
-
- /*
- ** $db total_changes
- **
- ** Return the number of rows that were modified, inserted, or deleted
- ** since the database handle was created.
- */
- case DB_TOTAL_CHANGES: {
- Tcl_Obj *pResult;
- if( objc!=2 ){
- Tcl_WrongNumArgs(interp, 2, objv, "");
- return TCL_ERROR;
- }
- pResult = Tcl_GetObjResult(interp);
- Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
- break;
- }
- /* $db trace ?CALLBACK?
- **
- ** Make arrangements to invoke the CALLBACK routine for each SQL statement
- ** that is executed. The text of the SQL is appended to CALLBACK before
- ** it is executed.
- */
- case DB_TRACE: {
- if( objc>3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
- return TCL_ERROR;
- }else if( objc==2 ){
- if( pDb->zTrace ){
- Tcl_AppendResult(interp, pDb->zTrace, 0);
- }
- }else{
- char *zTrace;
- int len;
- if( pDb->zTrace ){
- Tcl_Free(pDb->zTrace);
- }
- zTrace = Tcl_GetStringFromObj(objv[2], &len);
- if( zTrace && len>0 ){
- pDb->zTrace = Tcl_Alloc( len + 1 );
- memcpy(pDb->zTrace, zTrace, len+1);
- }else{
- pDb->zTrace = 0;
- }
- #ifndef SQLITE_OMIT_TRACE
- if( pDb->zTrace ){
- pDb->interp = interp;
- sqlite3_trace(pDb->db, DbTraceHandler, pDb);
- }else{
- sqlite3_trace(pDb->db, 0, 0);
- }
- #endif
- }
- break;
- }
- /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT
- **
- ** Start a new transaction (if we are not already in the midst of a
- ** transaction) and execute the TCL script SCRIPT. After SCRIPT
- ** completes, either commit the transaction or roll it back if SCRIPT
- ** throws an exception. Or if no new transation was started, do nothing.
- ** pass the exception on up the stack.
- **
- ** This command was inspired by Dave Thomas's talk on Ruby at the
- ** 2005 O'Reilly Open Source Convention (OSCON).
- */
- case DB_TRANSACTION: {
- int inTrans;
- Tcl_Obj *pScript;
- const char *zBegin = "BEGIN";
- if( objc!=3 && objc!=4 ){
- Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
- return TCL_ERROR;
- }
- if( objc==3 ){
- pScript = objv[2];
- } else {
- static const char *TTYPE_strs[] = {
- "deferred", "exclusive", "immediate", 0
- };
- enum TTYPE_enum {
- TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
- };
- int ttype;
- if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
- 0, &ttype) ){
- return TCL_ERROR;
- }
- switch( (enum TTYPE_enum)ttype ){
- case TTYPE_DEFERRED: /* no-op */; break;
- case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
- case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
- }
- pScript = objv[3];
- }
- inTrans = !sqlite3_get_autocommit(pDb->db);
- if( !inTrans ){
- (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
- }
- rc = Tcl_EvalObjEx(interp, pScript, 0);
- if( !inTrans ){
- const char *zEnd;
- if( rc==TCL_ERROR ){
- zEnd = "ROLLBACK";
- } else {
- zEnd = "COMMIT";
- }
- if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
- sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
- }
- }
- break;
- }
- /*
- ** $db update_hook ?script?
- ** $db rollback_hook ?script?
- */
- case DB_UPDATE_HOOK:
- case DB_ROLLBACK_HOOK: {
- /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
- ** whether [$db update_hook] or [$db rollback_hook] was invoked.
- */
- Tcl_Obj **ppHook;
- if( choice==DB_UPDATE_HOOK ){
- ppHook = &pDb->pUpdateHook;
- }else{
- ppHook = &pDb->pRollbackHook;
- }
- if( objc!=2 && objc!=3 ){
- Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
- return TCL_ERROR;
- }
- if( *ppHook ){
- Tcl_SetObjResult(interp, *ppHook);
- if( objc==3 ){
- Tcl_DecrRefCount(*ppHook);
- *ppHook = 0;
- }
- }
- if( objc==3 ){
- assert( !(*ppHook) );
- if( Tcl_GetCharLength(objv[2])>0 ){
- *ppHook = objv[2];
- Tcl_IncrRefCount(*ppHook);
- }
- }
- sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
- sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb);
- break;
- }
- /* $db version
- **
- ** Return the version string for this database.
- */
- case DB_VERSION: {
- Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
- break;
- }
- } /* End of the SWITCH statement */
- return rc;
- }
- /*
- ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
- ** ?-create BOOLEAN?
- **
- ** This is the main Tcl command. When the "sqlite" Tcl command is
- ** invoked, this routine runs to process that command.
- **
- ** The first argument, DBNAME, is an arbitrary name for a new
- ** database connection. This command creates a new command named
- ** DBNAME that is used to control that connection. The database
- ** connection is deleted when the DBNAME command is deleted.
- **
- ** The second argument is the name of the database file.
- **
- */
- static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
- SqliteDb *p;
- void *pKey = 0;
- int nKey = 0;
- const char *zArg;
- char *zErrMsg;
- int i;
- const char *zFile;
- const char *zVfs = 0;
- int flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE;
- Tcl_DString translatedFilename;
- if( objc==2 ){
- zArg = Tcl_GetStringFromObj(objv[1], 0);
- if( strcmp(zArg,"-version")==0 ){
- Tcl_AppendResult(interp,sqlite3_version,0);
- return TCL_OK;
- }
- if( strcmp(zArg,"-has-codec")==0 ){
- #ifdef SQLITE_HAS_CODEC
- Tcl_AppendResult(interp,"1",0);
- #else
- Tcl_AppendResult(interp,"0",0);
- #endif
- return TCL_OK;
- }
- }
- for(i=3; i+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 ){
- i++;
- zVfs = Tcl_GetString(objv[i]);
- }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{
- 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?"
- #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_TEST
- if( p->db ){
- extern int Md5_Register(sqlite3*);
- if( Md5_Register(p->db)==SQLITE_NOMEM ){
- zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
- sqlite3_close(p->db);
- p->db = 0;
- }
- }
- #endif
- #ifdef SQLITE_HAS_CODEC
- if( p->db ){
- sqlite3_key(p->db, pKey, nKey);
- }
- #endif
- if( p->db==0 ){
- Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
- Tcl_Free((char*)p);
- sqlite3_free(zErrMsg);
- return TCL_ERROR;
- }
- p->maxStmt = NUM_PREPARED_STMTS;
- p->interp = interp;
- zArg = Tcl_GetStringFromObj(objv[1], 0);
- Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
- return TCL_OK;
- }
- /*
- ** Provide a dummy Tcl_InitStubs if we are using this as a static
- ** library.
- */
- #ifndef USE_TCL_STUBS
- # undef Tcl_InitStubs
- # define Tcl_InitStubs(a,b,c)
- #endif
- /*
- ** Make sure we have a PACKAGE_VERSION macro defined. This will be
- ** defined automatically by the TEA makefile. But other makefiles
- ** do not define it.
- */
- #ifndef PACKAGE_VERSION
- # define PACKAGE_VERSION SQLITE_VERSION
- #endif
- /*
- ** Initialize this module.
- **
- ** This Tcl module contains only a single new Tcl command named "sqlite".
- ** (Hence there is no namespace. There is no point in using a namespace
- ** if the extension only supplies one new name!) The "sqlite" command is
- ** used to open a new SQLite database. See the DbMain() routine above
- ** for additional information.
- */
- EXTERN int Sqlite3_Init(Tcl_Interp *interp){
- Tcl_InitStubs(interp, "8.4", 0);
- Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
- Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
- Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
- Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION);
- return TCL_OK;
- }
- EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
- EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
- EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
- #ifndef SQLITE_3_SUFFIX_ONLY
- EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
- EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
- EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
- EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
- #endif
- #ifdef TCLSH
- /*****************************************************************************
- ** The code that follows is used to build standalone TCL interpreters
- ** that are statically linked with SQLite.
- */
- /*
- ** If the macro TCLSH is one, then put in code this for the
- ** "main" routine that will initialize Tcl and take input from
- ** standard input, or if a file is named on the command line
- ** the TCL interpreter reads and evaluates that file.
- */
- #if TCLSH==1
- static char zMainloop[] =
- "set line {}\n"
- "while {![eof stdin]} {\n"
- "if {$line!=\"\"} {\n"
- "puts -nonewline \"> \"\n"
- "} else {\n"
- "puts -nonewline \"% \"\n"
- "}\n"
- "flush stdout\n"
- "append line [gets stdin]\n"
- "if {[info complete $line]} {\n"
- "if {[catch {uplevel #0 $line} result]} {\n"
- "puts stderr \"Error: $result\"\n"
- "} elseif {$result!=\"\"} {\n"
- "puts $result\n"
- "}\n"
- "set line {}\n"
- "} else {\n"
- "append line \\n\n"
- "}\n"
- "}\n"
- ;
- #endif
- /*
- ** If the macro TCLSH is two, then get the main loop code out of
- ** the separate file "spaceanal_tcl.h".
- */
- #if TCLSH==2
- static char zMainloop[] =
- #include "spaceanal_tcl.h"
- ;
- #endif
- #define TCLSH_MAIN main /* Needed to fake out mktclapp */
- int TCLSH_MAIN(int argc, char **argv){
- Tcl_Interp *interp;
- Tcl_FindExecutable(argv[0]);
- interp = Tcl_CreateInterp();
- Sqlite3_Init(interp);
- #ifdef SQLITE_TEST
- {
- extern int Md5_Init(Tcl_Interp*);
- extern int Sqliteconfig_Init(Tcl_Interp*);
- extern int Sqlitetest1_Init(Tcl_Interp*);
- extern int Sqlitetest2_Init(Tcl_Interp*);
- extern int Sqlitetest3_Init(Tcl_Interp*);
- extern int Sqlitetest4_Init(Tcl_Interp*);
- extern int Sqlitetest5_Init(Tcl_Interp*);
- extern int Sqlitetest6_Init(Tcl_Interp*);
- extern int Sqlitetest7_Init(Tcl_Interp*);
- extern int Sqlitetest8_Init(Tcl_Interp*);
- extern int Sqlitetest9_Init(Tcl_Interp*);
- extern int Sqlitetestasync_Init(Tcl_Interp*);
- extern int Sqlitetest_autoext_Init(Tcl_Interp*);
- extern int Sqlitetest_hexio_Init(Tcl_Interp*);
- extern int Sqlitetest_malloc_Init(Tcl_Interp*);
- extern int Sqlitetestschema_Init(Tcl_Interp*);
- extern int Sqlitetestsse_Init(Tcl_Interp*);
- extern int Sqlitetesttclvar_Init(Tcl_Interp*);
- extern int SqlitetestThread_Init(Tcl_Interp*);
- extern int SqlitetestOnefile_Init();
- Md5_Init(interp);
- Sqliteconfig_Init(interp);
- Sqlitetest1_Init(interp);
- Sqlitetest2_Init(interp);
- Sqlitetest3_Init(interp);
- Sqlitetest4_Init(interp);
- Sqlitetest5_Init(interp);
- Sqlitetest6_Init(interp);
- Sqlitetest7_Init(interp);
- Sqlitetest8_Init(interp);
- Sqlitetest9_Init(interp);
- Sqlitetestasync_Init(interp);
- Sqlitetest_autoext_Init(interp);
- Sqlitetest_hexio_Init(interp);
- Sqlitetest_malloc_Init(interp);
- Sqlitetestschema_Init(interp);
- Sqlitetesttclvar_Init(interp);
- SqlitetestThread_Init(interp);
- SqlitetestOnefile_Init(interp);
- #ifdef SQLITE_SSE
- Sqlitetestsse_Init(interp);
- #endif
- }
- #endif
- if( argc>=2 || TCLSH==2 ){
- int i;
- char zArgc[32];
- sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH));
- Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
- for(i=3-TCLSH; 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 = interp->result;
- fprintf(stderr,"%s: %s\n", *argv, zInfo);
- return 1;
- }
- }
- if( argc<=1 || TCLSH==2 ){
- Tcl_GlobalEval(interp, zMainloop);
- }
- return 0;
- }
- #endif /* TCLSH */
|