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