000001  /*
000002  ** 2001 September 15
000003  **
000004  ** The author disclaims copyright to this source code.  In place of
000005  ** a legal notice, here is a blessing:
000006  **
000007  **    May you do good and not evil.
000008  **    May you find forgiveness for yourself and forgive others.
000009  **    May you share freely, never taking more than you give.
000010  **
000011  *************************************************************************
000012  ** A TCL Interface to SQLite.  Append this file to sqlite3.c and
000013  ** compile the whole thing to build a TCL-enabled version of SQLite.
000014  **
000015  ** Compile-time options:
000016  **
000017  **  -DTCLSH         Add a "main()" routine that works as a tclsh.
000018  **
000019  **  -DTCLSH_INIT_PROC=name
000020  **
000021  **                  Invoke name(interp) to initialize the Tcl interpreter.
000022  **                  If name(interp) returns a non-NULL string, then run
000023  **                  that string as a Tcl script to launch the application.
000024  **                  If name(interp) returns NULL, then run the regular
000025  **                  tclsh-emulator code.
000026  */
000027  #ifdef TCLSH_INIT_PROC
000028  # define TCLSH 1
000029  #endif
000030  
000031  /*
000032  ** If requested, include the SQLite compiler options file for MSVC.
000033  */
000034  #if defined(INCLUDE_MSVC_H)
000035  # include "msvc.h"
000036  #endif
000037  
000038  #if defined(INCLUDE_SQLITE_TCL_H)
000039  # include "sqlite_tcl.h"
000040  #else
000041  # include "tcl.h"
000042  # ifndef SQLITE_TCLAPI
000043  #  define SQLITE_TCLAPI
000044  # endif
000045  #endif
000046  #include <errno.h>
000047  
000048  /*
000049  ** Some additional include files are needed if this file is not
000050  ** appended to the amalgamation.
000051  */
000052  #ifndef SQLITE_AMALGAMATION
000053  # include "sqlite3.h"
000054  # include <stdlib.h>
000055  # include <string.h>
000056  # include <assert.h>
000057    typedef unsigned char u8;
000058  #endif
000059  #include <ctype.h>
000060  
000061  /* Used to get the current process ID */
000062  #if !defined(_WIN32)
000063  # include <unistd.h>
000064  # define GETPID getpid
000065  #elif !defined(_WIN32_WCE)
000066  # ifndef SQLITE_AMALGAMATION
000067  #  ifndef WIN32_LEAN_AND_MEAN
000068  #   define WIN32_LEAN_AND_MEAN
000069  #  endif
000070  #  include <windows.h>
000071  # endif
000072  # define GETPID (int)GetCurrentProcessId
000073  #endif
000074  
000075  /*
000076   * Windows needs to know which symbols to export.  Unix does not.
000077   * BUILD_sqlite should be undefined for Unix.
000078   */
000079  #ifdef BUILD_sqlite
000080  #undef TCL_STORAGE_CLASS
000081  #define TCL_STORAGE_CLASS DLLEXPORT
000082  #endif /* BUILD_sqlite */
000083  
000084  #define NUM_PREPARED_STMTS 10
000085  #define MAX_PREPARED_STMTS 100
000086  
000087  /* Forward declaration */
000088  typedef struct SqliteDb SqliteDb;
000089  
000090  /*
000091  ** New SQL functions can be created as TCL scripts.  Each such function
000092  ** is described by an instance of the following structure.
000093  */
000094  typedef struct SqlFunc SqlFunc;
000095  struct SqlFunc {
000096    Tcl_Interp *interp;   /* The TCL interpret to execute the function */
000097    Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
000098    SqliteDb *pDb;        /* Database connection that owns this function */
000099    int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
000100    char *zName;          /* Name of this function */
000101    SqlFunc *pNext;       /* Next function on the list of them all */
000102  };
000103  
000104  /*
000105  ** New collation sequences function can be created as TCL scripts.  Each such
000106  ** function is described by an instance of the following structure.
000107  */
000108  typedef struct SqlCollate SqlCollate;
000109  struct SqlCollate {
000110    Tcl_Interp *interp;   /* The TCL interpret to execute the function */
000111    char *zScript;        /* The script to be run */
000112    SqlCollate *pNext;    /* Next function on the list of them all */
000113  };
000114  
000115  /*
000116  ** Prepared statements are cached for faster execution.  Each prepared
000117  ** statement is described by an instance of the following structure.
000118  */
000119  typedef struct SqlPreparedStmt SqlPreparedStmt;
000120  struct SqlPreparedStmt {
000121    SqlPreparedStmt *pNext;  /* Next in linked list */
000122    SqlPreparedStmt *pPrev;  /* Previous on the list */
000123    sqlite3_stmt *pStmt;     /* The prepared statement */
000124    int nSql;                /* chars in zSql[] */
000125    const char *zSql;        /* Text of the SQL statement */
000126    int nParm;               /* Size of apParm array */
000127    Tcl_Obj **apParm;        /* Array of referenced object pointers */
000128  };
000129  
000130  typedef struct IncrblobChannel IncrblobChannel;
000131  
000132  /*
000133  ** There is one instance of this structure for each SQLite database
000134  ** that has been opened by the SQLite TCL interface.
000135  **
000136  ** If this module is built with SQLITE_TEST defined (to create the SQLite
000137  ** testfixture executable), then it may be configured to use either
000138  ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
000139  ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
000140  */
000141  struct SqliteDb {
000142    sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */
000143    Tcl_Interp *interp;        /* The interpreter used for this database */
000144    char *zBusy;               /* The busy callback routine */
000145    char *zCommit;             /* The commit hook callback routine */
000146    char *zTrace;              /* The trace callback routine */
000147    char *zTraceV2;            /* The trace_v2 callback routine */
000148    char *zProfile;            /* The profile callback routine */
000149    char *zProgress;           /* The progress callback routine */
000150    char *zAuth;               /* The authorization callback routine */
000151    int disableAuth;           /* Disable the authorizer if it exists */
000152    char *zNull;               /* Text to substitute for an SQL NULL value */
000153    SqlFunc *pFunc;            /* List of SQL functions */
000154    Tcl_Obj *pUpdateHook;      /* Update hook script (if any) */
000155    Tcl_Obj *pPreUpdateHook;   /* Pre-update hook script (if any) */
000156    Tcl_Obj *pRollbackHook;    /* Rollback hook script (if any) */
000157    Tcl_Obj *pWalHook;         /* WAL hook script (if any) */
000158    Tcl_Obj *pUnlockNotify;    /* Unlock notify script (if any) */
000159    SqlCollate *pCollate;      /* List of SQL collation functions */
000160    int rc;                    /* Return code of most recent sqlite3_exec() */
000161    Tcl_Obj *pCollateNeeded;   /* Collation needed script */
000162    SqlPreparedStmt *stmtList; /* List of prepared statements*/
000163    SqlPreparedStmt *stmtLast; /* Last statement in the list */
000164    int maxStmt;               /* The next maximum number of stmtList */
000165    int nStmt;                 /* Number of statements in stmtList */
000166    IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
000167    int nStep, nSort, nIndex;  /* Statistics for most recent operation */
000168    int nVMStep;               /* Another statistic for most recent operation */
000169    int nTransaction;          /* Number of nested [transaction] methods */
000170    int openFlags;             /* Flags used to open.  (SQLITE_OPEN_URI) */
000171  #ifdef SQLITE_TEST
000172    int bLegacyPrepare;        /* True to use sqlite3_prepare() */
000173  #endif
000174  };
000175  
000176  struct IncrblobChannel {
000177    sqlite3_blob *pBlob;      /* sqlite3 blob handle */
000178    SqliteDb *pDb;            /* Associated database connection */
000179    int iSeek;                /* Current seek offset */
000180    Tcl_Channel channel;      /* Channel identifier */
000181    IncrblobChannel *pNext;   /* Linked list of all open incrblob channels */
000182    IncrblobChannel *pPrev;   /* Linked list of all open incrblob channels */
000183  };
000184  
000185  /*
000186  ** Compute a string length that is limited to what can be stored in
000187  ** lower 30 bits of a 32-bit signed integer.
000188  */
000189  static int strlen30(const char *z){
000190    const char *z2 = z;
000191    while( *z2 ){ z2++; }
000192    return 0x3fffffff & (int)(z2 - z);
000193  }
000194  
000195  
000196  #ifndef SQLITE_OMIT_INCRBLOB
000197  /*
000198  ** Close all incrblob channels opened using database connection pDb.
000199  ** This is called when shutting down the database connection.
000200  */
000201  static void closeIncrblobChannels(SqliteDb *pDb){
000202    IncrblobChannel *p;
000203    IncrblobChannel *pNext;
000204  
000205    for(p=pDb->pIncrblob; p; p=pNext){
000206      pNext = p->pNext;
000207  
000208      /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
000209      ** which deletes the IncrblobChannel structure at *p. So do not
000210      ** call Tcl_Free() here.
000211      */
000212      Tcl_UnregisterChannel(pDb->interp, p->channel);
000213    }
000214  }
000215  
000216  /*
000217  ** Close an incremental blob channel.
000218  */
000219  static int SQLITE_TCLAPI incrblobClose(
000220    ClientData instanceData,
000221    Tcl_Interp *interp
000222  ){
000223    IncrblobChannel *p = (IncrblobChannel *)instanceData;
000224    int rc = sqlite3_blob_close(p->pBlob);
000225    sqlite3 *db = p->pDb->db;
000226  
000227    /* Remove the channel from the SqliteDb.pIncrblob list. */
000228    if( p->pNext ){
000229      p->pNext->pPrev = p->pPrev;
000230    }
000231    if( p->pPrev ){
000232      p->pPrev->pNext = p->pNext;
000233    }
000234    if( p->pDb->pIncrblob==p ){
000235      p->pDb->pIncrblob = p->pNext;
000236    }
000237  
000238    /* Free the IncrblobChannel structure */
000239    Tcl_Free((char *)p);
000240  
000241    if( rc!=SQLITE_OK ){
000242      Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
000243      return TCL_ERROR;
000244    }
000245    return TCL_OK;
000246  }
000247  
000248  /*
000249  ** Read data from an incremental blob channel.
000250  */
000251  static int SQLITE_TCLAPI incrblobInput(
000252    ClientData instanceData,
000253    char *buf,
000254    int bufSize,
000255    int *errorCodePtr
000256  ){
000257    IncrblobChannel *p = (IncrblobChannel *)instanceData;
000258    int nRead = bufSize;         /* Number of bytes to read */
000259    int nBlob;                   /* Total size of the blob */
000260    int rc;                      /* sqlite error code */
000261  
000262    nBlob = sqlite3_blob_bytes(p->pBlob);
000263    if( (p->iSeek+nRead)>nBlob ){
000264      nRead = nBlob-p->iSeek;
000265    }
000266    if( nRead<=0 ){
000267      return 0;
000268    }
000269  
000270    rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
000271    if( rc!=SQLITE_OK ){
000272      *errorCodePtr = rc;
000273      return -1;
000274    }
000275  
000276    p->iSeek += nRead;
000277    return nRead;
000278  }
000279  
000280  /*
000281  ** Write data to an incremental blob channel.
000282  */
000283  static int SQLITE_TCLAPI incrblobOutput(
000284    ClientData instanceData,
000285    CONST char *buf,
000286    int toWrite,
000287    int *errorCodePtr
000288  ){
000289    IncrblobChannel *p = (IncrblobChannel *)instanceData;
000290    int nWrite = toWrite;        /* Number of bytes to write */
000291    int nBlob;                   /* Total size of the blob */
000292    int rc;                      /* sqlite error code */
000293  
000294    nBlob = sqlite3_blob_bytes(p->pBlob);
000295    if( (p->iSeek+nWrite)>nBlob ){
000296      *errorCodePtr = EINVAL;
000297      return -1;
000298    }
000299    if( nWrite<=0 ){
000300      return 0;
000301    }
000302  
000303    rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
000304    if( rc!=SQLITE_OK ){
000305      *errorCodePtr = EIO;
000306      return -1;
000307    }
000308  
000309    p->iSeek += nWrite;
000310    return nWrite;
000311  }
000312  
000313  /*
000314  ** Seek an incremental blob channel.
000315  */
000316  static int SQLITE_TCLAPI incrblobSeek(
000317    ClientData instanceData,
000318    long offset,
000319    int seekMode,
000320    int *errorCodePtr
000321  ){
000322    IncrblobChannel *p = (IncrblobChannel *)instanceData;
000323  
000324    switch( seekMode ){
000325      case SEEK_SET:
000326        p->iSeek = offset;
000327        break;
000328      case SEEK_CUR:
000329        p->iSeek += offset;
000330        break;
000331      case SEEK_END:
000332        p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
000333        break;
000334  
000335      default: assert(!"Bad seekMode");
000336    }
000337  
000338    return p->iSeek;
000339  }
000340  
000341  
000342  static void SQLITE_TCLAPI incrblobWatch(
000343    ClientData instanceData,
000344    int mode
000345  ){
000346    /* NO-OP */
000347  }
000348  static int SQLITE_TCLAPI incrblobHandle(
000349    ClientData instanceData,
000350    int dir,
000351    ClientData *hPtr
000352  ){
000353    return TCL_ERROR;
000354  }
000355  
000356  static Tcl_ChannelType IncrblobChannelType = {
000357    "incrblob",                        /* typeName                             */
000358    TCL_CHANNEL_VERSION_2,             /* version                              */
000359    incrblobClose,                     /* closeProc                            */
000360    incrblobInput,                     /* inputProc                            */
000361    incrblobOutput,                    /* outputProc                           */
000362    incrblobSeek,                      /* seekProc                             */
000363    0,                                 /* setOptionProc                        */
000364    0,                                 /* getOptionProc                        */
000365    incrblobWatch,                     /* watchProc (this is a no-op)          */
000366    incrblobHandle,                    /* getHandleProc (always returns error) */
000367    0,                                 /* close2Proc                           */
000368    0,                                 /* blockModeProc                        */
000369    0,                                 /* flushProc                            */
000370    0,                                 /* handlerProc                          */
000371    0,                                 /* wideSeekProc                         */
000372  };
000373  
000374  /*
000375  ** Create a new incrblob channel.
000376  */
000377  static int createIncrblobChannel(
000378    Tcl_Interp *interp,
000379    SqliteDb *pDb,
000380    const char *zDb,
000381    const char *zTable,
000382    const char *zColumn,
000383    sqlite_int64 iRow,
000384    int isReadonly
000385  ){
000386    IncrblobChannel *p;
000387    sqlite3 *db = pDb->db;
000388    sqlite3_blob *pBlob;
000389    int rc;
000390    int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
000391  
000392    /* This variable is used to name the channels: "incrblob_[incr count]" */
000393    static int count = 0;
000394    char zChannel[64];
000395  
000396    rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
000397    if( rc!=SQLITE_OK ){
000398      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
000399      return TCL_ERROR;
000400    }
000401  
000402    p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
000403    p->iSeek = 0;
000404    p->pBlob = pBlob;
000405  
000406    sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
000407    p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
000408    Tcl_RegisterChannel(interp, p->channel);
000409  
000410    /* Link the new channel into the SqliteDb.pIncrblob list. */
000411    p->pNext = pDb->pIncrblob;
000412    p->pPrev = 0;
000413    if( p->pNext ){
000414      p->pNext->pPrev = p;
000415    }
000416    pDb->pIncrblob = p;
000417    p->pDb = pDb;
000418  
000419    Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
000420    return TCL_OK;
000421  }
000422  #else  /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
000423    #define closeIncrblobChannels(pDb)
000424  #endif
000425  
000426  /*
000427  ** Look at the script prefix in pCmd.  We will be executing this script
000428  ** after first appending one or more arguments.  This routine analyzes
000429  ** the script to see if it is safe to use Tcl_EvalObjv() on the script
000430  ** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much
000431  ** faster.
000432  **
000433  ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
000434  ** command name followed by zero or more arguments with no [...] or $
000435  ** or {...} or ; to be seen anywhere.  Most callback scripts consist
000436  ** of just a single procedure name and they meet this requirement.
000437  */
000438  static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
000439    /* We could try to do something with Tcl_Parse().  But we will instead
000440    ** just do a search for forbidden characters.  If any of the forbidden
000441    ** characters appear in pCmd, we will report the string as unsafe.
000442    */
000443    const char *z;
000444    int n;
000445    z = Tcl_GetStringFromObj(pCmd, &n);
000446    while( n-- > 0 ){
000447      int c = *(z++);
000448      if( c=='$' || c=='[' || c==';' ) return 0;
000449    }
000450    return 1;
000451  }
000452  
000453  /*
000454  ** Find an SqlFunc structure with the given name.  Or create a new
000455  ** one if an existing one cannot be found.  Return a pointer to the
000456  ** structure.
000457  */
000458  static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
000459    SqlFunc *p, *pNew;
000460    int nName = strlen30(zName);
000461    pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
000462    pNew->zName = (char*)&pNew[1];
000463    memcpy(pNew->zName, zName, nName+1);
000464    for(p=pDb->pFunc; p; p=p->pNext){
000465      if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){
000466        Tcl_Free((char*)pNew);
000467        return p;
000468      }
000469    }
000470    pNew->interp = pDb->interp;
000471    pNew->pDb = pDb;
000472    pNew->pScript = 0;
000473    pNew->pNext = pDb->pFunc;
000474    pDb->pFunc = pNew;
000475    return pNew;
000476  }
000477  
000478  /*
000479  ** Free a single SqlPreparedStmt object.
000480  */
000481  static void dbFreeStmt(SqlPreparedStmt *pStmt){
000482  #ifdef SQLITE_TEST
000483    if( sqlite3_sql(pStmt->pStmt)==0 ){
000484      Tcl_Free((char *)pStmt->zSql);
000485    }
000486  #endif
000487    sqlite3_finalize(pStmt->pStmt);
000488    Tcl_Free((char *)pStmt);
000489  }
000490  
000491  /*
000492  ** Finalize and free a list of prepared statements
000493  */
000494  static void flushStmtCache(SqliteDb *pDb){
000495    SqlPreparedStmt *pPreStmt;
000496    SqlPreparedStmt *pNext;
000497  
000498    for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){
000499      pNext = pPreStmt->pNext;
000500      dbFreeStmt(pPreStmt);
000501    }
000502    pDb->nStmt = 0;
000503    pDb->stmtLast = 0;
000504    pDb->stmtList = 0;
000505  }
000506  
000507  /*
000508  ** TCL calls this procedure when an sqlite3 database command is
000509  ** deleted.
000510  */
000511  static void SQLITE_TCLAPI DbDeleteCmd(void *db){
000512    SqliteDb *pDb = (SqliteDb*)db;
000513    flushStmtCache(pDb);
000514    closeIncrblobChannels(pDb);
000515    sqlite3_close(pDb->db);
000516    while( pDb->pFunc ){
000517      SqlFunc *pFunc = pDb->pFunc;
000518      pDb->pFunc = pFunc->pNext;
000519      assert( pFunc->pDb==pDb );
000520      Tcl_DecrRefCount(pFunc->pScript);
000521      Tcl_Free((char*)pFunc);
000522    }
000523    while( pDb->pCollate ){
000524      SqlCollate *pCollate = pDb->pCollate;
000525      pDb->pCollate = pCollate->pNext;
000526      Tcl_Free((char*)pCollate);
000527    }
000528    if( pDb->zBusy ){
000529      Tcl_Free(pDb->zBusy);
000530    }
000531    if( pDb->zTrace ){
000532      Tcl_Free(pDb->zTrace);
000533    }
000534    if( pDb->zTraceV2 ){
000535      Tcl_Free(pDb->zTraceV2);
000536    }
000537    if( pDb->zProfile ){
000538      Tcl_Free(pDb->zProfile);
000539    }
000540    if( pDb->zAuth ){
000541      Tcl_Free(pDb->zAuth);
000542    }
000543    if( pDb->zNull ){
000544      Tcl_Free(pDb->zNull);
000545    }
000546    if( pDb->pUpdateHook ){
000547      Tcl_DecrRefCount(pDb->pUpdateHook);
000548    }
000549    if( pDb->pPreUpdateHook ){
000550      Tcl_DecrRefCount(pDb->pPreUpdateHook);
000551    }
000552    if( pDb->pRollbackHook ){
000553      Tcl_DecrRefCount(pDb->pRollbackHook);
000554    }
000555    if( pDb->pWalHook ){
000556      Tcl_DecrRefCount(pDb->pWalHook);
000557    }
000558    if( pDb->pCollateNeeded ){
000559      Tcl_DecrRefCount(pDb->pCollateNeeded);
000560    }
000561    Tcl_Free((char*)pDb);
000562  }
000563  
000564  /*
000565  ** This routine is called when a database file is locked while trying
000566  ** to execute SQL.
000567  */
000568  static int DbBusyHandler(void *cd, int nTries){
000569    SqliteDb *pDb = (SqliteDb*)cd;
000570    int rc;
000571    char zVal[30];
000572  
000573    sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
000574    rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
000575    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
000576      return 0;
000577    }
000578    return 1;
000579  }
000580  
000581  #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
000582  /*
000583  ** This routine is invoked as the 'progress callback' for the database.
000584  */
000585  static int DbProgressHandler(void *cd){
000586    SqliteDb *pDb = (SqliteDb*)cd;
000587    int rc;
000588  
000589    assert( pDb->zProgress );
000590    rc = Tcl_Eval(pDb->interp, pDb->zProgress);
000591    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
000592      return 1;
000593    }
000594    return 0;
000595  }
000596  #endif
000597  
000598  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
000599      !defined(SQLITE_OMIT_DEPRECATED)
000600  /*
000601  ** This routine is called by the SQLite trace handler whenever a new
000602  ** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
000603  */
000604  static void DbTraceHandler(void *cd, const char *zSql){
000605    SqliteDb *pDb = (SqliteDb*)cd;
000606    Tcl_DString str;
000607  
000608    Tcl_DStringInit(&str);
000609    Tcl_DStringAppend(&str, pDb->zTrace, -1);
000610    Tcl_DStringAppendElement(&str, zSql);
000611    Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
000612    Tcl_DStringFree(&str);
000613    Tcl_ResetResult(pDb->interp);
000614  }
000615  #endif
000616  
000617  #ifndef SQLITE_OMIT_TRACE
000618  /*
000619  ** This routine is called by the SQLite trace_v2 handler whenever a new
000620  ** supported event is generated.  Unsupported event types are ignored.
000621  ** The TCL script in pDb->zTraceV2 is executed, with the arguments for
000622  ** the event appended to it (as list elements).
000623  */
000624  static int DbTraceV2Handler(
000625    unsigned type, /* One of the SQLITE_TRACE_* event types. */
000626    void *cd,      /* The original context data pointer. */
000627    void *pd,      /* Primary event data, depends on event type. */
000628    void *xd       /* Extra event data, depends on event type. */
000629  ){
000630    SqliteDb *pDb = (SqliteDb*)cd;
000631    Tcl_Obj *pCmd;
000632  
000633    switch( type ){
000634      case SQLITE_TRACE_STMT: {
000635        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
000636        char *zSql = (char *)xd;
000637  
000638        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
000639        Tcl_IncrRefCount(pCmd);
000640        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000641                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
000642        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000643                                 Tcl_NewStringObj(zSql, -1));
000644        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000645        Tcl_DecrRefCount(pCmd);
000646        Tcl_ResetResult(pDb->interp);
000647        break;
000648      }
000649      case SQLITE_TRACE_PROFILE: {
000650        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
000651        sqlite3_int64 ns = *(sqlite3_int64*)xd;
000652  
000653        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
000654        Tcl_IncrRefCount(pCmd);
000655        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000656                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
000657        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000658                                 Tcl_NewWideIntObj((Tcl_WideInt)ns));
000659        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000660        Tcl_DecrRefCount(pCmd);
000661        Tcl_ResetResult(pDb->interp);
000662        break;
000663      }
000664      case SQLITE_TRACE_ROW: {
000665        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
000666  
000667        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
000668        Tcl_IncrRefCount(pCmd);
000669        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000670                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
000671        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000672        Tcl_DecrRefCount(pCmd);
000673        Tcl_ResetResult(pDb->interp);
000674        break;
000675      }
000676      case SQLITE_TRACE_CLOSE: {
000677        sqlite3 *db = (sqlite3 *)pd;
000678  
000679        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
000680        Tcl_IncrRefCount(pCmd);
000681        Tcl_ListObjAppendElement(pDb->interp, pCmd,
000682                                 Tcl_NewWideIntObj((Tcl_WideInt)db));
000683        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000684        Tcl_DecrRefCount(pCmd);
000685        Tcl_ResetResult(pDb->interp);
000686        break;
000687      }
000688    }
000689    return SQLITE_OK;
000690  }
000691  #endif
000692  
000693  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
000694      !defined(SQLITE_OMIT_DEPRECATED)
000695  /*
000696  ** This routine is called by the SQLite profile handler after a statement
000697  ** SQL has executed.  The TCL script in pDb->zProfile is evaluated.
000698  */
000699  static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
000700    SqliteDb *pDb = (SqliteDb*)cd;
000701    Tcl_DString str;
000702    char zTm[100];
000703  
000704    sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
000705    Tcl_DStringInit(&str);
000706    Tcl_DStringAppend(&str, pDb->zProfile, -1);
000707    Tcl_DStringAppendElement(&str, zSql);
000708    Tcl_DStringAppendElement(&str, zTm);
000709    Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
000710    Tcl_DStringFree(&str);
000711    Tcl_ResetResult(pDb->interp);
000712  }
000713  #endif
000714  
000715  /*
000716  ** This routine is called when a transaction is committed.  The
000717  ** TCL script in pDb->zCommit is executed.  If it returns non-zero or
000718  ** if it throws an exception, the transaction is rolled back instead
000719  ** of being committed.
000720  */
000721  static int DbCommitHandler(void *cd){
000722    SqliteDb *pDb = (SqliteDb*)cd;
000723    int rc;
000724  
000725    rc = Tcl_Eval(pDb->interp, pDb->zCommit);
000726    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
000727      return 1;
000728    }
000729    return 0;
000730  }
000731  
000732  static void DbRollbackHandler(void *clientData){
000733    SqliteDb *pDb = (SqliteDb*)clientData;
000734    assert(pDb->pRollbackHook);
000735    if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
000736      Tcl_BackgroundError(pDb->interp);
000737    }
000738  }
000739  
000740  /*
000741  ** This procedure handles wal_hook callbacks.
000742  */
000743  static int DbWalHandler(
000744    void *clientData,
000745    sqlite3 *db,
000746    const char *zDb,
000747    int nEntry
000748  ){
000749    int ret = SQLITE_OK;
000750    Tcl_Obj *p;
000751    SqliteDb *pDb = (SqliteDb*)clientData;
000752    Tcl_Interp *interp = pDb->interp;
000753    assert(pDb->pWalHook);
000754  
000755    assert( db==pDb->db );
000756    p = Tcl_DuplicateObj(pDb->pWalHook);
000757    Tcl_IncrRefCount(p);
000758    Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
000759    Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
000760    if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
000761     || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
000762    ){
000763      Tcl_BackgroundError(interp);
000764    }
000765    Tcl_DecrRefCount(p);
000766  
000767    return ret;
000768  }
000769  
000770  #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
000771  static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
000772    char zBuf[64];
000773    sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);
000774    Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
000775    sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);
000776    Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
000777  }
000778  #else
000779  # define setTestUnlockNotifyVars(x,y,z)
000780  #endif
000781  
000782  #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
000783  static void DbUnlockNotify(void **apArg, int nArg){
000784    int i;
000785    for(i=0; i<nArg; i++){
000786      const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
000787      SqliteDb *pDb = (SqliteDb *)apArg[i];
000788      setTestUnlockNotifyVars(pDb->interp, i, nArg);
000789      assert( pDb->pUnlockNotify);
000790      Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
000791      Tcl_DecrRefCount(pDb->pUnlockNotify);
000792      pDb->pUnlockNotify = 0;
000793    }
000794  }
000795  #endif
000796  
000797  #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
000798  /*
000799  ** Pre-update hook callback.
000800  */
000801  static void DbPreUpdateHandler(
000802    void *p,
000803    sqlite3 *db,
000804    int op,
000805    const char *zDb,
000806    const char *zTbl,
000807    sqlite_int64 iKey1,
000808    sqlite_int64 iKey2
000809  ){
000810    SqliteDb *pDb = (SqliteDb *)p;
000811    Tcl_Obj *pCmd;
000812    static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
000813  
000814    assert( (SQLITE_DELETE-1)/9 == 0 );
000815    assert( (SQLITE_INSERT-1)/9 == 1 );
000816    assert( (SQLITE_UPDATE-1)/9 == 2 );
000817    assert( pDb->pPreUpdateHook );
000818    assert( db==pDb->db );
000819    assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
000820  
000821    pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);
000822    Tcl_IncrRefCount(pCmd);
000823    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
000824    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
000825    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
000826    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));
000827    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));
000828    Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000829    Tcl_DecrRefCount(pCmd);
000830  }
000831  #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
000832  
000833  static void DbUpdateHandler(
000834    void *p,
000835    int op,
000836    const char *zDb,
000837    const char *zTbl,
000838    sqlite_int64 rowid
000839  ){
000840    SqliteDb *pDb = (SqliteDb *)p;
000841    Tcl_Obj *pCmd;
000842    static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
000843  
000844    assert( (SQLITE_DELETE-1)/9 == 0 );
000845    assert( (SQLITE_INSERT-1)/9 == 1 );
000846    assert( (SQLITE_UPDATE-1)/9 == 2 );
000847  
000848    assert( pDb->pUpdateHook );
000849    assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
000850  
000851    pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
000852    Tcl_IncrRefCount(pCmd);
000853    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
000854    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
000855    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
000856    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
000857    Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
000858    Tcl_DecrRefCount(pCmd);
000859  }
000860  
000861  static void tclCollateNeeded(
000862    void *pCtx,
000863    sqlite3 *db,
000864    int enc,
000865    const char *zName
000866  ){
000867    SqliteDb *pDb = (SqliteDb *)pCtx;
000868    Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
000869    Tcl_IncrRefCount(pScript);
000870    Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
000871    Tcl_EvalObjEx(pDb->interp, pScript, 0);
000872    Tcl_DecrRefCount(pScript);
000873  }
000874  
000875  /*
000876  ** This routine is called to evaluate an SQL collation function implemented
000877  ** using TCL script.
000878  */
000879  static int tclSqlCollate(
000880    void *pCtx,
000881    int nA,
000882    const void *zA,
000883    int nB,
000884    const void *zB
000885  ){
000886    SqlCollate *p = (SqlCollate *)pCtx;
000887    Tcl_Obj *pCmd;
000888  
000889    pCmd = Tcl_NewStringObj(p->zScript, -1);
000890    Tcl_IncrRefCount(pCmd);
000891    Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
000892    Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
000893    Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
000894    Tcl_DecrRefCount(pCmd);
000895    return (atoi(Tcl_GetStringResult(p->interp)));
000896  }
000897  
000898  /*
000899  ** This routine is called to evaluate an SQL function implemented
000900  ** using TCL script.
000901  */
000902  static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
000903    SqlFunc *p = sqlite3_user_data(context);
000904    Tcl_Obj *pCmd;
000905    int i;
000906    int rc;
000907  
000908    if( argc==0 ){
000909      /* If there are no arguments to the function, call Tcl_EvalObjEx on the
000910      ** script object directly.  This allows the TCL compiler to generate
000911      ** bytecode for the command on the first invocation and thus make
000912      ** subsequent invocations much faster. */
000913      pCmd = p->pScript;
000914      Tcl_IncrRefCount(pCmd);
000915      rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
000916      Tcl_DecrRefCount(pCmd);
000917    }else{
000918      /* If there are arguments to the function, make a shallow copy of the
000919      ** script object, lappend the arguments, then evaluate the copy.
000920      **
000921      ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated.
000922      ** The new Tcl_Obj contains pointers to the original list elements.
000923      ** That way, when Tcl_EvalObjv() is run and shimmers the first element
000924      ** of the list to tclCmdNameType, that alternate representation will
000925      ** be preserved and reused on the next invocation.
000926      */
000927      Tcl_Obj **aArg;
000928      int nArg;
000929      if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
000930        sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
000931        return;
000932      }
000933      pCmd = Tcl_NewListObj(nArg, aArg);
000934      Tcl_IncrRefCount(pCmd);
000935      for(i=0; i<argc; i++){
000936        sqlite3_value *pIn = argv[i];
000937        Tcl_Obj *pVal;
000938  
000939        /* Set pVal to contain the i'th column of this row. */
000940        switch( sqlite3_value_type(pIn) ){
000941          case SQLITE_BLOB: {
000942            int bytes = sqlite3_value_bytes(pIn);
000943            pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
000944            break;
000945          }
000946          case SQLITE_INTEGER: {
000947            sqlite_int64 v = sqlite3_value_int64(pIn);
000948            if( v>=-2147483647 && v<=2147483647 ){
000949              pVal = Tcl_NewIntObj((int)v);
000950            }else{
000951              pVal = Tcl_NewWideIntObj(v);
000952            }
000953            break;
000954          }
000955          case SQLITE_FLOAT: {
000956            double r = sqlite3_value_double(pIn);
000957            pVal = Tcl_NewDoubleObj(r);
000958            break;
000959          }
000960          case SQLITE_NULL: {
000961            pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
000962            break;
000963          }
000964          default: {
000965            int bytes = sqlite3_value_bytes(pIn);
000966            pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
000967            break;
000968          }
000969        }
000970        rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
000971        if( rc ){
000972          Tcl_DecrRefCount(pCmd);
000973          sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
000974          return;
000975        }
000976      }
000977      if( !p->useEvalObjv ){
000978        /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
000979        ** is a list without a string representation.  To prevent this from
000980        ** happening, make sure pCmd has a valid string representation */
000981        Tcl_GetString(pCmd);
000982      }
000983      rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
000984      Tcl_DecrRefCount(pCmd);
000985    }
000986  
000987    if( rc && rc!=TCL_RETURN ){
000988      sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
000989    }else{
000990      Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
000991      int n;
000992      u8 *data;
000993      const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
000994      char c = zType[0];
000995      if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
000996        /* Only return a BLOB type if the Tcl variable is a bytearray and
000997        ** has no string representation. */
000998        data = Tcl_GetByteArrayFromObj(pVar, &n);
000999        sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
001000      }else if( c=='b' && strcmp(zType,"boolean")==0 ){
001001        Tcl_GetIntFromObj(0, pVar, &n);
001002        sqlite3_result_int(context, n);
001003      }else if( c=='d' && strcmp(zType,"double")==0 ){
001004        double r;
001005        Tcl_GetDoubleFromObj(0, pVar, &r);
001006        sqlite3_result_double(context, r);
001007      }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
001008            (c=='i' && strcmp(zType,"int")==0) ){
001009        Tcl_WideInt v;
001010        Tcl_GetWideIntFromObj(0, pVar, &v);
001011        sqlite3_result_int64(context, v);
001012      }else{
001013        data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
001014        sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
001015      }
001016    }
001017  }
001018  
001019  #ifndef SQLITE_OMIT_AUTHORIZATION
001020  /*
001021  ** This is the authentication function.  It appends the authentication
001022  ** type code and the two arguments to zCmd[] then invokes the result
001023  ** on the interpreter.  The reply is examined to determine if the
001024  ** authentication fails or succeeds.
001025  */
001026  static int auth_callback(
001027    void *pArg,
001028    int code,
001029    const char *zArg1,
001030    const char *zArg2,
001031    const char *zArg3,
001032    const char *zArg4
001033  #ifdef SQLITE_USER_AUTHENTICATION
001034    ,const char *zArg5
001035  #endif
001036  ){
001037    const char *zCode;
001038    Tcl_DString str;
001039    int rc;
001040    const char *zReply;
001041    /* EVIDENCE-OF: R-38590-62769 The first parameter to the authorizer
001042    ** callback is a copy of the third parameter to the
001043    ** sqlite3_set_authorizer() interface.
001044    */
001045    SqliteDb *pDb = (SqliteDb*)pArg;
001046    if( pDb->disableAuth ) return SQLITE_OK;
001047  
001048    /* EVIDENCE-OF: R-56518-44310 The second parameter to the callback is an
001049    ** integer action code that specifies the particular action to be
001050    ** authorized. */
001051    switch( code ){
001052      case SQLITE_COPY              : zCode="SQLITE_COPY"; break;
001053      case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;
001054      case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;
001055      case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
001056      case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
001057      case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
001058      case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
001059      case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;
001060      case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;
001061      case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;
001062      case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;
001063      case SQLITE_DROP_TABLE        : zCode="SQLITE_DROP_TABLE"; break;
001064      case SQLITE_DROP_TEMP_INDEX   : zCode="SQLITE_DROP_TEMP_INDEX"; break;
001065      case SQLITE_DROP_TEMP_TABLE   : zCode="SQLITE_DROP_TEMP_TABLE"; break;
001066      case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
001067      case SQLITE_DROP_TEMP_VIEW    : zCode="SQLITE_DROP_TEMP_VIEW"; break;
001068      case SQLITE_DROP_TRIGGER      : zCode="SQLITE_DROP_TRIGGER"; break;
001069      case SQLITE_DROP_VIEW         : zCode="SQLITE_DROP_VIEW"; break;
001070      case SQLITE_INSERT            : zCode="SQLITE_INSERT"; break;
001071      case SQLITE_PRAGMA            : zCode="SQLITE_PRAGMA"; break;
001072      case SQLITE_READ              : zCode="SQLITE_READ"; break;
001073      case SQLITE_SELECT            : zCode="SQLITE_SELECT"; break;
001074      case SQLITE_TRANSACTION       : zCode="SQLITE_TRANSACTION"; break;
001075      case SQLITE_UPDATE            : zCode="SQLITE_UPDATE"; break;
001076      case SQLITE_ATTACH            : zCode="SQLITE_ATTACH"; break;
001077      case SQLITE_DETACH            : zCode="SQLITE_DETACH"; break;
001078      case SQLITE_ALTER_TABLE       : zCode="SQLITE_ALTER_TABLE"; break;
001079      case SQLITE_REINDEX           : zCode="SQLITE_REINDEX"; break;
001080      case SQLITE_ANALYZE           : zCode="SQLITE_ANALYZE"; break;
001081      case SQLITE_CREATE_VTABLE     : zCode="SQLITE_CREATE_VTABLE"; break;
001082      case SQLITE_DROP_VTABLE       : zCode="SQLITE_DROP_VTABLE"; break;
001083      case SQLITE_FUNCTION          : zCode="SQLITE_FUNCTION"; break;
001084      case SQLITE_SAVEPOINT         : zCode="SQLITE_SAVEPOINT"; break;
001085      case SQLITE_RECURSIVE         : zCode="SQLITE_RECURSIVE"; break;
001086      default                       : zCode="????"; break;
001087    }
001088    Tcl_DStringInit(&str);
001089    Tcl_DStringAppend(&str, pDb->zAuth, -1);
001090    Tcl_DStringAppendElement(&str, zCode);
001091    Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
001092    Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
001093    Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
001094    Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
001095  #ifdef SQLITE_USER_AUTHENTICATION
001096    Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : "");
001097  #endif
001098    rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
001099    Tcl_DStringFree(&str);
001100    zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";
001101    if( strcmp(zReply,"SQLITE_OK")==0 ){
001102      rc = SQLITE_OK;
001103    }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
001104      rc = SQLITE_DENY;
001105    }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
001106      rc = SQLITE_IGNORE;
001107    }else{
001108      rc = 999;
001109    }
001110    return rc;
001111  }
001112  #endif /* SQLITE_OMIT_AUTHORIZATION */
001113  
001114  /*
001115  ** This routine reads a line of text from FILE in, stores
001116  ** the text in memory obtained from malloc() and returns a pointer
001117  ** to the text.  NULL is returned at end of file, or if malloc()
001118  ** fails.
001119  **
001120  ** The interface is like "readline" but no command-line editing
001121  ** is done.
001122  **
001123  ** copied from shell.c from '.import' command
001124  */
001125  static char *local_getline(char *zPrompt, FILE *in){
001126    char *zLine;
001127    int nLine;
001128    int n;
001129  
001130    nLine = 100;
001131    zLine = malloc( nLine );
001132    if( zLine==0 ) return 0;
001133    n = 0;
001134    while( 1 ){
001135      if( n+100>nLine ){
001136        nLine = nLine*2 + 100;
001137        zLine = realloc(zLine, nLine);
001138        if( zLine==0 ) return 0;
001139      }
001140      if( fgets(&zLine[n], nLine - n, in)==0 ){
001141        if( n==0 ){
001142          free(zLine);
001143          return 0;
001144        }
001145        zLine[n] = 0;
001146        break;
001147      }
001148      while( zLine[n] ){ n++; }
001149      if( n>0 && zLine[n-1]=='\n' ){
001150        n--;
001151        zLine[n] = 0;
001152        break;
001153      }
001154    }
001155    zLine = realloc( zLine, n+1 );
001156    return zLine;
001157  }
001158  
001159  
001160  /*
001161  ** This function is part of the implementation of the command:
001162  **
001163  **   $db transaction [-deferred|-immediate|-exclusive] SCRIPT
001164  **
001165  ** It is invoked after evaluating the script SCRIPT to commit or rollback
001166  ** the transaction or savepoint opened by the [transaction] command.
001167  */
001168  static int SQLITE_TCLAPI DbTransPostCmd(
001169    ClientData data[],                   /* data[0] is the Sqlite3Db* for $db */
001170    Tcl_Interp *interp,                  /* Tcl interpreter */
001171    int result                           /* Result of evaluating SCRIPT */
001172  ){
001173    static const char *const azEnd[] = {
001174      "RELEASE _tcl_transaction",        /* rc==TCL_ERROR, nTransaction!=0 */
001175      "COMMIT",                          /* rc!=TCL_ERROR, nTransaction==0 */
001176      "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
001177      "ROLLBACK"                         /* rc==TCL_ERROR, nTransaction==0 */
001178    };
001179    SqliteDb *pDb = (SqliteDb*)data[0];
001180    int rc = result;
001181    const char *zEnd;
001182  
001183    pDb->nTransaction--;
001184    zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
001185  
001186    pDb->disableAuth++;
001187    if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
001188        /* This is a tricky scenario to handle. The most likely cause of an
001189        ** error is that the exec() above was an attempt to commit the
001190        ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
001191        ** that an IO-error has occurred. In either case, throw a Tcl exception
001192        ** and try to rollback the transaction.
001193        **
001194        ** But it could also be that the user executed one or more BEGIN,
001195        ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
001196        ** this method's logic. Not clear how this would be best handled.
001197        */
001198      if( rc!=TCL_ERROR ){
001199        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
001200        rc = TCL_ERROR;
001201      }
001202      sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
001203    }
001204    pDb->disableAuth--;
001205  
001206    return rc;
001207  }
001208  
001209  /*
001210  ** Unless SQLITE_TEST is defined, this function is a simple wrapper around
001211  ** sqlite3_prepare_v2(). If SQLITE_TEST is defined, then it uses either
001212  ** sqlite3_prepare_v2() or legacy interface sqlite3_prepare(), depending
001213  ** on whether or not the [db_use_legacy_prepare] command has been used to
001214  ** configure the connection.
001215  */
001216  static int dbPrepare(
001217    SqliteDb *pDb,                  /* Database object */
001218    const char *zSql,               /* SQL to compile */
001219    sqlite3_stmt **ppStmt,          /* OUT: Prepared statement */
001220    const char **pzOut              /* OUT: Pointer to next SQL statement */
001221  ){
001222    unsigned int prepFlags = 0;
001223  #ifdef SQLITE_TEST
001224    if( pDb->bLegacyPrepare ){
001225      return sqlite3_prepare(pDb->db, zSql, -1, ppStmt, pzOut);
001226    }
001227  #endif
001228    /* If the statement cache is large, use the SQLITE_PREPARE_PERSISTENT
001229    ** flags, which uses less lookaside memory.  But if the cache is small,
001230    ** omit that flag to make full use of lookaside */
001231    if( pDb->maxStmt>5 ) prepFlags = SQLITE_PREPARE_PERSISTENT;
001232  
001233    return sqlite3_prepare_v3(pDb->db, zSql, -1, prepFlags, ppStmt, pzOut);
001234  }
001235  
001236  /*
001237  ** Search the cache for a prepared-statement object that implements the
001238  ** first SQL statement in the buffer pointed to by parameter zIn. If
001239  ** no such prepared-statement can be found, allocate and prepare a new
001240  ** one. In either case, bind the current values of the relevant Tcl
001241  ** variables to any $var, :var or @var variables in the statement. Before
001242  ** returning, set *ppPreStmt to point to the prepared-statement object.
001243  **
001244  ** Output parameter *pzOut is set to point to the next SQL statement in
001245  ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
001246  ** next statement.
001247  **
001248  ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
001249  ** and an error message loaded into interpreter pDb->interp.
001250  */
001251  static int dbPrepareAndBind(
001252    SqliteDb *pDb,                  /* Database object */
001253    char const *zIn,                /* SQL to compile */
001254    char const **pzOut,             /* OUT: Pointer to next SQL statement */
001255    SqlPreparedStmt **ppPreStmt     /* OUT: Object used to cache statement */
001256  ){
001257    const char *zSql = zIn;         /* Pointer to first SQL statement in zIn */
001258    sqlite3_stmt *pStmt = 0;        /* Prepared statement object */
001259    SqlPreparedStmt *pPreStmt;      /* Pointer to cached statement */
001260    int nSql;                       /* Length of zSql in bytes */
001261    int nVar = 0;                   /* Number of variables in statement */
001262    int iParm = 0;                  /* Next free entry in apParm */
001263    char c;
001264    int i;
001265    Tcl_Interp *interp = pDb->interp;
001266  
001267    *ppPreStmt = 0;
001268  
001269    /* Trim spaces from the start of zSql and calculate the remaining length. */
001270    while( (c = zSql[0])==' ' || c=='\t' || c=='\r' || c=='\n' ){ zSql++; }
001271    nSql = strlen30(zSql);
001272  
001273    for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
001274      int n = pPreStmt->nSql;
001275      if( nSql>=n
001276          && memcmp(pPreStmt->zSql, zSql, n)==0
001277          && (zSql[n]==0 || zSql[n-1]==';')
001278      ){
001279        pStmt = pPreStmt->pStmt;
001280        *pzOut = &zSql[pPreStmt->nSql];
001281  
001282        /* When a prepared statement is found, unlink it from the
001283        ** cache list.  It will later be added back to the beginning
001284        ** of the cache list in order to implement LRU replacement.
001285        */
001286        if( pPreStmt->pPrev ){
001287          pPreStmt->pPrev->pNext = pPreStmt->pNext;
001288        }else{
001289          pDb->stmtList = pPreStmt->pNext;
001290        }
001291        if( pPreStmt->pNext ){
001292          pPreStmt->pNext->pPrev = pPreStmt->pPrev;
001293        }else{
001294          pDb->stmtLast = pPreStmt->pPrev;
001295        }
001296        pDb->nStmt--;
001297        nVar = sqlite3_bind_parameter_count(pStmt);
001298        break;
001299      }
001300    }
001301  
001302    /* If no prepared statement was found. Compile the SQL text. Also allocate
001303    ** a new SqlPreparedStmt structure.  */
001304    if( pPreStmt==0 ){
001305      int nByte;
001306  
001307      if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
001308        Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
001309        return TCL_ERROR;
001310      }
001311      if( pStmt==0 ){
001312        if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
001313          /* A compile-time error in the statement. */
001314          Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
001315          return TCL_ERROR;
001316        }else{
001317          /* The statement was a no-op.  Continue to the next statement
001318          ** in the SQL string.
001319          */
001320          return TCL_OK;
001321        }
001322      }
001323  
001324      assert( pPreStmt==0 );
001325      nVar = sqlite3_bind_parameter_count(pStmt);
001326      nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
001327      pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
001328      memset(pPreStmt, 0, nByte);
001329  
001330      pPreStmt->pStmt = pStmt;
001331      pPreStmt->nSql = (int)(*pzOut - zSql);
001332      pPreStmt->zSql = sqlite3_sql(pStmt);
001333      pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
001334  #ifdef SQLITE_TEST
001335      if( pPreStmt->zSql==0 ){
001336        char *zCopy = Tcl_Alloc(pPreStmt->nSql + 1);
001337        memcpy(zCopy, zSql, pPreStmt->nSql);
001338        zCopy[pPreStmt->nSql] = '\0';
001339        pPreStmt->zSql = zCopy;
001340      }
001341  #endif
001342    }
001343    assert( pPreStmt );
001344    assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
001345    assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
001346  
001347    /* Bind values to parameters that begin with $ or : */
001348    for(i=1; i<=nVar; i++){
001349      const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
001350      if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
001351        Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
001352        if( pVar ){
001353          int n;
001354          u8 *data;
001355          const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
001356          c = zType[0];
001357          if( zVar[0]=='@' ||
001358             (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
001359            /* Load a BLOB type if the Tcl variable is a bytearray and
001360            ** it has no string representation or the host
001361            ** parameter name begins with "@". */
001362            data = Tcl_GetByteArrayFromObj(pVar, &n);
001363            sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
001364            Tcl_IncrRefCount(pVar);
001365            pPreStmt->apParm[iParm++] = pVar;
001366          }else if( c=='b' && strcmp(zType,"boolean")==0 ){
001367            Tcl_GetIntFromObj(interp, pVar, &n);
001368            sqlite3_bind_int(pStmt, i, n);
001369          }else if( c=='d' && strcmp(zType,"double")==0 ){
001370            double r;
001371            Tcl_GetDoubleFromObj(interp, pVar, &r);
001372            sqlite3_bind_double(pStmt, i, r);
001373          }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
001374                (c=='i' && strcmp(zType,"int")==0) ){
001375            Tcl_WideInt v;
001376            Tcl_GetWideIntFromObj(interp, pVar, &v);
001377            sqlite3_bind_int64(pStmt, i, v);
001378          }else{
001379            data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
001380            sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
001381            Tcl_IncrRefCount(pVar);
001382            pPreStmt->apParm[iParm++] = pVar;
001383          }
001384        }else{
001385          sqlite3_bind_null(pStmt, i);
001386        }
001387      }
001388    }
001389    pPreStmt->nParm = iParm;
001390    *ppPreStmt = pPreStmt;
001391  
001392    return TCL_OK;
001393  }
001394  
001395  /*
001396  ** Release a statement reference obtained by calling dbPrepareAndBind().
001397  ** There should be exactly one call to this function for each call to
001398  ** dbPrepareAndBind().
001399  **
001400  ** If the discard parameter is non-zero, then the statement is deleted
001401  ** immediately. Otherwise it is added to the LRU list and may be returned
001402  ** by a subsequent call to dbPrepareAndBind().
001403  */
001404  static void dbReleaseStmt(
001405    SqliteDb *pDb,                  /* Database handle */
001406    SqlPreparedStmt *pPreStmt,      /* Prepared statement handle to release */
001407    int discard                     /* True to delete (not cache) the pPreStmt */
001408  ){
001409    int i;
001410  
001411    /* Free the bound string and blob parameters */
001412    for(i=0; i<pPreStmt->nParm; i++){
001413      Tcl_DecrRefCount(pPreStmt->apParm[i]);
001414    }
001415    pPreStmt->nParm = 0;
001416  
001417    if( pDb->maxStmt<=0 || discard ){
001418      /* If the cache is turned off, deallocated the statement */
001419      dbFreeStmt(pPreStmt);
001420    }else{
001421      /* Add the prepared statement to the beginning of the cache list. */
001422      pPreStmt->pNext = pDb->stmtList;
001423      pPreStmt->pPrev = 0;
001424      if( pDb->stmtList ){
001425       pDb->stmtList->pPrev = pPreStmt;
001426      }
001427      pDb->stmtList = pPreStmt;
001428      if( pDb->stmtLast==0 ){
001429        assert( pDb->nStmt==0 );
001430        pDb->stmtLast = pPreStmt;
001431      }else{
001432        assert( pDb->nStmt>0 );
001433      }
001434      pDb->nStmt++;
001435  
001436      /* If we have too many statement in cache, remove the surplus from
001437      ** the end of the cache list.  */
001438      while( pDb->nStmt>pDb->maxStmt ){
001439        SqlPreparedStmt *pLast = pDb->stmtLast;
001440        pDb->stmtLast = pLast->pPrev;
001441        pDb->stmtLast->pNext = 0;
001442        pDb->nStmt--;
001443        dbFreeStmt(pLast);
001444      }
001445    }
001446  }
001447  
001448  /*
001449  ** Structure used with dbEvalXXX() functions:
001450  **
001451  **   dbEvalInit()
001452  **   dbEvalStep()
001453  **   dbEvalFinalize()
001454  **   dbEvalRowInfo()
001455  **   dbEvalColumnValue()
001456  */
001457  typedef struct DbEvalContext DbEvalContext;
001458  struct DbEvalContext {
001459    SqliteDb *pDb;                  /* Database handle */
001460    Tcl_Obj *pSql;                  /* Object holding string zSql */
001461    const char *zSql;               /* Remaining SQL to execute */
001462    SqlPreparedStmt *pPreStmt;      /* Current statement */
001463    int nCol;                       /* Number of columns returned by pStmt */
001464    int evalFlags;                  /* Flags used */
001465    Tcl_Obj *pArray;                /* Name of array variable */
001466    Tcl_Obj **apColName;            /* Array of column names */
001467  };
001468  
001469  #define SQLITE_EVAL_WITHOUTNULLS  0x00001  /* Unset array(*) for NULL */
001470  
001471  /*
001472  ** Release any cache of column names currently held as part of
001473  ** the DbEvalContext structure passed as the first argument.
001474  */
001475  static void dbReleaseColumnNames(DbEvalContext *p){
001476    if( p->apColName ){
001477      int i;
001478      for(i=0; i<p->nCol; i++){
001479        Tcl_DecrRefCount(p->apColName[i]);
001480      }
001481      Tcl_Free((char *)p->apColName);
001482      p->apColName = 0;
001483    }
001484    p->nCol = 0;
001485  }
001486  
001487  /*
001488  ** Initialize a DbEvalContext structure.
001489  **
001490  ** If pArray is not NULL, then it contains the name of a Tcl array
001491  ** variable. The "*" member of this array is set to a list containing
001492  ** the names of the columns returned by the statement as part of each
001493  ** call to dbEvalStep(), in order from left to right. e.g. if the names
001494  ** of the returned columns are a, b and c, it does the equivalent of the
001495  ** tcl command:
001496  **
001497  **     set ${pArray}(*) {a b c}
001498  */
001499  static void dbEvalInit(
001500    DbEvalContext *p,               /* Pointer to structure to initialize */
001501    SqliteDb *pDb,                  /* Database handle */
001502    Tcl_Obj *pSql,                  /* Object containing SQL script */
001503    Tcl_Obj *pArray,                /* Name of Tcl array to set (*) element of */
001504    int evalFlags                   /* Flags controlling evaluation */
001505  ){
001506    memset(p, 0, sizeof(DbEvalContext));
001507    p->pDb = pDb;
001508    p->zSql = Tcl_GetString(pSql);
001509    p->pSql = pSql;
001510    Tcl_IncrRefCount(pSql);
001511    if( pArray ){
001512      p->pArray = pArray;
001513      Tcl_IncrRefCount(pArray);
001514    }
001515    p->evalFlags = evalFlags;
001516  }
001517  
001518  /*
001519  ** Obtain information about the row that the DbEvalContext passed as the
001520  ** first argument currently points to.
001521  */
001522  static void dbEvalRowInfo(
001523    DbEvalContext *p,               /* Evaluation context */
001524    int *pnCol,                     /* OUT: Number of column names */
001525    Tcl_Obj ***papColName           /* OUT: Array of column names */
001526  ){
001527    /* Compute column names */
001528    if( 0==p->apColName ){
001529      sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
001530      int i;                        /* Iterator variable */
001531      int nCol;                     /* Number of columns returned by pStmt */
001532      Tcl_Obj **apColName = 0;      /* Array of column names */
001533  
001534      p->nCol = nCol = sqlite3_column_count(pStmt);
001535      if( nCol>0 && (papColName || p->pArray) ){
001536        apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
001537        for(i=0; i<nCol; i++){
001538          apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
001539          Tcl_IncrRefCount(apColName[i]);
001540        }
001541        p->apColName = apColName;
001542      }
001543  
001544      /* If results are being stored in an array variable, then create
001545      ** the array(*) entry for that array
001546      */
001547      if( p->pArray ){
001548        Tcl_Interp *interp = p->pDb->interp;
001549        Tcl_Obj *pColList = Tcl_NewObj();
001550        Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
001551  
001552        for(i=0; i<nCol; i++){
001553          Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
001554        }
001555        Tcl_IncrRefCount(pStar);
001556        Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
001557        Tcl_DecrRefCount(pStar);
001558      }
001559    }
001560  
001561    if( papColName ){
001562      *papColName = p->apColName;
001563    }
001564    if( pnCol ){
001565      *pnCol = p->nCol;
001566    }
001567  }
001568  
001569  /*
001570  ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
001571  ** returned, then an error message is stored in the interpreter before
001572  ** returning.
001573  **
001574  ** A return value of TCL_OK means there is a row of data available. The
001575  ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
001576  ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
001577  ** is returned, then the SQL script has finished executing and there are
001578  ** no further rows available. This is similar to SQLITE_DONE.
001579  */
001580  static int dbEvalStep(DbEvalContext *p){
001581    const char *zPrevSql = 0;       /* Previous value of p->zSql */
001582  
001583    while( p->zSql[0] || p->pPreStmt ){
001584      int rc;
001585      if( p->pPreStmt==0 ){
001586        zPrevSql = (p->zSql==zPrevSql ? 0 : p->zSql);
001587        rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
001588        if( rc!=TCL_OK ) return rc;
001589      }else{
001590        int rcs;
001591        SqliteDb *pDb = p->pDb;
001592        SqlPreparedStmt *pPreStmt = p->pPreStmt;
001593        sqlite3_stmt *pStmt = pPreStmt->pStmt;
001594  
001595        rcs = sqlite3_step(pStmt);
001596        if( rcs==SQLITE_ROW ){
001597          return TCL_OK;
001598        }
001599        if( p->pArray ){
001600          dbEvalRowInfo(p, 0, 0);
001601        }
001602        rcs = sqlite3_reset(pStmt);
001603  
001604        pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
001605        pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
001606        pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
001607        pDb->nVMStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_VM_STEP,1);
001608        dbReleaseColumnNames(p);
001609        p->pPreStmt = 0;
001610  
001611        if( rcs!=SQLITE_OK ){
001612          /* If a run-time error occurs, report the error and stop reading
001613          ** the SQL.  */
001614          dbReleaseStmt(pDb, pPreStmt, 1);
001615  #if SQLITE_TEST
001616          if( p->pDb->bLegacyPrepare && rcs==SQLITE_SCHEMA && zPrevSql ){
001617            /* If the runtime error was an SQLITE_SCHEMA, and the database
001618            ** handle is configured to use the legacy sqlite3_prepare()
001619            ** interface, retry prepare()/step() on the same SQL statement.
001620            ** This only happens once. If there is a second SQLITE_SCHEMA
001621            ** error, the error will be returned to the caller. */
001622            p->zSql = zPrevSql;
001623            continue;
001624          }
001625  #endif
001626          Tcl_SetObjResult(pDb->interp,
001627                           Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
001628          return TCL_ERROR;
001629        }else{
001630          dbReleaseStmt(pDb, pPreStmt, 0);
001631        }
001632      }
001633    }
001634  
001635    /* Finished */
001636    return TCL_BREAK;
001637  }
001638  
001639  /*
001640  ** Free all resources currently held by the DbEvalContext structure passed
001641  ** as the first argument. There should be exactly one call to this function
001642  ** for each call to dbEvalInit().
001643  */
001644  static void dbEvalFinalize(DbEvalContext *p){
001645    if( p->pPreStmt ){
001646      sqlite3_reset(p->pPreStmt->pStmt);
001647      dbReleaseStmt(p->pDb, p->pPreStmt, 0);
001648      p->pPreStmt = 0;
001649    }
001650    if( p->pArray ){
001651      Tcl_DecrRefCount(p->pArray);
001652      p->pArray = 0;
001653    }
001654    Tcl_DecrRefCount(p->pSql);
001655    dbReleaseColumnNames(p);
001656  }
001657  
001658  /*
001659  ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
001660  ** the value for the iCol'th column of the row currently pointed to by
001661  ** the DbEvalContext structure passed as the first argument.
001662  */
001663  static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
001664    sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
001665    switch( sqlite3_column_type(pStmt, iCol) ){
001666      case SQLITE_BLOB: {
001667        int bytes = sqlite3_column_bytes(pStmt, iCol);
001668        const char *zBlob = sqlite3_column_blob(pStmt, iCol);
001669        if( !zBlob ) bytes = 0;
001670        return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
001671      }
001672      case SQLITE_INTEGER: {
001673        sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
001674        if( v>=-2147483647 && v<=2147483647 ){
001675          return Tcl_NewIntObj((int)v);
001676        }else{
001677          return Tcl_NewWideIntObj(v);
001678        }
001679      }
001680      case SQLITE_FLOAT: {
001681        return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
001682      }
001683      case SQLITE_NULL: {
001684        return Tcl_NewStringObj(p->pDb->zNull, -1);
001685      }
001686    }
001687  
001688    return Tcl_NewStringObj((char*)sqlite3_column_text(pStmt, iCol), -1);
001689  }
001690  
001691  /*
001692  ** If using Tcl version 8.6 or greater, use the NR functions to avoid
001693  ** recursive evalution of scripts by the [db eval] and [db trans]
001694  ** commands. Even if the headers used while compiling the extension
001695  ** are 8.6 or newer, the code still tests the Tcl version at runtime.
001696  ** This allows stubs-enabled builds to be used with older Tcl libraries.
001697  */
001698  #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
001699  # define SQLITE_TCL_NRE 1
001700  static int DbUseNre(void){
001701    int major, minor;
001702    Tcl_GetVersion(&major, &minor, 0, 0);
001703    return( (major==8 && minor>=6) || major>8 );
001704  }
001705  #else
001706  /*
001707  ** Compiling using headers earlier than 8.6. In this case NR cannot be
001708  ** used, so DbUseNre() to always return zero. Add #defines for the other
001709  ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
001710  ** even though the only invocations of them are within conditional blocks
001711  ** of the form:
001712  **
001713  **   if( DbUseNre() ) { ... }
001714  */
001715  # define SQLITE_TCL_NRE 0
001716  # define DbUseNre() 0
001717  # define Tcl_NRAddCallback(a,b,c,d,e,f) (void)0
001718  # define Tcl_NREvalObj(a,b,c) 0
001719  # define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
001720  #endif
001721  
001722  /*
001723  ** This function is part of the implementation of the command:
001724  **
001725  **   $db eval SQL ?ARRAYNAME? SCRIPT
001726  */
001727  static int SQLITE_TCLAPI DbEvalNextCmd(
001728    ClientData data[],                   /* data[0] is the (DbEvalContext*) */
001729    Tcl_Interp *interp,                  /* Tcl interpreter */
001730    int result                           /* Result so far */
001731  ){
001732    int rc = result;                     /* Return code */
001733  
001734    /* The first element of the data[] array is a pointer to a DbEvalContext
001735    ** structure allocated using Tcl_Alloc(). The second element of data[]
001736    ** is a pointer to a Tcl_Obj containing the script to run for each row
001737    ** returned by the queries encapsulated in data[0]. */
001738    DbEvalContext *p = (DbEvalContext *)data[0];
001739    Tcl_Obj *pScript = (Tcl_Obj *)data[1];
001740    Tcl_Obj *pArray = p->pArray;
001741  
001742    while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
001743      int i;
001744      int nCol;
001745      Tcl_Obj **apColName;
001746      dbEvalRowInfo(p, &nCol, &apColName);
001747      for(i=0; i<nCol; i++){
001748        if( pArray==0 ){
001749          Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
001750        }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
001751               && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL 
001752        ){
001753          Tcl_UnsetVar2(interp, Tcl_GetString(pArray), 
001754                        Tcl_GetString(apColName[i]), 0);
001755        }else{
001756          Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
001757        }
001758      }
001759  
001760      /* The required interpreter variables are now populated with the data
001761      ** from the current row. If using NRE, schedule callbacks to evaluate
001762      ** script pScript, then to invoke this function again to fetch the next
001763      ** row (or clean up if there is no next row or the script throws an
001764      ** exception). After scheduling the callbacks, return control to the
001765      ** caller.
001766      **
001767      ** If not using NRE, evaluate pScript directly and continue with the
001768      ** next iteration of this while(...) loop.  */
001769      if( DbUseNre() ){
001770        Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
001771        return Tcl_NREvalObj(interp, pScript, 0);
001772      }else{
001773        rc = Tcl_EvalObjEx(interp, pScript, 0);
001774      }
001775    }
001776  
001777    Tcl_DecrRefCount(pScript);
001778    dbEvalFinalize(p);
001779    Tcl_Free((char *)p);
001780  
001781    if( rc==TCL_OK || rc==TCL_BREAK ){
001782      Tcl_ResetResult(interp);
001783      rc = TCL_OK;
001784    }
001785    return rc;
001786  }
001787  
001788  /*
001789  ** This function is used by the implementations of the following database
001790  ** handle sub-commands:
001791  **
001792  **   $db update_hook ?SCRIPT?
001793  **   $db wal_hook ?SCRIPT?
001794  **   $db commit_hook ?SCRIPT?
001795  **   $db preupdate hook ?SCRIPT?
001796  */
001797  static void DbHookCmd(
001798    Tcl_Interp *interp,             /* Tcl interpreter */
001799    SqliteDb *pDb,                  /* Database handle */
001800    Tcl_Obj *pArg,                  /* SCRIPT argument (or NULL) */
001801    Tcl_Obj **ppHook                /* Pointer to member of SqliteDb */
001802  ){
001803    sqlite3 *db = pDb->db;
001804  
001805    if( *ppHook ){
001806      Tcl_SetObjResult(interp, *ppHook);
001807      if( pArg ){
001808        Tcl_DecrRefCount(*ppHook);
001809        *ppHook = 0;
001810      }
001811    }
001812    if( pArg ){
001813      assert( !(*ppHook) );
001814      if( Tcl_GetCharLength(pArg)>0 ){
001815        *ppHook = pArg;
001816        Tcl_IncrRefCount(*ppHook);
001817      }
001818    }
001819  
001820  #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
001821    sqlite3_preupdate_hook(db, (pDb->pPreUpdateHook?DbPreUpdateHandler:0), pDb);
001822  #endif
001823    sqlite3_update_hook(db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
001824    sqlite3_rollback_hook(db, (pDb->pRollbackHook?DbRollbackHandler:0), pDb);
001825    sqlite3_wal_hook(db, (pDb->pWalHook?DbWalHandler:0), pDb);
001826  }
001827  
001828  /*
001829  ** The "sqlite" command below creates a new Tcl command for each
001830  ** connection it opens to an SQLite database.  This routine is invoked
001831  ** whenever one of those connection-specific commands is executed
001832  ** in Tcl.  For example, if you run Tcl code like this:
001833  **
001834  **       sqlite3 db1  "my_database"
001835  **       db1 close
001836  **
001837  ** The first command opens a connection to the "my_database" database
001838  ** and calls that connection "db1".  The second command causes this
001839  ** subroutine to be invoked.
001840  */
001841  static int SQLITE_TCLAPI DbObjCmd(
001842    void *cd,
001843    Tcl_Interp *interp,
001844    int objc,
001845    Tcl_Obj *const*objv
001846  ){
001847    SqliteDb *pDb = (SqliteDb*)cd;
001848    int choice;
001849    int rc = TCL_OK;
001850    static const char *DB_strs[] = {
001851      "authorizer",             "backup",                "busy",
001852      "cache",                  "changes",               "close",
001853      "collate",                "collation_needed",      "commit_hook",
001854      "complete",               "copy",                  "deserialize",
001855      "enable_load_extension",  "errorcode",             "eval",
001856      "exists",                 "function",              "incrblob",
001857      "interrupt",              "last_insert_rowid",     "nullvalue",
001858      "onecolumn",              "preupdate",             "profile",
001859      "progress",               "rekey",                 "restore",
001860      "rollback_hook",          "serialize",             "status",
001861      "timeout",                "total_changes",         "trace",
001862      "trace_v2",               "transaction",           "unlock_notify",
001863      "update_hook",            "version",               "wal_hook",
001864      0                        
001865    };
001866    enum DB_enum {
001867      DB_AUTHORIZER,            DB_BACKUP,               DB_BUSY,
001868      DB_CACHE,                 DB_CHANGES,              DB_CLOSE,
001869      DB_COLLATE,               DB_COLLATION_NEEDED,     DB_COMMIT_HOOK,
001870      DB_COMPLETE,              DB_COPY,                 DB_DESERIALIZE,
001871      DB_ENABLE_LOAD_EXTENSION, DB_ERRORCODE,            DB_EVAL,
001872      DB_EXISTS,                DB_FUNCTION,             DB_INCRBLOB,
001873      DB_INTERRUPT,             DB_LAST_INSERT_ROWID,    DB_NULLVALUE,
001874      DB_ONECOLUMN,             DB_PREUPDATE,            DB_PROFILE,
001875      DB_PROGRESS,              DB_REKEY,                DB_RESTORE,
001876      DB_ROLLBACK_HOOK,         DB_SERIALIZE,            DB_STATUS,
001877      DB_TIMEOUT,               DB_TOTAL_CHANGES,        DB_TRACE,
001878      DB_TRACE_V2,              DB_TRANSACTION,          DB_UNLOCK_NOTIFY,
001879      DB_UPDATE_HOOK,           DB_VERSION,              DB_WAL_HOOK
001880    };
001881    /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
001882  
001883    if( objc<2 ){
001884      Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
001885      return TCL_ERROR;
001886    }
001887    if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
001888      return TCL_ERROR;
001889    }
001890  
001891    switch( (enum DB_enum)choice ){
001892  
001893    /*    $db authorizer ?CALLBACK?
001894    **
001895    ** Invoke the given callback to authorize each SQL operation as it is
001896    ** compiled.  5 arguments are appended to the callback before it is
001897    ** invoked:
001898    **
001899    **   (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
001900    **   (2) First descriptive name (depends on authorization type)
001901    **   (3) Second descriptive name
001902    **   (4) Name of the database (ex: "main", "temp")
001903    **   (5) Name of trigger that is doing the access
001904    **
001905    ** The callback should return on of the following strings: SQLITE_OK,
001906    ** SQLITE_IGNORE, or SQLITE_DENY.  Any other return value is an error.
001907    **
001908    ** If this method is invoked with no arguments, the current authorization
001909    ** callback string is returned.
001910    */
001911    case DB_AUTHORIZER: {
001912  #ifdef SQLITE_OMIT_AUTHORIZATION
001913      Tcl_AppendResult(interp, "authorization not available in this build",
001914                       (char*)0);
001915      return TCL_ERROR;
001916  #else
001917      if( objc>3 ){
001918        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
001919        return TCL_ERROR;
001920      }else if( objc==2 ){
001921        if( pDb->zAuth ){
001922          Tcl_AppendResult(interp, pDb->zAuth, (char*)0);
001923        }
001924      }else{
001925        char *zAuth;
001926        int len;
001927        if( pDb->zAuth ){
001928          Tcl_Free(pDb->zAuth);
001929        }
001930        zAuth = Tcl_GetStringFromObj(objv[2], &len);
001931        if( zAuth && len>0 ){
001932          pDb->zAuth = Tcl_Alloc( len + 1 );
001933          memcpy(pDb->zAuth, zAuth, len+1);
001934        }else{
001935          pDb->zAuth = 0;
001936        }
001937        if( pDb->zAuth ){
001938          typedef int (*sqlite3_auth_cb)(
001939             void*,int,const char*,const char*,
001940             const char*,const char*);
001941          pDb->interp = interp;
001942          sqlite3_set_authorizer(pDb->db,(sqlite3_auth_cb)auth_callback,pDb);
001943        }else{
001944          sqlite3_set_authorizer(pDb->db, 0, 0);
001945        }
001946      }
001947  #endif
001948      break;
001949    }
001950  
001951    /*    $db backup ?DATABASE? FILENAME
001952    **
001953    ** Open or create a database file named FILENAME.  Transfer the
001954    ** content of local database DATABASE (default: "main") into the
001955    ** FILENAME database.
001956    */
001957    case DB_BACKUP: {
001958      const char *zDestFile;
001959      const char *zSrcDb;
001960      sqlite3 *pDest;
001961      sqlite3_backup *pBackup;
001962  
001963      if( objc==3 ){
001964        zSrcDb = "main";
001965        zDestFile = Tcl_GetString(objv[2]);
001966      }else if( objc==4 ){
001967        zSrcDb = Tcl_GetString(objv[2]);
001968        zDestFile = Tcl_GetString(objv[3]);
001969      }else{
001970        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
001971        return TCL_ERROR;
001972      }
001973      rc = sqlite3_open_v2(zDestFile, &pDest,
001974                 SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE| pDb->openFlags, 0);
001975      if( rc!=SQLITE_OK ){
001976        Tcl_AppendResult(interp, "cannot open target database: ",
001977             sqlite3_errmsg(pDest), (char*)0);
001978        sqlite3_close(pDest);
001979        return TCL_ERROR;
001980      }
001981      pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
001982      if( pBackup==0 ){
001983        Tcl_AppendResult(interp, "backup failed: ",
001984             sqlite3_errmsg(pDest), (char*)0);
001985        sqlite3_close(pDest);
001986        return TCL_ERROR;
001987      }
001988      while(  (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
001989      sqlite3_backup_finish(pBackup);
001990      if( rc==SQLITE_DONE ){
001991        rc = TCL_OK;
001992      }else{
001993        Tcl_AppendResult(interp, "backup failed: ",
001994             sqlite3_errmsg(pDest), (char*)0);
001995        rc = TCL_ERROR;
001996      }
001997      sqlite3_close(pDest);
001998      break;
001999    }
002000  
002001    /*    $db busy ?CALLBACK?
002002    **
002003    ** Invoke the given callback if an SQL statement attempts to open
002004    ** a locked database file.
002005    */
002006    case DB_BUSY: {
002007      if( objc>3 ){
002008        Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
002009        return TCL_ERROR;
002010      }else if( objc==2 ){
002011        if( pDb->zBusy ){
002012          Tcl_AppendResult(interp, pDb->zBusy, (char*)0);
002013        }
002014      }else{
002015        char *zBusy;
002016        int len;
002017        if( pDb->zBusy ){
002018          Tcl_Free(pDb->zBusy);
002019        }
002020        zBusy = Tcl_GetStringFromObj(objv[2], &len);
002021        if( zBusy && len>0 ){
002022          pDb->zBusy = Tcl_Alloc( len + 1 );
002023          memcpy(pDb->zBusy, zBusy, len+1);
002024        }else{
002025          pDb->zBusy = 0;
002026        }
002027        if( pDb->zBusy ){
002028          pDb->interp = interp;
002029          sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
002030        }else{
002031          sqlite3_busy_handler(pDb->db, 0, 0);
002032        }
002033      }
002034      break;
002035    }
002036  
002037    /*     $db cache flush
002038    **     $db cache size n
002039    **
002040    ** Flush the prepared statement cache, or set the maximum number of
002041    ** cached statements.
002042    */
002043    case DB_CACHE: {
002044      char *subCmd;
002045      int n;
002046  
002047      if( objc<=2 ){
002048        Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
002049        return TCL_ERROR;
002050      }
002051      subCmd = Tcl_GetStringFromObj( objv[2], 0 );
002052      if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
002053        if( objc!=3 ){
002054          Tcl_WrongNumArgs(interp, 2, objv, "flush");
002055          return TCL_ERROR;
002056        }else{
002057          flushStmtCache( pDb );
002058        }
002059      }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
002060        if( objc!=4 ){
002061          Tcl_WrongNumArgs(interp, 2, objv, "size n");
002062          return TCL_ERROR;
002063        }else{
002064          if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
002065            Tcl_AppendResult( interp, "cannot convert \"",
002066                 Tcl_GetStringFromObj(objv[3],0), "\" to integer", (char*)0);
002067            return TCL_ERROR;
002068          }else{
002069            if( n<0 ){
002070              flushStmtCache( pDb );
002071              n = 0;
002072            }else if( n>MAX_PREPARED_STMTS ){
002073              n = MAX_PREPARED_STMTS;
002074            }
002075            pDb->maxStmt = n;
002076          }
002077        }
002078      }else{
002079        Tcl_AppendResult( interp, "bad option \"",
002080            Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size",
002081            (char*)0);
002082        return TCL_ERROR;
002083      }
002084      break;
002085    }
002086  
002087    /*     $db changes
002088    **
002089    ** Return the number of rows that were modified, inserted, or deleted by
002090    ** the most recent INSERT, UPDATE or DELETE statement, not including
002091    ** any changes made by trigger programs.
002092    */
002093    case DB_CHANGES: {
002094      Tcl_Obj *pResult;
002095      if( objc!=2 ){
002096        Tcl_WrongNumArgs(interp, 2, objv, "");
002097        return TCL_ERROR;
002098      }
002099      pResult = Tcl_GetObjResult(interp);
002100      Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
002101      break;
002102    }
002103  
002104    /*    $db close
002105    **
002106    ** Shutdown the database
002107    */
002108    case DB_CLOSE: {
002109      Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
002110      break;
002111    }
002112  
002113    /*
002114    **     $db collate NAME SCRIPT
002115    **
002116    ** Create a new SQL collation function called NAME.  Whenever
002117    ** that function is called, invoke SCRIPT to evaluate the function.
002118    */
002119    case DB_COLLATE: {
002120      SqlCollate *pCollate;
002121      char *zName;
002122      char *zScript;
002123      int nScript;
002124      if( objc!=4 ){
002125        Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
002126        return TCL_ERROR;
002127      }
002128      zName = Tcl_GetStringFromObj(objv[2], 0);
002129      zScript = Tcl_GetStringFromObj(objv[3], &nScript);
002130      pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
002131      if( pCollate==0 ) return TCL_ERROR;
002132      pCollate->interp = interp;
002133      pCollate->pNext = pDb->pCollate;
002134      pCollate->zScript = (char*)&pCollate[1];
002135      pDb->pCollate = pCollate;
002136      memcpy(pCollate->zScript, zScript, nScript+1);
002137      if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
002138          pCollate, tclSqlCollate) ){
002139        Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
002140        return TCL_ERROR;
002141      }
002142      break;
002143    }
002144  
002145    /*
002146    **     $db collation_needed SCRIPT
002147    **
002148    ** Create a new SQL collation function called NAME.  Whenever
002149    ** that function is called, invoke SCRIPT to evaluate the function.
002150    */
002151    case DB_COLLATION_NEEDED: {
002152      if( objc!=3 ){
002153        Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
002154        return TCL_ERROR;
002155      }
002156      if( pDb->pCollateNeeded ){
002157        Tcl_DecrRefCount(pDb->pCollateNeeded);
002158      }
002159      pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
002160      Tcl_IncrRefCount(pDb->pCollateNeeded);
002161      sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
002162      break;
002163    }
002164  
002165    /*    $db commit_hook ?CALLBACK?
002166    **
002167    ** Invoke the given callback just before committing every SQL transaction.
002168    ** If the callback throws an exception or returns non-zero, then the
002169    ** transaction is aborted.  If CALLBACK is an empty string, the callback
002170    ** is disabled.
002171    */
002172    case DB_COMMIT_HOOK: {
002173      if( objc>3 ){
002174        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
002175        return TCL_ERROR;
002176      }else if( objc==2 ){
002177        if( pDb->zCommit ){
002178          Tcl_AppendResult(interp, pDb->zCommit, (char*)0);
002179        }
002180      }else{
002181        const char *zCommit;
002182        int len;
002183        if( pDb->zCommit ){
002184          Tcl_Free(pDb->zCommit);
002185        }
002186        zCommit = Tcl_GetStringFromObj(objv[2], &len);
002187        if( zCommit && len>0 ){
002188          pDb->zCommit = Tcl_Alloc( len + 1 );
002189          memcpy(pDb->zCommit, zCommit, len+1);
002190        }else{
002191          pDb->zCommit = 0;
002192        }
002193        if( pDb->zCommit ){
002194          pDb->interp = interp;
002195          sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
002196        }else{
002197          sqlite3_commit_hook(pDb->db, 0, 0);
002198        }
002199      }
002200      break;
002201    }
002202  
002203    /*    $db complete SQL
002204    **
002205    ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
002206    ** additional lines of input are needed.  This is similar to the
002207    ** built-in "info complete" command of Tcl.
002208    */
002209    case DB_COMPLETE: {
002210  #ifndef SQLITE_OMIT_COMPLETE
002211      Tcl_Obj *pResult;
002212      int isComplete;
002213      if( objc!=3 ){
002214        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
002215        return TCL_ERROR;
002216      }
002217      isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
002218      pResult = Tcl_GetObjResult(interp);
002219      Tcl_SetBooleanObj(pResult, isComplete);
002220  #endif
002221      break;
002222    }
002223  
002224    /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
002225    **
002226    ** Copy data into table from filename, optionally using SEPARATOR
002227    ** as column separators.  If a column contains a null string, or the
002228    ** value of NULLINDICATOR, a NULL is inserted for the column.
002229    ** conflict-algorithm is one of the sqlite conflict algorithms:
002230    **    rollback, abort, fail, ignore, replace
002231    ** On success, return the number of lines processed, not necessarily same
002232    ** as 'db changes' due to conflict-algorithm selected.
002233    **
002234    ** This code is basically an implementation/enhancement of
002235    ** the sqlite3 shell.c ".import" command.
002236    **
002237    ** This command usage is equivalent to the sqlite2.x COPY statement,
002238    ** which imports file data into a table using the PostgreSQL COPY file format:
002239    **   $db copy $conflit_algo $table_name $filename \t \\N
002240    */
002241    case DB_COPY: {
002242      char *zTable;               /* Insert data into this table */
002243      char *zFile;                /* The file from which to extract data */
002244      char *zConflict;            /* The conflict algorithm to use */
002245      sqlite3_stmt *pStmt;        /* A statement */
002246      int nCol;                   /* Number of columns in the table */
002247      int nByte;                  /* Number of bytes in an SQL string */
002248      int i, j;                   /* Loop counters */
002249      int nSep;                   /* Number of bytes in zSep[] */
002250      int nNull;                  /* Number of bytes in zNull[] */
002251      char *zSql;                 /* An SQL statement */
002252      char *zLine;                /* A single line of input from the file */
002253      char **azCol;               /* zLine[] broken up into columns */
002254      const char *zCommit;        /* How to commit changes */
002255      FILE *in;                   /* The input file */
002256      int lineno = 0;             /* Line number of input file */
002257      char zLineNum[80];          /* Line number print buffer */
002258      Tcl_Obj *pResult;           /* interp result */
002259  
002260      const char *zSep;
002261      const char *zNull;
002262      if( objc<5 || objc>7 ){
002263        Tcl_WrongNumArgs(interp, 2, objv,
002264           "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
002265        return TCL_ERROR;
002266      }
002267      if( objc>=6 ){
002268        zSep = Tcl_GetStringFromObj(objv[5], 0);
002269      }else{
002270        zSep = "\t";
002271      }
002272      if( objc>=7 ){
002273        zNull = Tcl_GetStringFromObj(objv[6], 0);
002274      }else{
002275        zNull = "";
002276      }
002277      zConflict = Tcl_GetStringFromObj(objv[2], 0);
002278      zTable = Tcl_GetStringFromObj(objv[3], 0);
002279      zFile = Tcl_GetStringFromObj(objv[4], 0);
002280      nSep = strlen30(zSep);
002281      nNull = strlen30(zNull);
002282      if( nSep==0 ){
002283        Tcl_AppendResult(interp,"Error: non-null separator required for copy",
002284                         (char*)0);
002285        return TCL_ERROR;
002286      }
002287      if(strcmp(zConflict, "rollback") != 0 &&
002288         strcmp(zConflict, "abort"   ) != 0 &&
002289         strcmp(zConflict, "fail"    ) != 0 &&
002290         strcmp(zConflict, "ignore"  ) != 0 &&
002291         strcmp(zConflict, "replace" ) != 0 ) {
002292        Tcl_AppendResult(interp, "Error: \"", zConflict,
002293              "\", conflict-algorithm must be one of: rollback, "
002294              "abort, fail, ignore, or replace", (char*)0);
002295        return TCL_ERROR;
002296      }
002297      zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
002298      if( zSql==0 ){
002299        Tcl_AppendResult(interp, "Error: no such table: ", zTable, (char*)0);
002300        return TCL_ERROR;
002301      }
002302      nByte = strlen30(zSql);
002303      rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
002304      sqlite3_free(zSql);
002305      if( rc ){
002306        Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
002307        nCol = 0;
002308      }else{
002309        nCol = sqlite3_column_count(pStmt);
002310      }
002311      sqlite3_finalize(pStmt);
002312      if( nCol==0 ) {
002313        return TCL_ERROR;
002314      }
002315      zSql = malloc( nByte + 50 + nCol*2 );
002316      if( zSql==0 ) {
002317        Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
002318        return TCL_ERROR;
002319      }
002320      sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
002321           zConflict, zTable);
002322      j = strlen30(zSql);
002323      for(i=1; i<nCol; i++){
002324        zSql[j++] = ',';
002325        zSql[j++] = '?';
002326      }
002327      zSql[j++] = ')';
002328      zSql[j] = 0;
002329      rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
002330      free(zSql);
002331      if( rc ){
002332        Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
002333        sqlite3_finalize(pStmt);
002334        return TCL_ERROR;
002335      }
002336      in = fopen(zFile, "rb");
002337      if( in==0 ){
002338        Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0);
002339        sqlite3_finalize(pStmt);
002340        return TCL_ERROR;
002341      }
002342      azCol = malloc( sizeof(azCol[0])*(nCol+1) );
002343      if( azCol==0 ) {
002344        Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
002345        fclose(in);
002346        return TCL_ERROR;
002347      }
002348      (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
002349      zCommit = "COMMIT";
002350      while( (zLine = local_getline(0, in))!=0 ){
002351        char *z;
002352        lineno++;
002353        azCol[0] = zLine;
002354        for(i=0, z=zLine; *z; z++){
002355          if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
002356            *z = 0;
002357            i++;
002358            if( i<nCol ){
002359              azCol[i] = &z[nSep];
002360              z += nSep-1;
002361            }
002362          }
002363        }
002364        if( i+1!=nCol ){
002365          char *zErr;
002366          int nErr = strlen30(zFile) + 200;
002367          zErr = malloc(nErr);
002368          if( zErr ){
002369            sqlite3_snprintf(nErr, zErr,
002370               "Error: %s line %d: expected %d columns of data but found %d",
002371               zFile, lineno, nCol, i+1);
002372            Tcl_AppendResult(interp, zErr, (char*)0);
002373            free(zErr);
002374          }
002375          zCommit = "ROLLBACK";
002376          break;
002377        }
002378        for(i=0; i<nCol; i++){
002379          /* check for null data, if so, bind as null */
002380          if( (nNull>0 && strcmp(azCol[i], zNull)==0)
002381            || strlen30(azCol[i])==0
002382          ){
002383            sqlite3_bind_null(pStmt, i+1);
002384          }else{
002385            sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
002386          }
002387        }
002388        sqlite3_step(pStmt);
002389        rc = sqlite3_reset(pStmt);
002390        free(zLine);
002391        if( rc!=SQLITE_OK ){
002392          Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0);
002393          zCommit = "ROLLBACK";
002394          break;
002395        }
002396      }
002397      free(azCol);
002398      fclose(in);
002399      sqlite3_finalize(pStmt);
002400      (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
002401  
002402      if( zCommit[0] == 'C' ){
002403        /* success, set result as number of lines processed */
002404        pResult = Tcl_GetObjResult(interp);
002405        Tcl_SetIntObj(pResult, lineno);
002406        rc = TCL_OK;
002407      }else{
002408        /* failure, append lineno where failed */
002409        sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
002410        Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,
002411                         (char*)0);
002412        rc = TCL_ERROR;
002413      }
002414      break;
002415    }
002416  
002417    /*
002418    **     $db deserialize ?DATABASE? VALUE
002419    **
002420    ** Reopen DATABASE (default "main") using the content in $VALUE
002421    */
002422    case DB_DESERIALIZE: {
002423  #ifndef SQLITE_ENABLE_DESERIALIZE
002424      Tcl_AppendResult(interp, "MEMDB not available in this build",
002425                       (char*)0);
002426      rc = TCL_ERROR;
002427  #else
002428      const char *zSchema;
002429      Tcl_Obj *pValue;
002430      unsigned char *pBA;
002431      unsigned char *pData;
002432      int len, xrc;
002433      
002434      if( objc==3 ){
002435        zSchema = 0;
002436        pValue = objv[2];
002437      }else if( objc==4 ){
002438        zSchema = Tcl_GetString(objv[2]);
002439        pValue = objv[3];
002440      }else{
002441        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? VALUE");
002442        rc = TCL_ERROR;
002443        break;
002444      }
002445      pBA = Tcl_GetByteArrayFromObj(pValue, &len);
002446      pData = sqlite3_malloc64( len );
002447      if( pData==0 && len>0 ){
002448        Tcl_AppendResult(interp, "out of memory", (char*)0);
002449        rc = TCL_ERROR;
002450      }else{
002451        if( len>0 ) memcpy(pData, pBA, len);
002452        xrc = sqlite3_deserialize(pDb->db, zSchema, pData, len, len,
002453                  SQLITE_DESERIALIZE_FREEONCLOSE |
002454                  SQLITE_DESERIALIZE_RESIZEABLE);
002455        if( xrc ){
002456          Tcl_AppendResult(interp, "unable to set MEMDB content", (char*)0);
002457          rc = TCL_ERROR;
002458        }
002459      }
002460  #endif
002461      break; 
002462    }
002463  
002464    /*
002465    **    $db enable_load_extension BOOLEAN
002466    **
002467    ** Turn the extension loading feature on or off.  It if off by
002468    ** default.
002469    */
002470    case DB_ENABLE_LOAD_EXTENSION: {
002471  #ifndef SQLITE_OMIT_LOAD_EXTENSION
002472      int onoff;
002473      if( objc!=3 ){
002474        Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
002475        return TCL_ERROR;
002476      }
002477      if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
002478        return TCL_ERROR;
002479      }
002480      sqlite3_enable_load_extension(pDb->db, onoff);
002481      break;
002482  #else
002483      Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
002484                       (char*)0);
002485      return TCL_ERROR;
002486  #endif
002487    }
002488  
002489    /*
002490    **    $db errorcode
002491    **
002492    ** Return the numeric error code that was returned by the most recent
002493    ** call to sqlite3_exec().
002494    */
002495    case DB_ERRORCODE: {
002496      Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
002497      break;
002498    }
002499  
002500    /*
002501    **    $db exists $sql
002502    **    $db onecolumn $sql
002503    **
002504    ** The onecolumn method is the equivalent of:
002505    **     lindex [$db eval $sql] 0
002506    */
002507    case DB_EXISTS:
002508    case DB_ONECOLUMN: {
002509      Tcl_Obj *pResult = 0;
002510      DbEvalContext sEval;
002511      if( objc!=3 ){
002512        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
002513        return TCL_ERROR;
002514      }
002515  
002516      dbEvalInit(&sEval, pDb, objv[2], 0, 0);
002517      rc = dbEvalStep(&sEval);
002518      if( choice==DB_ONECOLUMN ){
002519        if( rc==TCL_OK ){
002520          pResult = dbEvalColumnValue(&sEval, 0);
002521        }else if( rc==TCL_BREAK ){
002522          Tcl_ResetResult(interp);
002523        }
002524      }else if( rc==TCL_BREAK || rc==TCL_OK ){
002525        pResult = Tcl_NewBooleanObj(rc==TCL_OK);
002526      }
002527      dbEvalFinalize(&sEval);
002528      if( pResult ) Tcl_SetObjResult(interp, pResult);
002529  
002530      if( rc==TCL_BREAK ){
002531        rc = TCL_OK;
002532      }
002533      break;
002534    }
002535  
002536    /*
002537    **    $db eval ?options? $sql ?array? ?{  ...code... }?
002538    **
002539    ** The SQL statement in $sql is evaluated.  For each row, the values are
002540    ** placed in elements of the array named "array" and ...code... is executed.
002541    ** If "array" and "code" are omitted, then no callback is every invoked.
002542    ** If "array" is an empty string, then the values are placed in variables
002543    ** that have the same name as the fields extracted by the query.
002544    */
002545    case DB_EVAL: {
002546      int evalFlags = 0;
002547      const char *zOpt;
002548      while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
002549        if( strcmp(zOpt, "-withoutnulls")==0 ){
002550          evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
002551        }
002552        else{
002553          Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
002554          return TCL_ERROR;
002555        }
002556        objc--;
002557        objv++;
002558      }
002559      if( objc<3 || objc>5 ){
002560        Tcl_WrongNumArgs(interp, 2, objv, 
002561            "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
002562        return TCL_ERROR;
002563      }
002564  
002565      if( objc==3 ){
002566        DbEvalContext sEval;
002567        Tcl_Obj *pRet = Tcl_NewObj();
002568        Tcl_IncrRefCount(pRet);
002569        dbEvalInit(&sEval, pDb, objv[2], 0, 0);
002570        while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
002571          int i;
002572          int nCol;
002573          dbEvalRowInfo(&sEval, &nCol, 0);
002574          for(i=0; i<nCol; i++){
002575            Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
002576          }
002577        }
002578        dbEvalFinalize(&sEval);
002579        if( rc==TCL_BREAK ){
002580          Tcl_SetObjResult(interp, pRet);
002581          rc = TCL_OK;
002582        }
002583        Tcl_DecrRefCount(pRet);
002584      }else{
002585        ClientData cd2[2];
002586        DbEvalContext *p;
002587        Tcl_Obj *pArray = 0;
002588        Tcl_Obj *pScript;
002589  
002590        if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
002591          pArray = objv[3];
002592        }
002593        pScript = objv[objc-1];
002594        Tcl_IncrRefCount(pScript);
002595  
002596        p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
002597        dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
002598  
002599        cd2[0] = (void *)p;
002600        cd2[1] = (void *)pScript;
002601        rc = DbEvalNextCmd(cd2, interp, TCL_OK);
002602      }
002603      break;
002604    }
002605  
002606    /*
002607    **     $db function NAME [-argcount N] [-deterministic] SCRIPT
002608    **
002609    ** Create a new SQL function called NAME.  Whenever that function is
002610    ** called, invoke SCRIPT to evaluate the function.
002611    */
002612    case DB_FUNCTION: {
002613      int flags = SQLITE_UTF8;
002614      SqlFunc *pFunc;
002615      Tcl_Obj *pScript;
002616      char *zName;
002617      int nArg = -1;
002618      int i;
002619      if( objc<4 ){
002620        Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
002621        return TCL_ERROR;
002622      }
002623      for(i=3; i<(objc-1); i++){
002624        const char *z = Tcl_GetString(objv[i]);
002625        int n = strlen30(z);
002626        if( n>2 && strncmp(z, "-argcount",n)==0 ){
002627          if( i==(objc-2) ){
002628            Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
002629            return TCL_ERROR;
002630          }
002631          if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
002632          if( nArg<0 ){
002633            Tcl_AppendResult(interp, "number of arguments must be non-negative",
002634                             (char*)0);
002635            return TCL_ERROR;
002636          }
002637          i++;
002638        }else
002639        if( n>2 && strncmp(z, "-deterministic",n)==0 ){
002640          flags |= SQLITE_DETERMINISTIC;
002641        }else{
002642          Tcl_AppendResult(interp, "bad option \"", z,
002643              "\": must be -argcount or -deterministic", (char*)0
002644          );
002645          return TCL_ERROR;
002646        }
002647      }
002648  
002649      pScript = objv[objc-1];
002650      zName = Tcl_GetStringFromObj(objv[2], 0);
002651      pFunc = findSqlFunc(pDb, zName);
002652      if( pFunc==0 ) return TCL_ERROR;
002653      if( pFunc->pScript ){
002654        Tcl_DecrRefCount(pFunc->pScript);
002655      }
002656      pFunc->pScript = pScript;
002657      Tcl_IncrRefCount(pScript);
002658      pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
002659      rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
002660          pFunc, tclSqlFunc, 0, 0);
002661      if( rc!=SQLITE_OK ){
002662        rc = TCL_ERROR;
002663        Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
002664      }
002665      break;
002666    }
002667  
002668    /*
002669    **     $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
002670    */
002671    case DB_INCRBLOB: {
002672  #ifdef SQLITE_OMIT_INCRBLOB
002673      Tcl_AppendResult(interp, "incrblob not available in this build", (char*)0);
002674      return TCL_ERROR;
002675  #else
002676      int isReadonly = 0;
002677      const char *zDb = "main";
002678      const char *zTable;
002679      const char *zColumn;
002680      Tcl_WideInt iRow;
002681  
002682      /* Check for the -readonly option */
002683      if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
002684        isReadonly = 1;
002685      }
002686  
002687      if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
002688        Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
002689        return TCL_ERROR;
002690      }
002691  
002692      if( objc==(6+isReadonly) ){
002693        zDb = Tcl_GetString(objv[2]);
002694      }
002695      zTable = Tcl_GetString(objv[objc-3]);
002696      zColumn = Tcl_GetString(objv[objc-2]);
002697      rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
002698  
002699      if( rc==TCL_OK ){
002700        rc = createIncrblobChannel(
002701            interp, pDb, zDb, zTable, zColumn, (sqlite3_int64)iRow, isReadonly
002702        );
002703      }
002704  #endif
002705      break;
002706    }
002707  
002708    /*
002709    **     $db interrupt
002710    **
002711    ** Interrupt the execution of the inner-most SQL interpreter.  This
002712    ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
002713    */
002714    case DB_INTERRUPT: {
002715      sqlite3_interrupt(pDb->db);
002716      break;
002717    }
002718  
002719    /*
002720    **     $db nullvalue ?STRING?
002721    **
002722    ** Change text used when a NULL comes back from the database. If ?STRING?
002723    ** is not present, then the current string used for NULL is returned.
002724    ** If STRING is present, then STRING is returned.
002725    **
002726    */
002727    case DB_NULLVALUE: {
002728      if( objc!=2 && objc!=3 ){
002729        Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
002730        return TCL_ERROR;
002731      }
002732      if( objc==3 ){
002733        int len;
002734        char *zNull = Tcl_GetStringFromObj(objv[2], &len);
002735        if( pDb->zNull ){
002736          Tcl_Free(pDb->zNull);
002737        }
002738        if( zNull && len>0 ){
002739          pDb->zNull = Tcl_Alloc( len + 1 );
002740          memcpy(pDb->zNull, zNull, len);
002741          pDb->zNull[len] = '\0';
002742        }else{
002743          pDb->zNull = 0;
002744        }
002745      }
002746      Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
002747      break;
002748    }
002749  
002750    /*
002751    **     $db last_insert_rowid
002752    **
002753    ** Return an integer which is the ROWID for the most recent insert.
002754    */
002755    case DB_LAST_INSERT_ROWID: {
002756      Tcl_Obj *pResult;
002757      Tcl_WideInt rowid;
002758      if( objc!=2 ){
002759        Tcl_WrongNumArgs(interp, 2, objv, "");
002760        return TCL_ERROR;
002761      }
002762      rowid = sqlite3_last_insert_rowid(pDb->db);
002763      pResult = Tcl_GetObjResult(interp);
002764      Tcl_SetWideIntObj(pResult, rowid);
002765      break;
002766    }
002767  
002768    /*
002769    ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
002770    */
002771  
002772    /*    $db progress ?N CALLBACK?
002773    **
002774    ** Invoke the given callback every N virtual machine opcodes while executing
002775    ** queries.
002776    */
002777    case DB_PROGRESS: {
002778      if( objc==2 ){
002779        if( pDb->zProgress ){
002780          Tcl_AppendResult(interp, pDb->zProgress, (char*)0);
002781        }
002782      }else if( objc==4 ){
002783        char *zProgress;
002784        int len;
002785        int N;
002786        if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
002787          return TCL_ERROR;
002788        };
002789        if( pDb->zProgress ){
002790          Tcl_Free(pDb->zProgress);
002791        }
002792        zProgress = Tcl_GetStringFromObj(objv[3], &len);
002793        if( zProgress && len>0 ){
002794          pDb->zProgress = Tcl_Alloc( len + 1 );
002795          memcpy(pDb->zProgress, zProgress, len+1);
002796        }else{
002797          pDb->zProgress = 0;
002798        }
002799  #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
002800        if( pDb->zProgress ){
002801          pDb->interp = interp;
002802          sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
002803        }else{
002804          sqlite3_progress_handler(pDb->db, 0, 0, 0);
002805        }
002806  #endif
002807      }else{
002808        Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
002809        return TCL_ERROR;
002810      }
002811      break;
002812    }
002813  
002814    /*    $db profile ?CALLBACK?
002815    **
002816    ** Make arrangements to invoke the CALLBACK routine after each SQL statement
002817    ** that has run.  The text of the SQL and the amount of elapse time are
002818    ** appended to CALLBACK before the script is run.
002819    */
002820    case DB_PROFILE: {
002821      if( objc>3 ){
002822        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
002823        return TCL_ERROR;
002824      }else if( objc==2 ){
002825        if( pDb->zProfile ){
002826          Tcl_AppendResult(interp, pDb->zProfile, (char*)0);
002827        }
002828      }else{
002829        char *zProfile;
002830        int len;
002831        if( pDb->zProfile ){
002832          Tcl_Free(pDb->zProfile);
002833        }
002834        zProfile = Tcl_GetStringFromObj(objv[2], &len);
002835        if( zProfile && len>0 ){
002836          pDb->zProfile = Tcl_Alloc( len + 1 );
002837          memcpy(pDb->zProfile, zProfile, len+1);
002838        }else{
002839          pDb->zProfile = 0;
002840        }
002841  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
002842      !defined(SQLITE_OMIT_DEPRECATED)
002843        if( pDb->zProfile ){
002844          pDb->interp = interp;
002845          sqlite3_profile(pDb->db, DbProfileHandler, pDb);
002846        }else{
002847          sqlite3_profile(pDb->db, 0, 0);
002848        }
002849  #endif
002850      }
002851      break;
002852    }
002853  
002854    /*
002855    **     $db rekey KEY
002856    **
002857    ** Change the encryption key on the currently open database.
002858    */
002859    case DB_REKEY: {
002860  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
002861      int nKey;
002862      void *pKey;
002863  #endif
002864      if( objc!=3 ){
002865        Tcl_WrongNumArgs(interp, 2, objv, "KEY");
002866        return TCL_ERROR;
002867      }
002868  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
002869      pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
002870      rc = sqlite3_rekey(pDb->db, pKey, nKey);
002871      if( rc ){
002872        Tcl_AppendResult(interp, sqlite3_errstr(rc), (char*)0);
002873        rc = TCL_ERROR;
002874      }
002875  #endif
002876      break;
002877    }
002878  
002879    /*    $db restore ?DATABASE? FILENAME
002880    **
002881    ** Open a database file named FILENAME.  Transfer the content
002882    ** of FILENAME into the local database DATABASE (default: "main").
002883    */
002884    case DB_RESTORE: {
002885      const char *zSrcFile;
002886      const char *zDestDb;
002887      sqlite3 *pSrc;
002888      sqlite3_backup *pBackup;
002889      int nTimeout = 0;
002890  
002891      if( objc==3 ){
002892        zDestDb = "main";
002893        zSrcFile = Tcl_GetString(objv[2]);
002894      }else if( objc==4 ){
002895        zDestDb = Tcl_GetString(objv[2]);
002896        zSrcFile = Tcl_GetString(objv[3]);
002897      }else{
002898        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
002899        return TCL_ERROR;
002900      }
002901      rc = sqlite3_open_v2(zSrcFile, &pSrc,
002902                           SQLITE_OPEN_READONLY | pDb->openFlags, 0);
002903      if( rc!=SQLITE_OK ){
002904        Tcl_AppendResult(interp, "cannot open source database: ",
002905             sqlite3_errmsg(pSrc), (char*)0);
002906        sqlite3_close(pSrc);
002907        return TCL_ERROR;
002908      }
002909      pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
002910      if( pBackup==0 ){
002911        Tcl_AppendResult(interp, "restore failed: ",
002912             sqlite3_errmsg(pDb->db), (char*)0);
002913        sqlite3_close(pSrc);
002914        return TCL_ERROR;
002915      }
002916      while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
002917                || rc==SQLITE_BUSY ){
002918        if( rc==SQLITE_BUSY ){
002919          if( nTimeout++ >= 3 ) break;
002920          sqlite3_sleep(100);
002921        }
002922      }
002923      sqlite3_backup_finish(pBackup);
002924      if( rc==SQLITE_DONE ){
002925        rc = TCL_OK;
002926      }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
002927        Tcl_AppendResult(interp, "restore failed: source database busy",
002928                         (char*)0);
002929        rc = TCL_ERROR;
002930      }else{
002931        Tcl_AppendResult(interp, "restore failed: ",
002932             sqlite3_errmsg(pDb->db), (char*)0);
002933        rc = TCL_ERROR;
002934      }
002935      sqlite3_close(pSrc);
002936      break;
002937    }
002938  
002939    /*
002940    **     $db serialize ?DATABASE?
002941    **
002942    ** Return a serialization of a database.  
002943    */
002944    case DB_SERIALIZE: {
002945  #ifndef SQLITE_ENABLE_DESERIALIZE
002946      Tcl_AppendResult(interp, "MEMDB not available in this build",
002947                       (char*)0);
002948      rc = TCL_ERROR;
002949  #else
002950      const char *zSchema = objc>=3 ? Tcl_GetString(objv[2]) : "main";
002951      sqlite3_int64 sz = 0;
002952      unsigned char *pData;
002953      if( objc!=2 && objc!=3 ){
002954        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE?");
002955        rc = TCL_ERROR;
002956      }else{
002957        int needFree;
002958        pData = sqlite3_serialize(pDb->db, zSchema, &sz, SQLITE_SERIALIZE_NOCOPY);
002959        if( pData ){
002960          needFree = 0;
002961        }else{
002962          pData = sqlite3_serialize(pDb->db, zSchema, &sz, 0);
002963          needFree = 1;
002964        }
002965        Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(pData,sz));
002966        if( needFree ) sqlite3_free(pData);
002967      }
002968  #endif
002969      break;
002970    }
002971  
002972    /*
002973    **     $db status (step|sort|autoindex|vmstep)
002974    **
002975    ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
002976    ** SQLITE_STMTSTATUS_SORT for the most recent eval.
002977    */
002978    case DB_STATUS: {
002979      int v;
002980      const char *zOp;
002981      if( objc!=3 ){
002982        Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
002983        return TCL_ERROR;
002984      }
002985      zOp = Tcl_GetString(objv[2]);
002986      if( strcmp(zOp, "step")==0 ){
002987        v = pDb->nStep;
002988      }else if( strcmp(zOp, "sort")==0 ){
002989        v = pDb->nSort;
002990      }else if( strcmp(zOp, "autoindex")==0 ){
002991        v = pDb->nIndex;
002992      }else if( strcmp(zOp, "vmstep")==0 ){
002993        v = pDb->nVMStep;
002994      }else{
002995        Tcl_AppendResult(interp,
002996              "bad argument: should be autoindex, step, sort or vmstep",
002997              (char*)0);
002998        return TCL_ERROR;
002999      }
003000      Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
003001      break;
003002    }
003003  
003004    /*
003005    **     $db timeout MILLESECONDS
003006    **
003007    ** Delay for the number of milliseconds specified when a file is locked.
003008    */
003009    case DB_TIMEOUT: {
003010      int ms;
003011      if( objc!=3 ){
003012        Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
003013        return TCL_ERROR;
003014      }
003015      if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
003016      sqlite3_busy_timeout(pDb->db, ms);
003017      break;
003018    }
003019  
003020    /*
003021    **     $db total_changes
003022    **
003023    ** Return the number of rows that were modified, inserted, or deleted
003024    ** since the database handle was created.
003025    */
003026    case DB_TOTAL_CHANGES: {
003027      Tcl_Obj *pResult;
003028      if( objc!=2 ){
003029        Tcl_WrongNumArgs(interp, 2, objv, "");
003030        return TCL_ERROR;
003031      }
003032      pResult = Tcl_GetObjResult(interp);
003033      Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
003034      break;
003035    }
003036  
003037    /*    $db trace ?CALLBACK?
003038    **
003039    ** Make arrangements to invoke the CALLBACK routine for each SQL statement
003040    ** that is executed.  The text of the SQL is appended to CALLBACK before
003041    ** it is executed.
003042    */
003043    case DB_TRACE: {
003044      if( objc>3 ){
003045        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
003046        return TCL_ERROR;
003047      }else if( objc==2 ){
003048        if( pDb->zTrace ){
003049          Tcl_AppendResult(interp, pDb->zTrace, (char*)0);
003050        }
003051      }else{
003052        char *zTrace;
003053        int len;
003054        if( pDb->zTrace ){
003055          Tcl_Free(pDb->zTrace);
003056        }
003057        zTrace = Tcl_GetStringFromObj(objv[2], &len);
003058        if( zTrace && len>0 ){
003059          pDb->zTrace = Tcl_Alloc( len + 1 );
003060          memcpy(pDb->zTrace, zTrace, len+1);
003061        }else{
003062          pDb->zTrace = 0;
003063        }
003064  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
003065      !defined(SQLITE_OMIT_DEPRECATED)
003066        if( pDb->zTrace ){
003067          pDb->interp = interp;
003068          sqlite3_trace(pDb->db, DbTraceHandler, pDb);
003069        }else{
003070          sqlite3_trace(pDb->db, 0, 0);
003071        }
003072  #endif
003073      }
003074      break;
003075    }
003076  
003077    /*    $db trace_v2 ?CALLBACK? ?MASK?
003078    **
003079    ** Make arrangements to invoke the CALLBACK routine for each trace event
003080    ** matching the mask that is generated.  The parameters are appended to
003081    ** CALLBACK before it is executed.
003082    */
003083    case DB_TRACE_V2: {
003084      if( objc>4 ){
003085        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK? ?MASK?");
003086        return TCL_ERROR;
003087      }else if( objc==2 ){
003088        if( pDb->zTraceV2 ){
003089          Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
003090        }
003091      }else{
003092        char *zTraceV2;
003093        int len;
003094        Tcl_WideInt wMask = 0;
003095        if( objc==4 ){
003096          static const char *TTYPE_strs[] = {
003097            "statement", "profile", "row", "close", 0
003098          };
003099          enum TTYPE_enum {
003100            TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
003101          };
003102          int i;
003103          if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
003104            return TCL_ERROR;
003105          }
003106          for(i=0; i<len; i++){
003107            Tcl_Obj *pObj;
003108            int ttype;
003109            if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
003110              return TCL_ERROR;
003111            }
003112            if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
003113                                    0, &ttype)!=TCL_OK ){
003114              Tcl_WideInt wType;
003115              Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
003116              Tcl_IncrRefCount(pError);
003117              if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
003118                Tcl_DecrRefCount(pError);
003119                wMask |= wType;
003120              }else{
003121                Tcl_SetObjResult(interp, pError);
003122                Tcl_DecrRefCount(pError);
003123                return TCL_ERROR;
003124              }
003125            }else{
003126              switch( (enum TTYPE_enum)ttype ){
003127                case TTYPE_STMT:    wMask |= SQLITE_TRACE_STMT;    break;
003128                case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
003129                case TTYPE_ROW:     wMask |= SQLITE_TRACE_ROW;     break;
003130                case TTYPE_CLOSE:   wMask |= SQLITE_TRACE_CLOSE;   break;
003131              }
003132            }
003133          }
003134        }else{
003135          wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
003136        }
003137        if( pDb->zTraceV2 ){
003138          Tcl_Free(pDb->zTraceV2);
003139        }
003140        zTraceV2 = Tcl_GetStringFromObj(objv[2], &len);
003141        if( zTraceV2 && len>0 ){
003142          pDb->zTraceV2 = Tcl_Alloc( len + 1 );
003143          memcpy(pDb->zTraceV2, zTraceV2, len+1);
003144        }else{
003145          pDb->zTraceV2 = 0;
003146        }
003147  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
003148        if( pDb->zTraceV2 ){
003149          pDb->interp = interp;
003150          sqlite3_trace_v2(pDb->db, (unsigned)wMask, DbTraceV2Handler, pDb);
003151        }else{
003152          sqlite3_trace_v2(pDb->db, 0, 0, 0);
003153        }
003154  #endif
003155      }
003156      break;
003157    }
003158  
003159    /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
003160    **
003161    ** Start a new transaction (if we are not already in the midst of a
003162    ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
003163    ** completes, either commit the transaction or roll it back if SCRIPT
003164    ** throws an exception.  Or if no new transation was started, do nothing.
003165    ** pass the exception on up the stack.
003166    **
003167    ** This command was inspired by Dave Thomas's talk on Ruby at the
003168    ** 2005 O'Reilly Open Source Convention (OSCON).
003169    */
003170    case DB_TRANSACTION: {
003171      Tcl_Obj *pScript;
003172      const char *zBegin = "SAVEPOINT _tcl_transaction";
003173      if( objc!=3 && objc!=4 ){
003174        Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
003175        return TCL_ERROR;
003176      }
003177  
003178      if( pDb->nTransaction==0 && objc==4 ){
003179        static const char *TTYPE_strs[] = {
003180          "deferred",   "exclusive",  "immediate", 0
003181        };
003182        enum TTYPE_enum {
003183          TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
003184        };
003185        int ttype;
003186        if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
003187                                0, &ttype) ){
003188          return TCL_ERROR;
003189        }
003190        switch( (enum TTYPE_enum)ttype ){
003191          case TTYPE_DEFERRED:    /* no-op */;                 break;
003192          case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
003193          case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
003194        }
003195      }
003196      pScript = objv[objc-1];
003197  
003198      /* Run the SQLite BEGIN command to open a transaction or savepoint. */
003199      pDb->disableAuth++;
003200      rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
003201      pDb->disableAuth--;
003202      if( rc!=SQLITE_OK ){
003203        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
003204        return TCL_ERROR;
003205      }
003206      pDb->nTransaction++;
003207  
003208      /* If using NRE, schedule a callback to invoke the script pScript, then
003209      ** a second callback to commit (or rollback) the transaction or savepoint
003210      ** opened above. If not using NRE, evaluate the script directly, then
003211      ** call function DbTransPostCmd() to commit (or rollback) the transaction
003212      ** or savepoint.  */
003213      if( DbUseNre() ){
003214        Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
003215        (void)Tcl_NREvalObj(interp, pScript, 0);
003216      }else{
003217        rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
003218      }
003219      break;
003220    }
003221  
003222    /*
003223    **    $db unlock_notify ?script?
003224    */
003225    case DB_UNLOCK_NOTIFY: {
003226  #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
003227      Tcl_AppendResult(interp, "unlock_notify not available in this build",
003228                       (char*)0);
003229      rc = TCL_ERROR;
003230  #else
003231      if( objc!=2 && objc!=3 ){
003232        Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
003233        rc = TCL_ERROR;
003234      }else{
003235        void (*xNotify)(void **, int) = 0;
003236        void *pNotifyArg = 0;
003237  
003238        if( pDb->pUnlockNotify ){
003239          Tcl_DecrRefCount(pDb->pUnlockNotify);
003240          pDb->pUnlockNotify = 0;
003241        }
003242  
003243        if( objc==3 ){
003244          xNotify = DbUnlockNotify;
003245          pNotifyArg = (void *)pDb;
003246          pDb->pUnlockNotify = objv[2];
003247          Tcl_IncrRefCount(pDb->pUnlockNotify);
003248        }
003249  
003250        if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
003251          Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
003252          rc = TCL_ERROR;
003253        }
003254      }
003255  #endif
003256      break;
003257    }
003258  
003259    /*
003260    **    $db preupdate_hook count
003261    **    $db preupdate_hook hook ?SCRIPT?
003262    **    $db preupdate_hook new INDEX
003263    **    $db preupdate_hook old INDEX
003264    */
003265    case DB_PREUPDATE: {
003266  #ifndef SQLITE_ENABLE_PREUPDATE_HOOK
003267      Tcl_AppendResult(interp, "preupdate_hook was omitted at compile-time", 
003268                       (char*)0);
003269      rc = TCL_ERROR;
003270  #else
003271      static const char *azSub[] = {"count", "depth", "hook", "new", "old", 0};
003272      enum DbPreupdateSubCmd {
003273        PRE_COUNT, PRE_DEPTH, PRE_HOOK, PRE_NEW, PRE_OLD
003274      };
003275      int iSub;
003276  
003277      if( objc<3 ){
003278        Tcl_WrongNumArgs(interp, 2, objv, "SUB-COMMAND ?ARGS?");
003279      }
003280      if( Tcl_GetIndexFromObj(interp, objv[2], azSub, "sub-command", 0, &iSub) ){
003281        return TCL_ERROR;
003282      }
003283  
003284      switch( (enum DbPreupdateSubCmd)iSub ){
003285        case PRE_COUNT: {
003286          int nCol = sqlite3_preupdate_count(pDb->db);
003287          Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
003288          break;
003289        }
003290  
003291        case PRE_HOOK: {
003292          if( objc>4 ){
003293            Tcl_WrongNumArgs(interp, 2, objv, "hook ?SCRIPT?");
003294            return TCL_ERROR;
003295          }
003296          DbHookCmd(interp, pDb, (objc==4 ? objv[3] : 0), &pDb->pPreUpdateHook);
003297          break;
003298        }
003299  
003300        case PRE_DEPTH: {
003301          Tcl_Obj *pRet;
003302          if( objc!=3 ){
003303            Tcl_WrongNumArgs(interp, 3, objv, "");
003304            return TCL_ERROR;
003305          }
003306          pRet = Tcl_NewIntObj(sqlite3_preupdate_depth(pDb->db));
003307          Tcl_SetObjResult(interp, pRet);
003308          break;
003309        }
003310  
003311        case PRE_NEW:
003312        case PRE_OLD: {
003313          int iIdx;
003314          sqlite3_value *pValue;
003315          if( objc!=4 ){
003316            Tcl_WrongNumArgs(interp, 3, objv, "INDEX");
003317            return TCL_ERROR;
003318          }
003319          if( Tcl_GetIntFromObj(interp, objv[3], &iIdx) ){
003320            return TCL_ERROR;
003321          }
003322  
003323          if( iSub==PRE_OLD ){
003324            rc = sqlite3_preupdate_old(pDb->db, iIdx, &pValue);
003325          }else{
003326            assert( iSub==PRE_NEW );
003327            rc = sqlite3_preupdate_new(pDb->db, iIdx, &pValue);
003328          }
003329  
003330          if( rc==SQLITE_OK ){
003331            Tcl_Obj *pObj;
003332            pObj = Tcl_NewStringObj((char*)sqlite3_value_text(pValue), -1);
003333            Tcl_SetObjResult(interp, pObj);
003334          }else{
003335            Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
003336            return TCL_ERROR;
003337          }
003338        }
003339      }
003340  #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
003341      break;
003342    }
003343  
003344    /*
003345    **    $db wal_hook ?script?
003346    **    $db update_hook ?script?
003347    **    $db rollback_hook ?script?
003348    */
003349    case DB_WAL_HOOK:
003350    case DB_UPDATE_HOOK:
003351    case DB_ROLLBACK_HOOK: {
003352      /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
003353      ** whether [$db update_hook] or [$db rollback_hook] was invoked.
003354      */
003355      Tcl_Obj **ppHook = 0;
003356      if( choice==DB_WAL_HOOK ) ppHook = &pDb->pWalHook;
003357      if( choice==DB_UPDATE_HOOK ) ppHook = &pDb->pUpdateHook;
003358      if( choice==DB_ROLLBACK_HOOK ) ppHook = &pDb->pRollbackHook;
003359      if( objc>3 ){
003360         Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
003361         return TCL_ERROR;
003362      }
003363  
003364      DbHookCmd(interp, pDb, (objc==3 ? objv[2] : 0), ppHook);
003365      break;
003366    }
003367  
003368    /*    $db version
003369    **
003370    ** Return the version string for this database.
003371    */
003372    case DB_VERSION: {
003373      int i;
003374      for(i=2; i<objc; i++){
003375        const char *zArg = Tcl_GetString(objv[i]);
003376        /* Optional arguments to $db version are used for testing purpose */
003377  #ifdef SQLITE_TEST
003378        /* $db version -use-legacy-prepare BOOLEAN
003379        **
003380        ** Turn the use of legacy sqlite3_prepare() on or off.
003381        */
003382        if( strcmp(zArg, "-use-legacy-prepare")==0 && i+1<objc ){
003383          i++;
003384          if( Tcl_GetBooleanFromObj(interp, objv[i], &pDb->bLegacyPrepare) ){
003385            return TCL_ERROR;
003386          }
003387        }else
003388  
003389        /* $db version -last-stmt-ptr
003390        **
003391        ** Return a string which is a hex encoding of the pointer to the
003392        ** most recent sqlite3_stmt in the statement cache.
003393        */
003394        if( strcmp(zArg, "-last-stmt-ptr")==0 ){
003395          char zBuf[100];
003396          sqlite3_snprintf(sizeof(zBuf), zBuf, "%p",
003397                           pDb->stmtList ? pDb->stmtList->pStmt: 0);
003398          Tcl_SetResult(interp, zBuf, TCL_VOLATILE);
003399        }else
003400  #endif /* SQLITE_TEST */
003401        {
003402          Tcl_AppendResult(interp, "unknown argument: ", zArg, (char*)0);
003403          return TCL_ERROR;
003404        }
003405      }
003406      if( i==2 ){   
003407        Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
003408      }
003409      break;
003410    }
003411  
003412  
003413    } /* End of the SWITCH statement */
003414    return rc;
003415  }
003416  
003417  #if SQLITE_TCL_NRE
003418  /*
003419  ** Adaptor that provides an objCmd interface to the NRE-enabled
003420  ** interface implementation.
003421  */
003422  static int SQLITE_TCLAPI DbObjCmdAdaptor(
003423    void *cd,
003424    Tcl_Interp *interp,
003425    int objc,
003426    Tcl_Obj *const*objv
003427  ){
003428    return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
003429  }
003430  #endif /* SQLITE_TCL_NRE */
003431  
003432  /*
003433  ** Issue the usage message when the "sqlite3" command arguments are
003434  ** incorrect.
003435  */
003436  static int sqliteCmdUsage(
003437    Tcl_Interp *interp,
003438    Tcl_Obj *const*objv
003439  ){
003440    Tcl_WrongNumArgs(interp, 1, objv,
003441      "HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
003442      " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
003443  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
003444      " ?-key CODECKEY?"
003445  #endif
003446    );
003447    return TCL_ERROR;
003448  }
003449  
003450  /*
003451  **   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
003452  **                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
003453  **
003454  ** This is the main Tcl command.  When the "sqlite" Tcl command is
003455  ** invoked, this routine runs to process that command.
003456  **
003457  ** The first argument, DBNAME, is an arbitrary name for a new
003458  ** database connection.  This command creates a new command named
003459  ** DBNAME that is used to control that connection.  The database
003460  ** connection is deleted when the DBNAME command is deleted.
003461  **
003462  ** The second argument is the name of the database file.
003463  **
003464  */
003465  static int SQLITE_TCLAPI DbMain(
003466    void *cd,
003467    Tcl_Interp *interp,
003468    int objc,
003469    Tcl_Obj *const*objv
003470  ){
003471    SqliteDb *p;
003472    const char *zArg;
003473    char *zErrMsg;
003474    int i;
003475    const char *zFile = 0;
003476    const char *zVfs = 0;
003477    int flags;
003478    Tcl_DString translatedFilename;
003479  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
003480    void *pKey = 0;
003481    int nKey = 0;
003482  #endif
003483    int rc;
003484  
003485    /* In normal use, each TCL interpreter runs in a single thread.  So
003486    ** by default, we can turn off mutexing on SQLite database connections.
003487    ** However, for testing purposes it is useful to have mutexes turned
003488    ** on.  So, by default, mutexes default off.  But if compiled with
003489    ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
003490    */
003491  #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
003492    flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
003493  #else
003494    flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
003495  #endif
003496  
003497    if( objc==2 ){
003498      zArg = Tcl_GetStringFromObj(objv[1], 0);
003499      if( strcmp(zArg,"-version")==0 ){
003500        Tcl_AppendResult(interp,sqlite3_libversion(), (char*)0);
003501        return TCL_OK;
003502      }
003503      if( strcmp(zArg,"-sourceid")==0 ){
003504        Tcl_AppendResult(interp,sqlite3_sourceid(), (char*)0);
003505        return TCL_OK;
003506      }
003507      if( strcmp(zArg,"-has-codec")==0 ){
003508  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
003509        Tcl_AppendResult(interp,"1",(char*)0);
003510  #else
003511        Tcl_AppendResult(interp,"0",(char*)0);
003512  #endif
003513        return TCL_OK;
003514      }
003515      if( zArg[0]=='-' ) return sqliteCmdUsage(interp, objv);
003516    }
003517    for(i=2; i<objc; i++){
003518      zArg = Tcl_GetString(objv[i]);
003519      if( zArg[0]!='-' ){
003520        if( zFile!=0 ) return sqliteCmdUsage(interp, objv);
003521        zFile = zArg;
003522        continue;
003523      }
003524      if( i==objc-1 ) return sqliteCmdUsage(interp, objv);
003525      i++;
003526      if( strcmp(zArg,"-key")==0 ){
003527  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
003528        pKey = Tcl_GetByteArrayFromObj(objv[i], &nKey);
003529  #endif
003530      }else if( strcmp(zArg, "-vfs")==0 ){
003531        zVfs = Tcl_GetString(objv[i]);
003532      }else if( strcmp(zArg, "-readonly")==0 ){
003533        int b;
003534        if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
003535        if( b ){
003536          flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
003537          flags |= SQLITE_OPEN_READONLY;
003538        }else{
003539          flags &= ~SQLITE_OPEN_READONLY;
003540          flags |= SQLITE_OPEN_READWRITE;
003541        }
003542      }else if( strcmp(zArg, "-create")==0 ){
003543        int b;
003544        if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
003545        if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
003546          flags |= SQLITE_OPEN_CREATE;
003547        }else{
003548          flags &= ~SQLITE_OPEN_CREATE;
003549        }
003550      }else if( strcmp(zArg, "-nomutex")==0 ){
003551        int b;
003552        if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
003553        if( b ){
003554          flags |= SQLITE_OPEN_NOMUTEX;
003555          flags &= ~SQLITE_OPEN_FULLMUTEX;
003556        }else{
003557          flags &= ~SQLITE_OPEN_NOMUTEX;
003558        }
003559      }else if( strcmp(zArg, "-fullmutex")==0 ){
003560        int b;
003561        if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
003562        if( b ){
003563          flags |= SQLITE_OPEN_FULLMUTEX;
003564          flags &= ~SQLITE_OPEN_NOMUTEX;
003565        }else{
003566          flags &= ~SQLITE_OPEN_FULLMUTEX;
003567        }
003568      }else if( strcmp(zArg, "-uri")==0 ){
003569        int b;
003570        if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
003571        if( b ){
003572          flags |= SQLITE_OPEN_URI;
003573        }else{
003574          flags &= ~SQLITE_OPEN_URI;
003575        }
003576      }else{
003577        Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
003578        return TCL_ERROR;
003579      }
003580    }
003581    zErrMsg = 0;
003582    p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
003583    memset(p, 0, sizeof(*p));
003584    if( zFile==0 ) zFile = "";
003585    zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
003586    rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
003587    Tcl_DStringFree(&translatedFilename);
003588    if( p->db ){
003589      if( SQLITE_OK!=sqlite3_errcode(p->db) ){
003590        zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
003591        sqlite3_close(p->db);
003592        p->db = 0;
003593      }
003594    }else{
003595      zErrMsg = sqlite3_mprintf("%s", sqlite3_errstr(rc));
003596    }
003597  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
003598    if( p->db ){
003599      sqlite3_key(p->db, pKey, nKey);
003600    }
003601  #endif
003602    if( p->db==0 ){
003603      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
003604      Tcl_Free((char*)p);
003605      sqlite3_free(zErrMsg);
003606      return TCL_ERROR;
003607    }
003608    p->maxStmt = NUM_PREPARED_STMTS;
003609    p->openFlags = flags & SQLITE_OPEN_URI;
003610    p->interp = interp;
003611    zArg = Tcl_GetStringFromObj(objv[1], 0);
003612    if( DbUseNre() ){
003613      Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
003614                          (char*)p, DbDeleteCmd);
003615    }else{
003616      Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
003617    }
003618    return TCL_OK;
003619  }
003620  
003621  /*
003622  ** Provide a dummy Tcl_InitStubs if we are using this as a static
003623  ** library.
003624  */
003625  #ifndef USE_TCL_STUBS
003626  # undef  Tcl_InitStubs
003627  # define Tcl_InitStubs(a,b,c) TCL_VERSION
003628  #endif
003629  
003630  /*
003631  ** Make sure we have a PACKAGE_VERSION macro defined.  This will be
003632  ** defined automatically by the TEA makefile.  But other makefiles
003633  ** do not define it.
003634  */
003635  #ifndef PACKAGE_VERSION
003636  # define PACKAGE_VERSION SQLITE_VERSION
003637  #endif
003638  
003639  /*
003640  ** Initialize this module.
003641  **
003642  ** This Tcl module contains only a single new Tcl command named "sqlite".
003643  ** (Hence there is no namespace.  There is no point in using a namespace
003644  ** if the extension only supplies one new name!)  The "sqlite" command is
003645  ** used to open a new SQLite database.  See the DbMain() routine above
003646  ** for additional information.
003647  **
003648  ** The EXTERN macros are required by TCL in order to work on windows.
003649  */
003650  EXTERN int Sqlite3_Init(Tcl_Interp *interp){
003651    int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR;
003652    if( rc==TCL_OK ){
003653      Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
003654  #ifndef SQLITE_3_SUFFIX_ONLY
003655      /* The "sqlite" alias is undocumented.  It is here only to support
003656      ** legacy scripts.  All new scripts should use only the "sqlite3"
003657      ** command. */
003658      Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
003659  #endif
003660      rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
003661    }
003662    return rc;
003663  }
003664  EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
003665  EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
003666  EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
003667  
003668  /* Because it accesses the file-system and uses persistent state, SQLite
003669  ** is not considered appropriate for safe interpreters.  Hence, we cause
003670  ** the _SafeInit() interfaces return TCL_ERROR.
003671  */
003672  EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; }
003673  EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;}
003674  
003675  
003676  
003677  #ifndef SQLITE_3_SUFFIX_ONLY
003678  int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
003679  int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
003680  int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
003681  int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
003682  #endif
003683  
003684  /*
003685  ** If the TCLSH macro is defined, add code to make a stand-alone program.
003686  */
003687  #if defined(TCLSH)
003688  
003689  /* This is the main routine for an ordinary TCL shell.  If there are
003690  ** are arguments, run the first argument as a script.  Otherwise,
003691  ** read TCL commands from standard input
003692  */
003693  static const char *tclsh_main_loop(void){
003694    static const char zMainloop[] =
003695      "if {[llength $argv]>=1} {\n"
003696        "set argv0 [lindex $argv 0]\n"
003697        "set argv [lrange $argv 1 end]\n"
003698        "source $argv0\n"
003699      "} else {\n"
003700        "set line {}\n"
003701        "while {![eof stdin]} {\n"
003702          "if {$line!=\"\"} {\n"
003703            "puts -nonewline \"> \"\n"
003704          "} else {\n"
003705            "puts -nonewline \"% \"\n"
003706          "}\n"
003707          "flush stdout\n"
003708          "append line [gets stdin]\n"
003709          "if {[info complete $line]} {\n"
003710            "if {[catch {uplevel #0 $line} result]} {\n"
003711              "puts stderr \"Error: $result\"\n"
003712            "} elseif {$result!=\"\"} {\n"
003713              "puts $result\n"
003714            "}\n"
003715            "set line {}\n"
003716          "} else {\n"
003717            "append line \\n\n"
003718          "}\n"
003719        "}\n"
003720      "}\n"
003721    ;
003722    return zMainloop;
003723  }
003724  
003725  #define TCLSH_MAIN main   /* Needed to fake out mktclapp */
003726  int SQLITE_CDECL TCLSH_MAIN(int argc, char **argv){
003727    Tcl_Interp *interp;
003728    int i;
003729    const char *zScript = 0;
003730    char zArgc[32];
003731  #if defined(TCLSH_INIT_PROC)
003732    extern const char *TCLSH_INIT_PROC(Tcl_Interp*);
003733  #endif
003734  
003735  #if !defined(_WIN32_WCE)
003736    if( getenv("BREAK") ){
003737      fprintf(stderr,
003738          "attach debugger to process %d and press any key to continue.\n",
003739          GETPID());
003740      fgetc(stdin);
003741    }
003742  #endif
003743  
003744    /* Call sqlite3_shutdown() once before doing anything else. This is to
003745    ** test that sqlite3_shutdown() can be safely called by a process before
003746    ** sqlite3_initialize() is. */
003747    sqlite3_shutdown();
003748  
003749    Tcl_FindExecutable(argv[0]);
003750    Tcl_SetSystemEncoding(NULL, "utf-8");
003751    interp = Tcl_CreateInterp();
003752    Sqlite3_Init(interp);
003753  
003754    sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-1);
003755    Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
003756    Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
003757    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
003758    for(i=1; i<argc; i++){
003759      Tcl_SetVar(interp, "argv", argv[i],
003760          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
003761    }
003762  #if defined(TCLSH_INIT_PROC)
003763    zScript = TCLSH_INIT_PROC(interp);
003764  #endif
003765    if( zScript==0 ){
003766      zScript = tclsh_main_loop();
003767    }
003768    if( Tcl_GlobalEval(interp, zScript)!=TCL_OK ){
003769      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
003770      if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
003771      fprintf(stderr,"%s: %s\n", *argv, zInfo);
003772      return 1;
003773    }
003774    return 0;
003775  }
003776  #endif /* TCLSH */