modernc.org/cc@v1.0.1/v2/testdata/_sqlite/src/tclsqlite.c (about)

     1  /*
     2  ** 2001 September 15
     3  **
     4  ** The author disclaims copyright to this source code.  In place of
     5  ** a legal notice, here is a blessing:
     6  **
     7  **    May you do good and not evil.
     8  **    May you find forgiveness for yourself and forgive others.
     9  **    May you share freely, never taking more than you give.
    10  **
    11  *************************************************************************
    12  ** A TCL Interface to SQLite.  Append this file to sqlite3.c and
    13  ** compile the whole thing to build a TCL-enabled version of SQLite.
    14  **
    15  ** Compile-time options:
    16  **
    17  **  -DTCLSH         Add a "main()" routine that works as a tclsh.
    18  **
    19  **  -DTCLSH_INIT_PROC=name
    20  **
    21  **                  Invoke name(interp) to initialize the Tcl interpreter.
    22  **                  If name(interp) returns a non-NULL string, then run
    23  **                  that string as a Tcl script to launch the application.
    24  **                  If name(interp) returns NULL, then run the regular
    25  **                  tclsh-emulator code.
    26  */
    27  #ifdef TCLSH_INIT_PROC
    28  # define TCLSH 1
    29  #endif
    30  
    31  /*
    32  ** If requested, include the SQLite compiler options file for MSVC.
    33  */
    34  #if defined(INCLUDE_MSVC_H)
    35  # include "msvc.h"
    36  #endif
    37  
    38  #if defined(INCLUDE_SQLITE_TCL_H)
    39  # include "sqlite_tcl.h"
    40  #else
    41  # include "tcl.h"
    42  # ifndef SQLITE_TCLAPI
    43  #  define SQLITE_TCLAPI
    44  # endif
    45  #endif
    46  #include <errno.h>
    47  
    48  /*
    49  ** Some additional include files are needed if this file is not
    50  ** appended to the amalgamation.
    51  */
    52  #ifndef SQLITE_AMALGAMATION
    53  # include "sqlite3.h"
    54  # include <stdlib.h>
    55  # include <string.h>
    56  # include <assert.h>
    57    typedef unsigned char u8;
    58  #endif
    59  #include <ctype.h>
    60  
    61  /* Used to get the current process ID */
    62  #if !defined(_WIN32)
    63  # include <unistd.h>
    64  # define GETPID getpid
    65  #elif !defined(_WIN32_WCE)
    66  # ifndef SQLITE_AMALGAMATION
    67  #  define WIN32_LEAN_AND_MEAN
    68  #  include <windows.h>
    69  # endif
    70  # define GETPID (int)GetCurrentProcessId
    71  #endif
    72  
    73  /*
    74   * Windows needs to know which symbols to export.  Unix does not.
    75   * BUILD_sqlite should be undefined for Unix.
    76   */
    77  #ifdef BUILD_sqlite
    78  #undef TCL_STORAGE_CLASS
    79  #define TCL_STORAGE_CLASS DLLEXPORT
    80  #endif /* BUILD_sqlite */
    81  
    82  #define NUM_PREPARED_STMTS 10
    83  #define MAX_PREPARED_STMTS 100
    84  
    85  /* Forward declaration */
    86  typedef struct SqliteDb SqliteDb;
    87  
    88  /*
    89  ** New SQL functions can be created as TCL scripts.  Each such function
    90  ** is described by an instance of the following structure.
    91  */
    92  typedef struct SqlFunc SqlFunc;
    93  struct SqlFunc {
    94    Tcl_Interp *interp;   /* The TCL interpret to execute the function */
    95    Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
    96    SqliteDb *pDb;        /* Database connection that owns this function */
    97    int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
    98    char *zName;          /* Name of this function */
    99    SqlFunc *pNext;       /* Next function on the list of them all */
   100  };
   101  
   102  /*
   103  ** New collation sequences function can be created as TCL scripts.  Each such
   104  ** function is described by an instance of the following structure.
   105  */
   106  typedef struct SqlCollate SqlCollate;
   107  struct SqlCollate {
   108    Tcl_Interp *interp;   /* The TCL interpret to execute the function */
   109    char *zScript;        /* The script to be run */
   110    SqlCollate *pNext;    /* Next function on the list of them all */
   111  };
   112  
   113  /*
   114  ** Prepared statements are cached for faster execution.  Each prepared
   115  ** statement is described by an instance of the following structure.
   116  */
   117  typedef struct SqlPreparedStmt SqlPreparedStmt;
   118  struct SqlPreparedStmt {
   119    SqlPreparedStmt *pNext;  /* Next in linked list */
   120    SqlPreparedStmt *pPrev;  /* Previous on the list */
   121    sqlite3_stmt *pStmt;     /* The prepared statement */
   122    int nSql;                /* chars in zSql[] */
   123    const char *zSql;        /* Text of the SQL statement */
   124    int nParm;               /* Size of apParm array */
   125    Tcl_Obj **apParm;        /* Array of referenced object pointers */
   126  };
   127  
   128  typedef struct IncrblobChannel IncrblobChannel;
   129  
   130  /*
   131  ** There is one instance of this structure for each SQLite database
   132  ** that has been opened by the SQLite TCL interface.
   133  **
   134  ** If this module is built with SQLITE_TEST defined (to create the SQLite
   135  ** testfixture executable), then it may be configured to use either
   136  ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
   137  ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
   138  */
   139  struct SqliteDb {
   140    sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */
   141    Tcl_Interp *interp;        /* The interpreter used for this database */
   142    char *zBusy;               /* The busy callback routine */
   143    char *zCommit;             /* The commit hook callback routine */
   144    char *zTrace;              /* The trace callback routine */
   145    char *zTraceV2;            /* The trace_v2 callback routine */
   146    char *zProfile;            /* The profile callback routine */
   147    char *zProgress;           /* The progress callback routine */
   148    char *zAuth;               /* The authorization callback routine */
   149    int disableAuth;           /* Disable the authorizer if it exists */
   150    char *zNull;               /* Text to substitute for an SQL NULL value */
   151    SqlFunc *pFunc;            /* List of SQL functions */
   152    Tcl_Obj *pUpdateHook;      /* Update hook script (if any) */
   153    Tcl_Obj *pPreUpdateHook;   /* Pre-update hook script (if any) */
   154    Tcl_Obj *pRollbackHook;    /* Rollback hook script (if any) */
   155    Tcl_Obj *pWalHook;         /* WAL hook script (if any) */
   156    Tcl_Obj *pUnlockNotify;    /* Unlock notify script (if any) */
   157    SqlCollate *pCollate;      /* List of SQL collation functions */
   158    int rc;                    /* Return code of most recent sqlite3_exec() */
   159    Tcl_Obj *pCollateNeeded;   /* Collation needed script */
   160    SqlPreparedStmt *stmtList; /* List of prepared statements*/
   161    SqlPreparedStmt *stmtLast; /* Last statement in the list */
   162    int maxStmt;               /* The next maximum number of stmtList */
   163    int nStmt;                 /* Number of statements in stmtList */
   164    IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
   165    int nStep, nSort, nIndex;  /* Statistics for most recent operation */
   166    int nVMStep;               /* Another statistic for most recent operation */
   167    int nTransaction;          /* Number of nested [transaction] methods */
   168    int openFlags;             /* Flags used to open.  (SQLITE_OPEN_URI) */
   169  #ifdef SQLITE_TEST
   170    int bLegacyPrepare;        /* True to use sqlite3_prepare() */
   171  #endif
   172  };
   173  
   174  struct IncrblobChannel {
   175    sqlite3_blob *pBlob;      /* sqlite3 blob handle */
   176    SqliteDb *pDb;            /* Associated database connection */
   177    int iSeek;                /* Current seek offset */
   178    Tcl_Channel channel;      /* Channel identifier */
   179    IncrblobChannel *pNext;   /* Linked list of all open incrblob channels */
   180    IncrblobChannel *pPrev;   /* Linked list of all open incrblob channels */
   181  };
   182  
   183  /*
   184  ** Compute a string length that is limited to what can be stored in
   185  ** lower 30 bits of a 32-bit signed integer.
   186  */
   187  static int strlen30(const char *z){
   188    const char *z2 = z;
   189    while( *z2 ){ z2++; }
   190    return 0x3fffffff & (int)(z2 - z);
   191  }
   192  
   193  
   194  #ifndef SQLITE_OMIT_INCRBLOB
   195  /*
   196  ** Close all incrblob channels opened using database connection pDb.
   197  ** This is called when shutting down the database connection.
   198  */
   199  static void closeIncrblobChannels(SqliteDb *pDb){
   200    IncrblobChannel *p;
   201    IncrblobChannel *pNext;
   202  
   203    for(p=pDb->pIncrblob; p; p=pNext){
   204      pNext = p->pNext;
   205  
   206      /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
   207      ** which deletes the IncrblobChannel structure at *p. So do not
   208      ** call Tcl_Free() here.
   209      */
   210      Tcl_UnregisterChannel(pDb->interp, p->channel);
   211    }
   212  }
   213  
   214  /*
   215  ** Close an incremental blob channel.
   216  */
   217  static int SQLITE_TCLAPI incrblobClose(
   218    ClientData instanceData,
   219    Tcl_Interp *interp
   220  ){
   221    IncrblobChannel *p = (IncrblobChannel *)instanceData;
   222    int rc = sqlite3_blob_close(p->pBlob);
   223    sqlite3 *db = p->pDb->db;
   224  
   225    /* Remove the channel from the SqliteDb.pIncrblob list. */
   226    if( p->pNext ){
   227      p->pNext->pPrev = p->pPrev;
   228    }
   229    if( p->pPrev ){
   230      p->pPrev->pNext = p->pNext;
   231    }
   232    if( p->pDb->pIncrblob==p ){
   233      p->pDb->pIncrblob = p->pNext;
   234    }
   235  
   236    /* Free the IncrblobChannel structure */
   237    Tcl_Free((char *)p);
   238  
   239    if( rc!=SQLITE_OK ){
   240      Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
   241      return TCL_ERROR;
   242    }
   243    return TCL_OK;
   244  }
   245  
   246  /*
   247  ** Read data from an incremental blob channel.
   248  */
   249  static int SQLITE_TCLAPI incrblobInput(
   250    ClientData instanceData,
   251    char *buf,
   252    int bufSize,
   253    int *errorCodePtr
   254  ){
   255    IncrblobChannel *p = (IncrblobChannel *)instanceData;
   256    int nRead = bufSize;         /* Number of bytes to read */
   257    int nBlob;                   /* Total size of the blob */
   258    int rc;                      /* sqlite error code */
   259  
   260    nBlob = sqlite3_blob_bytes(p->pBlob);
   261    if( (p->iSeek+nRead)>nBlob ){
   262      nRead = nBlob-p->iSeek;
   263    }
   264    if( nRead<=0 ){
   265      return 0;
   266    }
   267  
   268    rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
   269    if( rc!=SQLITE_OK ){
   270      *errorCodePtr = rc;
   271      return -1;
   272    }
   273  
   274    p->iSeek += nRead;
   275    return nRead;
   276  }
   277  
   278  /*
   279  ** Write data to an incremental blob channel.
   280  */
   281  static int SQLITE_TCLAPI incrblobOutput(
   282    ClientData instanceData,
   283    CONST char *buf,
   284    int toWrite,
   285    int *errorCodePtr
   286  ){
   287    IncrblobChannel *p = (IncrblobChannel *)instanceData;
   288    int nWrite = toWrite;        /* Number of bytes to write */
   289    int nBlob;                   /* Total size of the blob */
   290    int rc;                      /* sqlite error code */
   291  
   292    nBlob = sqlite3_blob_bytes(p->pBlob);
   293    if( (p->iSeek+nWrite)>nBlob ){
   294      *errorCodePtr = EINVAL;
   295      return -1;
   296    }
   297    if( nWrite<=0 ){
   298      return 0;
   299    }
   300  
   301    rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
   302    if( rc!=SQLITE_OK ){
   303      *errorCodePtr = EIO;
   304      return -1;
   305    }
   306  
   307    p->iSeek += nWrite;
   308    return nWrite;
   309  }
   310  
   311  /*
   312  ** Seek an incremental blob channel.
   313  */
   314  static int SQLITE_TCLAPI incrblobSeek(
   315    ClientData instanceData,
   316    long offset,
   317    int seekMode,
   318    int *errorCodePtr
   319  ){
   320    IncrblobChannel *p = (IncrblobChannel *)instanceData;
   321  
   322    switch( seekMode ){
   323      case SEEK_SET:
   324        p->iSeek = offset;
   325        break;
   326      case SEEK_CUR:
   327        p->iSeek += offset;
   328        break;
   329      case SEEK_END:
   330        p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
   331        break;
   332  
   333      default: assert(!"Bad seekMode");
   334    }
   335  
   336    return p->iSeek;
   337  }
   338  
   339  
   340  static void SQLITE_TCLAPI incrblobWatch(
   341    ClientData instanceData,
   342    int mode
   343  ){
   344    /* NO-OP */
   345  }
   346  static int SQLITE_TCLAPI incrblobHandle(
   347    ClientData instanceData,
   348    int dir,
   349    ClientData *hPtr
   350  ){
   351    return TCL_ERROR;
   352  }
   353  
   354  static Tcl_ChannelType IncrblobChannelType = {
   355    "incrblob",                        /* typeName                             */
   356    TCL_CHANNEL_VERSION_2,             /* version                              */
   357    incrblobClose,                     /* closeProc                            */
   358    incrblobInput,                     /* inputProc                            */
   359    incrblobOutput,                    /* outputProc                           */
   360    incrblobSeek,                      /* seekProc                             */
   361    0,                                 /* setOptionProc                        */
   362    0,                                 /* getOptionProc                        */
   363    incrblobWatch,                     /* watchProc (this is a no-op)          */
   364    incrblobHandle,                    /* getHandleProc (always returns error) */
   365    0,                                 /* close2Proc                           */
   366    0,                                 /* blockModeProc                        */
   367    0,                                 /* flushProc                            */
   368    0,                                 /* handlerProc                          */
   369    0,                                 /* wideSeekProc                         */
   370  };
   371  
   372  /*
   373  ** Create a new incrblob channel.
   374  */
   375  static int createIncrblobChannel(
   376    Tcl_Interp *interp,
   377    SqliteDb *pDb,
   378    const char *zDb,
   379    const char *zTable,
   380    const char *zColumn,
   381    sqlite_int64 iRow,
   382    int isReadonly
   383  ){
   384    IncrblobChannel *p;
   385    sqlite3 *db = pDb->db;
   386    sqlite3_blob *pBlob;
   387    int rc;
   388    int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
   389  
   390    /* This variable is used to name the channels: "incrblob_[incr count]" */
   391    static int count = 0;
   392    char zChannel[64];
   393  
   394    rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
   395    if( rc!=SQLITE_OK ){
   396      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
   397      return TCL_ERROR;
   398    }
   399  
   400    p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
   401    p->iSeek = 0;
   402    p->pBlob = pBlob;
   403  
   404    sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
   405    p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
   406    Tcl_RegisterChannel(interp, p->channel);
   407  
   408    /* Link the new channel into the SqliteDb.pIncrblob list. */
   409    p->pNext = pDb->pIncrblob;
   410    p->pPrev = 0;
   411    if( p->pNext ){
   412      p->pNext->pPrev = p;
   413    }
   414    pDb->pIncrblob = p;
   415    p->pDb = pDb;
   416  
   417    Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
   418    return TCL_OK;
   419  }
   420  #else  /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
   421    #define closeIncrblobChannels(pDb)
   422  #endif
   423  
   424  /*
   425  ** Look at the script prefix in pCmd.  We will be executing this script
   426  ** after first appending one or more arguments.  This routine analyzes
   427  ** the script to see if it is safe to use Tcl_EvalObjv() on the script
   428  ** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much
   429  ** faster.
   430  **
   431  ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
   432  ** command name followed by zero or more arguments with no [...] or $
   433  ** or {...} or ; to be seen anywhere.  Most callback scripts consist
   434  ** of just a single procedure name and they meet this requirement.
   435  */
   436  static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
   437    /* We could try to do something with Tcl_Parse().  But we will instead
   438    ** just do a search for forbidden characters.  If any of the forbidden
   439    ** characters appear in pCmd, we will report the string as unsafe.
   440    */
   441    const char *z;
   442    int n;
   443    z = Tcl_GetStringFromObj(pCmd, &n);
   444    while( n-- > 0 ){
   445      int c = *(z++);
   446      if( c=='$' || c=='[' || c==';' ) return 0;
   447    }
   448    return 1;
   449  }
   450  
   451  /*
   452  ** Find an SqlFunc structure with the given name.  Or create a new
   453  ** one if an existing one cannot be found.  Return a pointer to the
   454  ** structure.
   455  */
   456  static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
   457    SqlFunc *p, *pNew;
   458    int nName = strlen30(zName);
   459    pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
   460    pNew->zName = (char*)&pNew[1];
   461    memcpy(pNew->zName, zName, nName+1);
   462    for(p=pDb->pFunc; p; p=p->pNext){
   463      if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){
   464        Tcl_Free((char*)pNew);
   465        return p;
   466      }
   467    }
   468    pNew->interp = pDb->interp;
   469    pNew->pDb = pDb;
   470    pNew->pScript = 0;
   471    pNew->pNext = pDb->pFunc;
   472    pDb->pFunc = pNew;
   473    return pNew;
   474  }
   475  
   476  /*
   477  ** Free a single SqlPreparedStmt object.
   478  */
   479  static void dbFreeStmt(SqlPreparedStmt *pStmt){
   480  #ifdef SQLITE_TEST
   481    if( sqlite3_sql(pStmt->pStmt)==0 ){
   482      Tcl_Free((char *)pStmt->zSql);
   483    }
   484  #endif
   485    sqlite3_finalize(pStmt->pStmt);
   486    Tcl_Free((char *)pStmt);
   487  }
   488  
   489  /*
   490  ** Finalize and free a list of prepared statements
   491  */
   492  static void flushStmtCache(SqliteDb *pDb){
   493    SqlPreparedStmt *pPreStmt;
   494    SqlPreparedStmt *pNext;
   495  
   496    for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){
   497      pNext = pPreStmt->pNext;
   498      dbFreeStmt(pPreStmt);
   499    }
   500    pDb->nStmt = 0;
   501    pDb->stmtLast = 0;
   502    pDb->stmtList = 0;
   503  }
   504  
   505  /*
   506  ** TCL calls this procedure when an sqlite3 database command is
   507  ** deleted.
   508  */
   509  static void SQLITE_TCLAPI DbDeleteCmd(void *db){
   510    SqliteDb *pDb = (SqliteDb*)db;
   511    flushStmtCache(pDb);
   512    closeIncrblobChannels(pDb);
   513    sqlite3_close(pDb->db);
   514    while( pDb->pFunc ){
   515      SqlFunc *pFunc = pDb->pFunc;
   516      pDb->pFunc = pFunc->pNext;
   517      assert( pFunc->pDb==pDb );
   518      Tcl_DecrRefCount(pFunc->pScript);
   519      Tcl_Free((char*)pFunc);
   520    }
   521    while( pDb->pCollate ){
   522      SqlCollate *pCollate = pDb->pCollate;
   523      pDb->pCollate = pCollate->pNext;
   524      Tcl_Free((char*)pCollate);
   525    }
   526    if( pDb->zBusy ){
   527      Tcl_Free(pDb->zBusy);
   528    }
   529    if( pDb->zTrace ){
   530      Tcl_Free(pDb->zTrace);
   531    }
   532    if( pDb->zTraceV2 ){
   533      Tcl_Free(pDb->zTraceV2);
   534    }
   535    if( pDb->zProfile ){
   536      Tcl_Free(pDb->zProfile);
   537    }
   538    if( pDb->zAuth ){
   539      Tcl_Free(pDb->zAuth);
   540    }
   541    if( pDb->zNull ){
   542      Tcl_Free(pDb->zNull);
   543    }
   544    if( pDb->pUpdateHook ){
   545      Tcl_DecrRefCount(pDb->pUpdateHook);
   546    }
   547    if( pDb->pPreUpdateHook ){
   548      Tcl_DecrRefCount(pDb->pPreUpdateHook);
   549    }
   550    if( pDb->pRollbackHook ){
   551      Tcl_DecrRefCount(pDb->pRollbackHook);
   552    }
   553    if( pDb->pWalHook ){
   554      Tcl_DecrRefCount(pDb->pWalHook);
   555    }
   556    if( pDb->pCollateNeeded ){
   557      Tcl_DecrRefCount(pDb->pCollateNeeded);
   558    }
   559    Tcl_Free((char*)pDb);
   560  }
   561  
   562  /*
   563  ** This routine is called when a database file is locked while trying
   564  ** to execute SQL.
   565  */
   566  static int DbBusyHandler(void *cd, int nTries){
   567    SqliteDb *pDb = (SqliteDb*)cd;
   568    int rc;
   569    char zVal[30];
   570  
   571    sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
   572    rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
   573    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
   574      return 0;
   575    }
   576    return 1;
   577  }
   578  
   579  #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
   580  /*
   581  ** This routine is invoked as the 'progress callback' for the database.
   582  */
   583  static int DbProgressHandler(void *cd){
   584    SqliteDb *pDb = (SqliteDb*)cd;
   585    int rc;
   586  
   587    assert( pDb->zProgress );
   588    rc = Tcl_Eval(pDb->interp, pDb->zProgress);
   589    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
   590      return 1;
   591    }
   592    return 0;
   593  }
   594  #endif
   595  
   596  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
   597      !defined(SQLITE_OMIT_DEPRECATED)
   598  /*
   599  ** This routine is called by the SQLite trace handler whenever a new
   600  ** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
   601  */
   602  static void DbTraceHandler(void *cd, const char *zSql){
   603    SqliteDb *pDb = (SqliteDb*)cd;
   604    Tcl_DString str;
   605  
   606    Tcl_DStringInit(&str);
   607    Tcl_DStringAppend(&str, pDb->zTrace, -1);
   608    Tcl_DStringAppendElement(&str, zSql);
   609    Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
   610    Tcl_DStringFree(&str);
   611    Tcl_ResetResult(pDb->interp);
   612  }
   613  #endif
   614  
   615  #ifndef SQLITE_OMIT_TRACE
   616  /*
   617  ** This routine is called by the SQLite trace_v2 handler whenever a new
   618  ** supported event is generated.  Unsupported event types are ignored.
   619  ** The TCL script in pDb->zTraceV2 is executed, with the arguments for
   620  ** the event appended to it (as list elements).
   621  */
   622  static int DbTraceV2Handler(
   623    unsigned type, /* One of the SQLITE_TRACE_* event types. */
   624    void *cd,      /* The original context data pointer. */
   625    void *pd,      /* Primary event data, depends on event type. */
   626    void *xd       /* Extra event data, depends on event type. */
   627  ){
   628    SqliteDb *pDb = (SqliteDb*)cd;
   629    Tcl_Obj *pCmd;
   630  
   631    switch( type ){
   632      case SQLITE_TRACE_STMT: {
   633        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
   634        char *zSql = (char *)xd;
   635  
   636        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
   637        Tcl_IncrRefCount(pCmd);
   638        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   639                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
   640        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   641                                 Tcl_NewStringObj(zSql, -1));
   642        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   643        Tcl_DecrRefCount(pCmd);
   644        Tcl_ResetResult(pDb->interp);
   645        break;
   646      }
   647      case SQLITE_TRACE_PROFILE: {
   648        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
   649        sqlite3_int64 ns = (sqlite3_int64)xd;
   650  
   651        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
   652        Tcl_IncrRefCount(pCmd);
   653        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   654                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
   655        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   656                                 Tcl_NewWideIntObj((Tcl_WideInt)ns));
   657        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   658        Tcl_DecrRefCount(pCmd);
   659        Tcl_ResetResult(pDb->interp);
   660        break;
   661      }
   662      case SQLITE_TRACE_ROW: {
   663        sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
   664  
   665        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
   666        Tcl_IncrRefCount(pCmd);
   667        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   668                                 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
   669        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   670        Tcl_DecrRefCount(pCmd);
   671        Tcl_ResetResult(pDb->interp);
   672        break;
   673      }
   674      case SQLITE_TRACE_CLOSE: {
   675        sqlite3 *db = (sqlite3 *)pd;
   676  
   677        pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
   678        Tcl_IncrRefCount(pCmd);
   679        Tcl_ListObjAppendElement(pDb->interp, pCmd,
   680                                 Tcl_NewWideIntObj((Tcl_WideInt)db));
   681        Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   682        Tcl_DecrRefCount(pCmd);
   683        Tcl_ResetResult(pDb->interp);
   684        break;
   685      }
   686    }
   687    return SQLITE_OK;
   688  }
   689  #endif
   690  
   691  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
   692      !defined(SQLITE_OMIT_DEPRECATED)
   693  /*
   694  ** This routine is called by the SQLite profile handler after a statement
   695  ** SQL has executed.  The TCL script in pDb->zProfile is evaluated.
   696  */
   697  static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
   698    SqliteDb *pDb = (SqliteDb*)cd;
   699    Tcl_DString str;
   700    char zTm[100];
   701  
   702    sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
   703    Tcl_DStringInit(&str);
   704    Tcl_DStringAppend(&str, pDb->zProfile, -1);
   705    Tcl_DStringAppendElement(&str, zSql);
   706    Tcl_DStringAppendElement(&str, zTm);
   707    Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
   708    Tcl_DStringFree(&str);
   709    Tcl_ResetResult(pDb->interp);
   710  }
   711  #endif
   712  
   713  /*
   714  ** This routine is called when a transaction is committed.  The
   715  ** TCL script in pDb->zCommit is executed.  If it returns non-zero or
   716  ** if it throws an exception, the transaction is rolled back instead
   717  ** of being committed.
   718  */
   719  static int DbCommitHandler(void *cd){
   720    SqliteDb *pDb = (SqliteDb*)cd;
   721    int rc;
   722  
   723    rc = Tcl_Eval(pDb->interp, pDb->zCommit);
   724    if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
   725      return 1;
   726    }
   727    return 0;
   728  }
   729  
   730  static void DbRollbackHandler(void *clientData){
   731    SqliteDb *pDb = (SqliteDb*)clientData;
   732    assert(pDb->pRollbackHook);
   733    if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
   734      Tcl_BackgroundError(pDb->interp);
   735    }
   736  }
   737  
   738  /*
   739  ** This procedure handles wal_hook callbacks.
   740  */
   741  static int DbWalHandler(
   742    void *clientData,
   743    sqlite3 *db,
   744    const char *zDb,
   745    int nEntry
   746  ){
   747    int ret = SQLITE_OK;
   748    Tcl_Obj *p;
   749    SqliteDb *pDb = (SqliteDb*)clientData;
   750    Tcl_Interp *interp = pDb->interp;
   751    assert(pDb->pWalHook);
   752  
   753    assert( db==pDb->db );
   754    p = Tcl_DuplicateObj(pDb->pWalHook);
   755    Tcl_IncrRefCount(p);
   756    Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
   757    Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
   758    if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
   759     || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
   760    ){
   761      Tcl_BackgroundError(interp);
   762    }
   763    Tcl_DecrRefCount(p);
   764  
   765    return ret;
   766  }
   767  
   768  #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
   769  static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
   770    char zBuf[64];
   771    sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);
   772    Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
   773    sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);
   774    Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
   775  }
   776  #else
   777  # define setTestUnlockNotifyVars(x,y,z)
   778  #endif
   779  
   780  #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
   781  static void DbUnlockNotify(void **apArg, int nArg){
   782    int i;
   783    for(i=0; i<nArg; i++){
   784      const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
   785      SqliteDb *pDb = (SqliteDb *)apArg[i];
   786      setTestUnlockNotifyVars(pDb->interp, i, nArg);
   787      assert( pDb->pUnlockNotify);
   788      Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
   789      Tcl_DecrRefCount(pDb->pUnlockNotify);
   790      pDb->pUnlockNotify = 0;
   791    }
   792  }
   793  #endif
   794  
   795  #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
   796  /*
   797  ** Pre-update hook callback.
   798  */
   799  static void DbPreUpdateHandler(
   800    void *p,
   801    sqlite3 *db,
   802    int op,
   803    const char *zDb,
   804    const char *zTbl,
   805    sqlite_int64 iKey1,
   806    sqlite_int64 iKey2
   807  ){
   808    SqliteDb *pDb = (SqliteDb *)p;
   809    Tcl_Obj *pCmd;
   810    static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
   811  
   812    assert( (SQLITE_DELETE-1)/9 == 0 );
   813    assert( (SQLITE_INSERT-1)/9 == 1 );
   814    assert( (SQLITE_UPDATE-1)/9 == 2 );
   815    assert( pDb->pPreUpdateHook );
   816    assert( db==pDb->db );
   817    assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
   818  
   819    pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);
   820    Tcl_IncrRefCount(pCmd);
   821    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
   822    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
   823    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
   824    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));
   825    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));
   826    Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   827    Tcl_DecrRefCount(pCmd);
   828  }
   829  #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
   830  
   831  static void DbUpdateHandler(
   832    void *p,
   833    int op,
   834    const char *zDb,
   835    const char *zTbl,
   836    sqlite_int64 rowid
   837  ){
   838    SqliteDb *pDb = (SqliteDb *)p;
   839    Tcl_Obj *pCmd;
   840    static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
   841  
   842    assert( (SQLITE_DELETE-1)/9 == 0 );
   843    assert( (SQLITE_INSERT-1)/9 == 1 );
   844    assert( (SQLITE_UPDATE-1)/9 == 2 );
   845  
   846    assert( pDb->pUpdateHook );
   847    assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
   848  
   849    pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
   850    Tcl_IncrRefCount(pCmd);
   851    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
   852    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
   853    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
   854    Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
   855    Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
   856    Tcl_DecrRefCount(pCmd);
   857  }
   858  
   859  static void tclCollateNeeded(
   860    void *pCtx,
   861    sqlite3 *db,
   862    int enc,
   863    const char *zName
   864  ){
   865    SqliteDb *pDb = (SqliteDb *)pCtx;
   866    Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
   867    Tcl_IncrRefCount(pScript);
   868    Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
   869    Tcl_EvalObjEx(pDb->interp, pScript, 0);
   870    Tcl_DecrRefCount(pScript);
   871  }
   872  
   873  /*
   874  ** This routine is called to evaluate an SQL collation function implemented
   875  ** using TCL script.
   876  */
   877  static int tclSqlCollate(
   878    void *pCtx,
   879    int nA,
   880    const void *zA,
   881    int nB,
   882    const void *zB
   883  ){
   884    SqlCollate *p = (SqlCollate *)pCtx;
   885    Tcl_Obj *pCmd;
   886  
   887    pCmd = Tcl_NewStringObj(p->zScript, -1);
   888    Tcl_IncrRefCount(pCmd);
   889    Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
   890    Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
   891    Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
   892    Tcl_DecrRefCount(pCmd);
   893    return (atoi(Tcl_GetStringResult(p->interp)));
   894  }
   895  
   896  /*
   897  ** This routine is called to evaluate an SQL function implemented
   898  ** using TCL script.
   899  */
   900  static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
   901    SqlFunc *p = sqlite3_user_data(context);
   902    Tcl_Obj *pCmd;
   903    int i;
   904    int rc;
   905  
   906    if( argc==0 ){
   907      /* If there are no arguments to the function, call Tcl_EvalObjEx on the
   908      ** script object directly.  This allows the TCL compiler to generate
   909      ** bytecode for the command on the first invocation and thus make
   910      ** subsequent invocations much faster. */
   911      pCmd = p->pScript;
   912      Tcl_IncrRefCount(pCmd);
   913      rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
   914      Tcl_DecrRefCount(pCmd);
   915    }else{
   916      /* If there are arguments to the function, make a shallow copy of the
   917      ** script object, lappend the arguments, then evaluate the copy.
   918      **
   919      ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated.
   920      ** The new Tcl_Obj contains pointers to the original list elements.
   921      ** That way, when Tcl_EvalObjv() is run and shimmers the first element
   922      ** of the list to tclCmdNameType, that alternate representation will
   923      ** be preserved and reused on the next invocation.
   924      */
   925      Tcl_Obj **aArg;
   926      int nArg;
   927      if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
   928        sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
   929        return;
   930      }
   931      pCmd = Tcl_NewListObj(nArg, aArg);
   932      Tcl_IncrRefCount(pCmd);
   933      for(i=0; i<argc; i++){
   934        sqlite3_value *pIn = argv[i];
   935        Tcl_Obj *pVal;
   936  
   937        /* Set pVal to contain the i'th column of this row. */
   938        switch( sqlite3_value_type(pIn) ){
   939          case SQLITE_BLOB: {
   940            int bytes = sqlite3_value_bytes(pIn);
   941            pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
   942            break;
   943          }
   944          case SQLITE_INTEGER: {
   945            sqlite_int64 v = sqlite3_value_int64(pIn);
   946            if( v>=-2147483647 && v<=2147483647 ){
   947              pVal = Tcl_NewIntObj((int)v);
   948            }else{
   949              pVal = Tcl_NewWideIntObj(v);
   950            }
   951            break;
   952          }
   953          case SQLITE_FLOAT: {
   954            double r = sqlite3_value_double(pIn);
   955            pVal = Tcl_NewDoubleObj(r);
   956            break;
   957          }
   958          case SQLITE_NULL: {
   959            pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
   960            break;
   961          }
   962          default: {
   963            int bytes = sqlite3_value_bytes(pIn);
   964            pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
   965            break;
   966          }
   967        }
   968        rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
   969        if( rc ){
   970          Tcl_DecrRefCount(pCmd);
   971          sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
   972          return;
   973        }
   974      }
   975      if( !p->useEvalObjv ){
   976        /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
   977        ** is a list without a string representation.  To prevent this from
   978        ** happening, make sure pCmd has a valid string representation */
   979        Tcl_GetString(pCmd);
   980      }
   981      rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
   982      Tcl_DecrRefCount(pCmd);
   983    }
   984  
   985    if( rc && rc!=TCL_RETURN ){
   986      sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
   987    }else{
   988      Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
   989      int n;
   990      u8 *data;
   991      const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
   992      char c = zType[0];
   993      if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
   994        /* Only return a BLOB type if the Tcl variable is a bytearray and
   995        ** has no string representation. */
   996        data = Tcl_GetByteArrayFromObj(pVar, &n);
   997        sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
   998      }else if( c=='b' && strcmp(zType,"boolean")==0 ){
   999        Tcl_GetIntFromObj(0, pVar, &n);
  1000        sqlite3_result_int(context, n);
  1001      }else if( c=='d' && strcmp(zType,"double")==0 ){
  1002        double r;
  1003        Tcl_GetDoubleFromObj(0, pVar, &r);
  1004        sqlite3_result_double(context, r);
  1005      }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
  1006            (c=='i' && strcmp(zType,"int")==0) ){
  1007        Tcl_WideInt v;
  1008        Tcl_GetWideIntFromObj(0, pVar, &v);
  1009        sqlite3_result_int64(context, v);
  1010      }else{
  1011        data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
  1012        sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
  1013      }
  1014    }
  1015  }
  1016  
  1017  #ifndef SQLITE_OMIT_AUTHORIZATION
  1018  /*
  1019  ** This is the authentication function.  It appends the authentication
  1020  ** type code and the two arguments to zCmd[] then invokes the result
  1021  ** on the interpreter.  The reply is examined to determine if the
  1022  ** authentication fails or succeeds.
  1023  */
  1024  static int auth_callback(
  1025    void *pArg,
  1026    int code,
  1027    const char *zArg1,
  1028    const char *zArg2,
  1029    const char *zArg3,
  1030    const char *zArg4
  1031  #ifdef SQLITE_USER_AUTHENTICATION
  1032    ,const char *zArg5
  1033  #endif
  1034  ){
  1035    const char *zCode;
  1036    Tcl_DString str;
  1037    int rc;
  1038    const char *zReply;
  1039    /* EVIDENCE-OF: R-38590-62769 The first parameter to the authorizer
  1040    ** callback is a copy of the third parameter to the
  1041    ** sqlite3_set_authorizer() interface.
  1042    */
  1043    SqliteDb *pDb = (SqliteDb*)pArg;
  1044    if( pDb->disableAuth ) return SQLITE_OK;
  1045  
  1046    /* EVIDENCE-OF: R-56518-44310 The second parameter to the callback is an
  1047    ** integer action code that specifies the particular action to be
  1048    ** authorized. */
  1049    switch( code ){
  1050      case SQLITE_COPY              : zCode="SQLITE_COPY"; break;
  1051      case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;
  1052      case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;
  1053      case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
  1054      case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
  1055      case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
  1056      case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
  1057      case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;
  1058      case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;
  1059      case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;
  1060      case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;
  1061      case SQLITE_DROP_TABLE        : zCode="SQLITE_DROP_TABLE"; break;
  1062      case SQLITE_DROP_TEMP_INDEX   : zCode="SQLITE_DROP_TEMP_INDEX"; break;
  1063      case SQLITE_DROP_TEMP_TABLE   : zCode="SQLITE_DROP_TEMP_TABLE"; break;
  1064      case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
  1065      case SQLITE_DROP_TEMP_VIEW    : zCode="SQLITE_DROP_TEMP_VIEW"; break;
  1066      case SQLITE_DROP_TRIGGER      : zCode="SQLITE_DROP_TRIGGER"; break;
  1067      case SQLITE_DROP_VIEW         : zCode="SQLITE_DROP_VIEW"; break;
  1068      case SQLITE_INSERT            : zCode="SQLITE_INSERT"; break;
  1069      case SQLITE_PRAGMA            : zCode="SQLITE_PRAGMA"; break;
  1070      case SQLITE_READ              : zCode="SQLITE_READ"; break;
  1071      case SQLITE_SELECT            : zCode="SQLITE_SELECT"; break;
  1072      case SQLITE_TRANSACTION       : zCode="SQLITE_TRANSACTION"; break;
  1073      case SQLITE_UPDATE            : zCode="SQLITE_UPDATE"; break;
  1074      case SQLITE_ATTACH            : zCode="SQLITE_ATTACH"; break;
  1075      case SQLITE_DETACH            : zCode="SQLITE_DETACH"; break;
  1076      case SQLITE_ALTER_TABLE       : zCode="SQLITE_ALTER_TABLE"; break;
  1077      case SQLITE_REINDEX           : zCode="SQLITE_REINDEX"; break;
  1078      case SQLITE_ANALYZE           : zCode="SQLITE_ANALYZE"; break;
  1079      case SQLITE_CREATE_VTABLE     : zCode="SQLITE_CREATE_VTABLE"; break;
  1080      case SQLITE_DROP_VTABLE       : zCode="SQLITE_DROP_VTABLE"; break;
  1081      case SQLITE_FUNCTION          : zCode="SQLITE_FUNCTION"; break;
  1082      case SQLITE_SAVEPOINT         : zCode="SQLITE_SAVEPOINT"; break;
  1083      case SQLITE_RECURSIVE         : zCode="SQLITE_RECURSIVE"; break;
  1084      default                       : zCode="????"; break;
  1085    }
  1086    Tcl_DStringInit(&str);
  1087    Tcl_DStringAppend(&str, pDb->zAuth, -1);
  1088    Tcl_DStringAppendElement(&str, zCode);
  1089    Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
  1090    Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
  1091    Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
  1092    Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
  1093  #ifdef SQLITE_USER_AUTHENTICATION
  1094    Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : "");
  1095  #endif
  1096    rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
  1097    Tcl_DStringFree(&str);
  1098    zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";
  1099    if( strcmp(zReply,"SQLITE_OK")==0 ){
  1100      rc = SQLITE_OK;
  1101    }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
  1102      rc = SQLITE_DENY;
  1103    }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
  1104      rc = SQLITE_IGNORE;
  1105    }else{
  1106      rc = 999;
  1107    }
  1108    return rc;
  1109  }
  1110  #endif /* SQLITE_OMIT_AUTHORIZATION */
  1111  
  1112  /*
  1113  ** This routine reads a line of text from FILE in, stores
  1114  ** the text in memory obtained from malloc() and returns a pointer
  1115  ** to the text.  NULL is returned at end of file, or if malloc()
  1116  ** fails.
  1117  **
  1118  ** The interface is like "readline" but no command-line editing
  1119  ** is done.
  1120  **
  1121  ** copied from shell.c from '.import' command
  1122  */
  1123  static char *local_getline(char *zPrompt, FILE *in){
  1124    char *zLine;
  1125    int nLine;
  1126    int n;
  1127  
  1128    nLine = 100;
  1129    zLine = malloc( nLine );
  1130    if( zLine==0 ) return 0;
  1131    n = 0;
  1132    while( 1 ){
  1133      if( n+100>nLine ){
  1134        nLine = nLine*2 + 100;
  1135        zLine = realloc(zLine, nLine);
  1136        if( zLine==0 ) return 0;
  1137      }
  1138      if( fgets(&zLine[n], nLine - n, in)==0 ){
  1139        if( n==0 ){
  1140          free(zLine);
  1141          return 0;
  1142        }
  1143        zLine[n] = 0;
  1144        break;
  1145      }
  1146      while( zLine[n] ){ n++; }
  1147      if( n>0 && zLine[n-1]=='\n' ){
  1148        n--;
  1149        zLine[n] = 0;
  1150        break;
  1151      }
  1152    }
  1153    zLine = realloc( zLine, n+1 );
  1154    return zLine;
  1155  }
  1156  
  1157  
  1158  /*
  1159  ** This function is part of the implementation of the command:
  1160  **
  1161  **   $db transaction [-deferred|-immediate|-exclusive] SCRIPT
  1162  **
  1163  ** It is invoked after evaluating the script SCRIPT to commit or rollback
  1164  ** the transaction or savepoint opened by the [transaction] command.
  1165  */
  1166  static int SQLITE_TCLAPI DbTransPostCmd(
  1167    ClientData data[],                   /* data[0] is the Sqlite3Db* for $db */
  1168    Tcl_Interp *interp,                  /* Tcl interpreter */
  1169    int result                           /* Result of evaluating SCRIPT */
  1170  ){
  1171    static const char *const azEnd[] = {
  1172      "RELEASE _tcl_transaction",        /* rc==TCL_ERROR, nTransaction!=0 */
  1173      "COMMIT",                          /* rc!=TCL_ERROR, nTransaction==0 */
  1174      "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
  1175      "ROLLBACK"                         /* rc==TCL_ERROR, nTransaction==0 */
  1176    };
  1177    SqliteDb *pDb = (SqliteDb*)data[0];
  1178    int rc = result;
  1179    const char *zEnd;
  1180  
  1181    pDb->nTransaction--;
  1182    zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
  1183  
  1184    pDb->disableAuth++;
  1185    if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
  1186        /* This is a tricky scenario to handle. The most likely cause of an
  1187        ** error is that the exec() above was an attempt to commit the
  1188        ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
  1189        ** that an IO-error has occurred. In either case, throw a Tcl exception
  1190        ** and try to rollback the transaction.
  1191        **
  1192        ** But it could also be that the user executed one or more BEGIN,
  1193        ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
  1194        ** this method's logic. Not clear how this would be best handled.
  1195        */
  1196      if( rc!=TCL_ERROR ){
  1197        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
  1198        rc = TCL_ERROR;
  1199      }
  1200      sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
  1201    }
  1202    pDb->disableAuth--;
  1203  
  1204    return rc;
  1205  }
  1206  
  1207  /*
  1208  ** Unless SQLITE_TEST is defined, this function is a simple wrapper around
  1209  ** sqlite3_prepare_v2(). If SQLITE_TEST is defined, then it uses either
  1210  ** sqlite3_prepare_v2() or legacy interface sqlite3_prepare(), depending
  1211  ** on whether or not the [db_use_legacy_prepare] command has been used to
  1212  ** configure the connection.
  1213  */
  1214  static int dbPrepare(
  1215    SqliteDb *pDb,                  /* Database object */
  1216    const char *zSql,               /* SQL to compile */
  1217    sqlite3_stmt **ppStmt,          /* OUT: Prepared statement */
  1218    const char **pzOut              /* OUT: Pointer to next SQL statement */
  1219  ){
  1220    unsigned int prepFlags = 0;
  1221  #ifdef SQLITE_TEST
  1222    if( pDb->bLegacyPrepare ){
  1223      return sqlite3_prepare(pDb->db, zSql, -1, ppStmt, pzOut);
  1224    }
  1225  #endif
  1226    /* If the statement cache is large, use the SQLITE_PREPARE_PERSISTENT
  1227    ** flags, which uses less lookaside memory.  But if the cache is small,
  1228    ** omit that flag to make full use of lookaside */
  1229    if( pDb->maxStmt>5 ) prepFlags = SQLITE_PREPARE_PERSISTENT;
  1230  
  1231    return sqlite3_prepare_v3(pDb->db, zSql, -1, prepFlags, ppStmt, pzOut);
  1232  }
  1233  
  1234  /*
  1235  ** Search the cache for a prepared-statement object that implements the
  1236  ** first SQL statement in the buffer pointed to by parameter zIn. If
  1237  ** no such prepared-statement can be found, allocate and prepare a new
  1238  ** one. In either case, bind the current values of the relevant Tcl
  1239  ** variables to any $var, :var or @var variables in the statement. Before
  1240  ** returning, set *ppPreStmt to point to the prepared-statement object.
  1241  **
  1242  ** Output parameter *pzOut is set to point to the next SQL statement in
  1243  ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
  1244  ** next statement.
  1245  **
  1246  ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
  1247  ** and an error message loaded into interpreter pDb->interp.
  1248  */
  1249  static int dbPrepareAndBind(
  1250    SqliteDb *pDb,                  /* Database object */
  1251    char const *zIn,                /* SQL to compile */
  1252    char const **pzOut,             /* OUT: Pointer to next SQL statement */
  1253    SqlPreparedStmt **ppPreStmt     /* OUT: Object used to cache statement */
  1254  ){
  1255    const char *zSql = zIn;         /* Pointer to first SQL statement in zIn */
  1256    sqlite3_stmt *pStmt = 0;        /* Prepared statement object */
  1257    SqlPreparedStmt *pPreStmt;      /* Pointer to cached statement */
  1258    int nSql;                       /* Length of zSql in bytes */
  1259    int nVar = 0;                   /* Number of variables in statement */
  1260    int iParm = 0;                  /* Next free entry in apParm */
  1261    char c;
  1262    int i;
  1263    Tcl_Interp *interp = pDb->interp;
  1264  
  1265    *ppPreStmt = 0;
  1266  
  1267    /* Trim spaces from the start of zSql and calculate the remaining length. */
  1268    while( (c = zSql[0])==' ' || c=='\t' || c=='\r' || c=='\n' ){ zSql++; }
  1269    nSql = strlen30(zSql);
  1270  
  1271    for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
  1272      int n = pPreStmt->nSql;
  1273      if( nSql>=n
  1274          && memcmp(pPreStmt->zSql, zSql, n)==0
  1275          && (zSql[n]==0 || zSql[n-1]==';')
  1276      ){
  1277        pStmt = pPreStmt->pStmt;
  1278        *pzOut = &zSql[pPreStmt->nSql];
  1279  
  1280        /* When a prepared statement is found, unlink it from the
  1281        ** cache list.  It will later be added back to the beginning
  1282        ** of the cache list in order to implement LRU replacement.
  1283        */
  1284        if( pPreStmt->pPrev ){
  1285          pPreStmt->pPrev->pNext = pPreStmt->pNext;
  1286        }else{
  1287          pDb->stmtList = pPreStmt->pNext;
  1288        }
  1289        if( pPreStmt->pNext ){
  1290          pPreStmt->pNext->pPrev = pPreStmt->pPrev;
  1291        }else{
  1292          pDb->stmtLast = pPreStmt->pPrev;
  1293        }
  1294        pDb->nStmt--;
  1295        nVar = sqlite3_bind_parameter_count(pStmt);
  1296        break;
  1297      }
  1298    }
  1299  
  1300    /* If no prepared statement was found. Compile the SQL text. Also allocate
  1301    ** a new SqlPreparedStmt structure.  */
  1302    if( pPreStmt==0 ){
  1303      int nByte;
  1304  
  1305      if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
  1306        Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1307        return TCL_ERROR;
  1308      }
  1309      if( pStmt==0 ){
  1310        if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
  1311          /* A compile-time error in the statement. */
  1312          Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1313          return TCL_ERROR;
  1314        }else{
  1315          /* The statement was a no-op.  Continue to the next statement
  1316          ** in the SQL string.
  1317          */
  1318          return TCL_OK;
  1319        }
  1320      }
  1321  
  1322      assert( pPreStmt==0 );
  1323      nVar = sqlite3_bind_parameter_count(pStmt);
  1324      nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
  1325      pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
  1326      memset(pPreStmt, 0, nByte);
  1327  
  1328      pPreStmt->pStmt = pStmt;
  1329      pPreStmt->nSql = (int)(*pzOut - zSql);
  1330      pPreStmt->zSql = sqlite3_sql(pStmt);
  1331      pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
  1332  #ifdef SQLITE_TEST
  1333      if( pPreStmt->zSql==0 ){
  1334        char *zCopy = Tcl_Alloc(pPreStmt->nSql + 1);
  1335        memcpy(zCopy, zSql, pPreStmt->nSql);
  1336        zCopy[pPreStmt->nSql] = '\0';
  1337        pPreStmt->zSql = zCopy;
  1338      }
  1339  #endif
  1340    }
  1341    assert( pPreStmt );
  1342    assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
  1343    assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
  1344  
  1345    /* Bind values to parameters that begin with $ or : */
  1346    for(i=1; i<=nVar; i++){
  1347      const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
  1348      if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
  1349        Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
  1350        if( pVar ){
  1351          int n;
  1352          u8 *data;
  1353          const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
  1354          c = zType[0];
  1355          if( zVar[0]=='@' ||
  1356             (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
  1357            /* Load a BLOB type if the Tcl variable is a bytearray and
  1358            ** it has no string representation or the host
  1359            ** parameter name begins with "@". */
  1360            data = Tcl_GetByteArrayFromObj(pVar, &n);
  1361            sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
  1362            Tcl_IncrRefCount(pVar);
  1363            pPreStmt->apParm[iParm++] = pVar;
  1364          }else if( c=='b' && strcmp(zType,"boolean")==0 ){
  1365            Tcl_GetIntFromObj(interp, pVar, &n);
  1366            sqlite3_bind_int(pStmt, i, n);
  1367          }else if( c=='d' && strcmp(zType,"double")==0 ){
  1368            double r;
  1369            Tcl_GetDoubleFromObj(interp, pVar, &r);
  1370            sqlite3_bind_double(pStmt, i, r);
  1371          }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
  1372                (c=='i' && strcmp(zType,"int")==0) ){
  1373            Tcl_WideInt v;
  1374            Tcl_GetWideIntFromObj(interp, pVar, &v);
  1375            sqlite3_bind_int64(pStmt, i, v);
  1376          }else{
  1377            data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
  1378            sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
  1379            Tcl_IncrRefCount(pVar);
  1380            pPreStmt->apParm[iParm++] = pVar;
  1381          }
  1382        }else{
  1383          sqlite3_bind_null(pStmt, i);
  1384        }
  1385      }
  1386    }
  1387    pPreStmt->nParm = iParm;
  1388    *ppPreStmt = pPreStmt;
  1389  
  1390    return TCL_OK;
  1391  }
  1392  
  1393  /*
  1394  ** Release a statement reference obtained by calling dbPrepareAndBind().
  1395  ** There should be exactly one call to this function for each call to
  1396  ** dbPrepareAndBind().
  1397  **
  1398  ** If the discard parameter is non-zero, then the statement is deleted
  1399  ** immediately. Otherwise it is added to the LRU list and may be returned
  1400  ** by a subsequent call to dbPrepareAndBind().
  1401  */
  1402  static void dbReleaseStmt(
  1403    SqliteDb *pDb,                  /* Database handle */
  1404    SqlPreparedStmt *pPreStmt,      /* Prepared statement handle to release */
  1405    int discard                     /* True to delete (not cache) the pPreStmt */
  1406  ){
  1407    int i;
  1408  
  1409    /* Free the bound string and blob parameters */
  1410    for(i=0; i<pPreStmt->nParm; i++){
  1411      Tcl_DecrRefCount(pPreStmt->apParm[i]);
  1412    }
  1413    pPreStmt->nParm = 0;
  1414  
  1415    if( pDb->maxStmt<=0 || discard ){
  1416      /* If the cache is turned off, deallocated the statement */
  1417      dbFreeStmt(pPreStmt);
  1418    }else{
  1419      /* Add the prepared statement to the beginning of the cache list. */
  1420      pPreStmt->pNext = pDb->stmtList;
  1421      pPreStmt->pPrev = 0;
  1422      if( pDb->stmtList ){
  1423       pDb->stmtList->pPrev = pPreStmt;
  1424      }
  1425      pDb->stmtList = pPreStmt;
  1426      if( pDb->stmtLast==0 ){
  1427        assert( pDb->nStmt==0 );
  1428        pDb->stmtLast = pPreStmt;
  1429      }else{
  1430        assert( pDb->nStmt>0 );
  1431      }
  1432      pDb->nStmt++;
  1433  
  1434      /* If we have too many statement in cache, remove the surplus from
  1435      ** the end of the cache list.  */
  1436      while( pDb->nStmt>pDb->maxStmt ){
  1437        SqlPreparedStmt *pLast = pDb->stmtLast;
  1438        pDb->stmtLast = pLast->pPrev;
  1439        pDb->stmtLast->pNext = 0;
  1440        pDb->nStmt--;
  1441        dbFreeStmt(pLast);
  1442      }
  1443    }
  1444  }
  1445  
  1446  /*
  1447  ** Structure used with dbEvalXXX() functions:
  1448  **
  1449  **   dbEvalInit()
  1450  **   dbEvalStep()
  1451  **   dbEvalFinalize()
  1452  **   dbEvalRowInfo()
  1453  **   dbEvalColumnValue()
  1454  */
  1455  typedef struct DbEvalContext DbEvalContext;
  1456  struct DbEvalContext {
  1457    SqliteDb *pDb;                  /* Database handle */
  1458    Tcl_Obj *pSql;                  /* Object holding string zSql */
  1459    const char *zSql;               /* Remaining SQL to execute */
  1460    SqlPreparedStmt *pPreStmt;      /* Current statement */
  1461    int nCol;                       /* Number of columns returned by pStmt */
  1462    int evalFlags;                  /* Flags used */
  1463    Tcl_Obj *pArray;                /* Name of array variable */
  1464    Tcl_Obj **apColName;            /* Array of column names */
  1465  };
  1466  
  1467  #define SQLITE_EVAL_WITHOUTNULLS  0x00001  /* Unset array(*) for NULL */
  1468  
  1469  /*
  1470  ** Release any cache of column names currently held as part of
  1471  ** the DbEvalContext structure passed as the first argument.
  1472  */
  1473  static void dbReleaseColumnNames(DbEvalContext *p){
  1474    if( p->apColName ){
  1475      int i;
  1476      for(i=0; i<p->nCol; i++){
  1477        Tcl_DecrRefCount(p->apColName[i]);
  1478      }
  1479      Tcl_Free((char *)p->apColName);
  1480      p->apColName = 0;
  1481    }
  1482    p->nCol = 0;
  1483  }
  1484  
  1485  /*
  1486  ** Initialize a DbEvalContext structure.
  1487  **
  1488  ** If pArray is not NULL, then it contains the name of a Tcl array
  1489  ** variable. The "*" member of this array is set to a list containing
  1490  ** the names of the columns returned by the statement as part of each
  1491  ** call to dbEvalStep(), in order from left to right. e.g. if the names
  1492  ** of the returned columns are a, b and c, it does the equivalent of the
  1493  ** tcl command:
  1494  **
  1495  **     set ${pArray}(*) {a b c}
  1496  */
  1497  static void dbEvalInit(
  1498    DbEvalContext *p,               /* Pointer to structure to initialize */
  1499    SqliteDb *pDb,                  /* Database handle */
  1500    Tcl_Obj *pSql,                  /* Object containing SQL script */
  1501    Tcl_Obj *pArray,                /* Name of Tcl array to set (*) element of */
  1502    int evalFlags                   /* Flags controlling evaluation */
  1503  ){
  1504    memset(p, 0, sizeof(DbEvalContext));
  1505    p->pDb = pDb;
  1506    p->zSql = Tcl_GetString(pSql);
  1507    p->pSql = pSql;
  1508    Tcl_IncrRefCount(pSql);
  1509    if( pArray ){
  1510      p->pArray = pArray;
  1511      Tcl_IncrRefCount(pArray);
  1512    }
  1513    p->evalFlags = evalFlags;
  1514  }
  1515  
  1516  /*
  1517  ** Obtain information about the row that the DbEvalContext passed as the
  1518  ** first argument currently points to.
  1519  */
  1520  static void dbEvalRowInfo(
  1521    DbEvalContext *p,               /* Evaluation context */
  1522    int *pnCol,                     /* OUT: Number of column names */
  1523    Tcl_Obj ***papColName           /* OUT: Array of column names */
  1524  ){
  1525    /* Compute column names */
  1526    if( 0==p->apColName ){
  1527      sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
  1528      int i;                        /* Iterator variable */
  1529      int nCol;                     /* Number of columns returned by pStmt */
  1530      Tcl_Obj **apColName = 0;      /* Array of column names */
  1531  
  1532      p->nCol = nCol = sqlite3_column_count(pStmt);
  1533      if( nCol>0 && (papColName || p->pArray) ){
  1534        apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
  1535        for(i=0; i<nCol; i++){
  1536          apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
  1537          Tcl_IncrRefCount(apColName[i]);
  1538        }
  1539        p->apColName = apColName;
  1540      }
  1541  
  1542      /* If results are being stored in an array variable, then create
  1543      ** the array(*) entry for that array
  1544      */
  1545      if( p->pArray ){
  1546        Tcl_Interp *interp = p->pDb->interp;
  1547        Tcl_Obj *pColList = Tcl_NewObj();
  1548        Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
  1549  
  1550        for(i=0; i<nCol; i++){
  1551          Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
  1552        }
  1553        Tcl_IncrRefCount(pStar);
  1554        Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
  1555        Tcl_DecrRefCount(pStar);
  1556      }
  1557    }
  1558  
  1559    if( papColName ){
  1560      *papColName = p->apColName;
  1561    }
  1562    if( pnCol ){
  1563      *pnCol = p->nCol;
  1564    }
  1565  }
  1566  
  1567  /*
  1568  ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
  1569  ** returned, then an error message is stored in the interpreter before
  1570  ** returning.
  1571  **
  1572  ** A return value of TCL_OK means there is a row of data available. The
  1573  ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
  1574  ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
  1575  ** is returned, then the SQL script has finished executing and there are
  1576  ** no further rows available. This is similar to SQLITE_DONE.
  1577  */
  1578  static int dbEvalStep(DbEvalContext *p){
  1579    const char *zPrevSql = 0;       /* Previous value of p->zSql */
  1580  
  1581    while( p->zSql[0] || p->pPreStmt ){
  1582      int rc;
  1583      if( p->pPreStmt==0 ){
  1584        zPrevSql = (p->zSql==zPrevSql ? 0 : p->zSql);
  1585        rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
  1586        if( rc!=TCL_OK ) return rc;
  1587      }else{
  1588        int rcs;
  1589        SqliteDb *pDb = p->pDb;
  1590        SqlPreparedStmt *pPreStmt = p->pPreStmt;
  1591        sqlite3_stmt *pStmt = pPreStmt->pStmt;
  1592  
  1593        rcs = sqlite3_step(pStmt);
  1594        if( rcs==SQLITE_ROW ){
  1595          return TCL_OK;
  1596        }
  1597        if( p->pArray ){
  1598          dbEvalRowInfo(p, 0, 0);
  1599        }
  1600        rcs = sqlite3_reset(pStmt);
  1601  
  1602        pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
  1603        pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
  1604        pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
  1605        pDb->nVMStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_VM_STEP,1);
  1606        dbReleaseColumnNames(p);
  1607        p->pPreStmt = 0;
  1608  
  1609        if( rcs!=SQLITE_OK ){
  1610          /* If a run-time error occurs, report the error and stop reading
  1611          ** the SQL.  */
  1612          dbReleaseStmt(pDb, pPreStmt, 1);
  1613  #if SQLITE_TEST
  1614          if( p->pDb->bLegacyPrepare && rcs==SQLITE_SCHEMA && zPrevSql ){
  1615            /* If the runtime error was an SQLITE_SCHEMA, and the database
  1616            ** handle is configured to use the legacy sqlite3_prepare()
  1617            ** interface, retry prepare()/step() on the same SQL statement.
  1618            ** This only happens once. If there is a second SQLITE_SCHEMA
  1619            ** error, the error will be returned to the caller. */
  1620            p->zSql = zPrevSql;
  1621            continue;
  1622          }
  1623  #endif
  1624          Tcl_SetObjResult(pDb->interp,
  1625                           Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1626          return TCL_ERROR;
  1627        }else{
  1628          dbReleaseStmt(pDb, pPreStmt, 0);
  1629        }
  1630      }
  1631    }
  1632  
  1633    /* Finished */
  1634    return TCL_BREAK;
  1635  }
  1636  
  1637  /*
  1638  ** Free all resources currently held by the DbEvalContext structure passed
  1639  ** as the first argument. There should be exactly one call to this function
  1640  ** for each call to dbEvalInit().
  1641  */
  1642  static void dbEvalFinalize(DbEvalContext *p){
  1643    if( p->pPreStmt ){
  1644      sqlite3_reset(p->pPreStmt->pStmt);
  1645      dbReleaseStmt(p->pDb, p->pPreStmt, 0);
  1646      p->pPreStmt = 0;
  1647    }
  1648    if( p->pArray ){
  1649      Tcl_DecrRefCount(p->pArray);
  1650      p->pArray = 0;
  1651    }
  1652    Tcl_DecrRefCount(p->pSql);
  1653    dbReleaseColumnNames(p);
  1654  }
  1655  
  1656  /*
  1657  ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
  1658  ** the value for the iCol'th column of the row currently pointed to by
  1659  ** the DbEvalContext structure passed as the first argument.
  1660  */
  1661  static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
  1662    sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
  1663    switch( sqlite3_column_type(pStmt, iCol) ){
  1664      case SQLITE_BLOB: {
  1665        int bytes = sqlite3_column_bytes(pStmt, iCol);
  1666        const char *zBlob = sqlite3_column_blob(pStmt, iCol);
  1667        if( !zBlob ) bytes = 0;
  1668        return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
  1669      }
  1670      case SQLITE_INTEGER: {
  1671        sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
  1672        if( v>=-2147483647 && v<=2147483647 ){
  1673          return Tcl_NewIntObj((int)v);
  1674        }else{
  1675          return Tcl_NewWideIntObj(v);
  1676        }
  1677      }
  1678      case SQLITE_FLOAT: {
  1679        return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
  1680      }
  1681      case SQLITE_NULL: {
  1682        return Tcl_NewStringObj(p->pDb->zNull, -1);
  1683      }
  1684    }
  1685  
  1686    return Tcl_NewStringObj((char*)sqlite3_column_text(pStmt, iCol), -1);
  1687  }
  1688  
  1689  /*
  1690  ** If using Tcl version 8.6 or greater, use the NR functions to avoid
  1691  ** recursive evalution of scripts by the [db eval] and [db trans]
  1692  ** commands. Even if the headers used while compiling the extension
  1693  ** are 8.6 or newer, the code still tests the Tcl version at runtime.
  1694  ** This allows stubs-enabled builds to be used with older Tcl libraries.
  1695  */
  1696  #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
  1697  # define SQLITE_TCL_NRE 1
  1698  static int DbUseNre(void){
  1699    int major, minor;
  1700    Tcl_GetVersion(&major, &minor, 0, 0);
  1701    return( (major==8 && minor>=6) || major>8 );
  1702  }
  1703  #else
  1704  /*
  1705  ** Compiling using headers earlier than 8.6. In this case NR cannot be
  1706  ** used, so DbUseNre() to always return zero. Add #defines for the other
  1707  ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
  1708  ** even though the only invocations of them are within conditional blocks
  1709  ** of the form:
  1710  **
  1711  **   if( DbUseNre() ) { ... }
  1712  */
  1713  # define SQLITE_TCL_NRE 0
  1714  # define DbUseNre() 0
  1715  # define Tcl_NRAddCallback(a,b,c,d,e,f) (void)0
  1716  # define Tcl_NREvalObj(a,b,c) 0
  1717  # define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
  1718  #endif
  1719  
  1720  /*
  1721  ** This function is part of the implementation of the command:
  1722  **
  1723  **   $db eval SQL ?ARRAYNAME? SCRIPT
  1724  */
  1725  static int SQLITE_TCLAPI DbEvalNextCmd(
  1726    ClientData data[],                   /* data[0] is the (DbEvalContext*) */
  1727    Tcl_Interp *interp,                  /* Tcl interpreter */
  1728    int result                           /* Result so far */
  1729  ){
  1730    int rc = result;                     /* Return code */
  1731  
  1732    /* The first element of the data[] array is a pointer to a DbEvalContext
  1733    ** structure allocated using Tcl_Alloc(). The second element of data[]
  1734    ** is a pointer to a Tcl_Obj containing the script to run for each row
  1735    ** returned by the queries encapsulated in data[0]. */
  1736    DbEvalContext *p = (DbEvalContext *)data[0];
  1737    Tcl_Obj *pScript = (Tcl_Obj *)data[1];
  1738    Tcl_Obj *pArray = p->pArray;
  1739  
  1740    while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
  1741      int i;
  1742      int nCol;
  1743      Tcl_Obj **apColName;
  1744      dbEvalRowInfo(p, &nCol, &apColName);
  1745      for(i=0; i<nCol; i++){
  1746        if( pArray==0 ){
  1747          Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
  1748        }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
  1749               && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL 
  1750        ){
  1751          Tcl_UnsetVar2(interp, Tcl_GetString(pArray), 
  1752                        Tcl_GetString(apColName[i]), 0);
  1753        }else{
  1754          Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
  1755        }
  1756      }
  1757  
  1758      /* The required interpreter variables are now populated with the data
  1759      ** from the current row. If using NRE, schedule callbacks to evaluate
  1760      ** script pScript, then to invoke this function again to fetch the next
  1761      ** row (or clean up if there is no next row or the script throws an
  1762      ** exception). After scheduling the callbacks, return control to the
  1763      ** caller.
  1764      **
  1765      ** If not using NRE, evaluate pScript directly and continue with the
  1766      ** next iteration of this while(...) loop.  */
  1767      if( DbUseNre() ){
  1768        Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
  1769        return Tcl_NREvalObj(interp, pScript, 0);
  1770      }else{
  1771        rc = Tcl_EvalObjEx(interp, pScript, 0);
  1772      }
  1773    }
  1774  
  1775    Tcl_DecrRefCount(pScript);
  1776    dbEvalFinalize(p);
  1777    Tcl_Free((char *)p);
  1778  
  1779    if( rc==TCL_OK || rc==TCL_BREAK ){
  1780      Tcl_ResetResult(interp);
  1781      rc = TCL_OK;
  1782    }
  1783    return rc;
  1784  }
  1785  
  1786  /*
  1787  ** This function is used by the implementations of the following database
  1788  ** handle sub-commands:
  1789  **
  1790  **   $db update_hook ?SCRIPT?
  1791  **   $db wal_hook ?SCRIPT?
  1792  **   $db commit_hook ?SCRIPT?
  1793  **   $db preupdate hook ?SCRIPT?
  1794  */
  1795  static void DbHookCmd(
  1796    Tcl_Interp *interp,             /* Tcl interpreter */
  1797    SqliteDb *pDb,                  /* Database handle */
  1798    Tcl_Obj *pArg,                  /* SCRIPT argument (or NULL) */
  1799    Tcl_Obj **ppHook                /* Pointer to member of SqliteDb */
  1800  ){
  1801    sqlite3 *db = pDb->db;
  1802  
  1803    if( *ppHook ){
  1804      Tcl_SetObjResult(interp, *ppHook);
  1805      if( pArg ){
  1806        Tcl_DecrRefCount(*ppHook);
  1807        *ppHook = 0;
  1808      }
  1809    }
  1810    if( pArg ){
  1811      assert( !(*ppHook) );
  1812      if( Tcl_GetCharLength(pArg)>0 ){
  1813        *ppHook = pArg;
  1814        Tcl_IncrRefCount(*ppHook);
  1815      }
  1816    }
  1817  
  1818  #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
  1819    sqlite3_preupdate_hook(db, (pDb->pPreUpdateHook?DbPreUpdateHandler:0), pDb);
  1820  #endif
  1821    sqlite3_update_hook(db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
  1822    sqlite3_rollback_hook(db, (pDb->pRollbackHook?DbRollbackHandler:0), pDb);
  1823    sqlite3_wal_hook(db, (pDb->pWalHook?DbWalHandler:0), pDb);
  1824  }
  1825  
  1826  /*
  1827  ** The "sqlite" command below creates a new Tcl command for each
  1828  ** connection it opens to an SQLite database.  This routine is invoked
  1829  ** whenever one of those connection-specific commands is executed
  1830  ** in Tcl.  For example, if you run Tcl code like this:
  1831  **
  1832  **       sqlite3 db1  "my_database"
  1833  **       db1 close
  1834  **
  1835  ** The first command opens a connection to the "my_database" database
  1836  ** and calls that connection "db1".  The second command causes this
  1837  ** subroutine to be invoked.
  1838  */
  1839  static int SQLITE_TCLAPI DbObjCmd(
  1840    void *cd,
  1841    Tcl_Interp *interp,
  1842    int objc,
  1843    Tcl_Obj *const*objv
  1844  ){
  1845    SqliteDb *pDb = (SqliteDb*)cd;
  1846    int choice;
  1847    int rc = TCL_OK;
  1848    static const char *DB_strs[] = {
  1849      "authorizer",         "backup",            "busy",
  1850      "cache",              "changes",           "close",
  1851      "collate",            "collation_needed",  "commit_hook",
  1852      "complete",           "copy",              "enable_load_extension",
  1853      "errorcode",          "eval",              "exists",
  1854      "function",           "incrblob",          "interrupt",
  1855      "last_insert_rowid",  "nullvalue",         "onecolumn",
  1856      "preupdate",          "profile",           "progress",
  1857      "rekey",              "restore",           "rollback_hook",
  1858      "status",             "timeout",           "total_changes",
  1859      "trace",              "trace_v2",          "transaction",
  1860      "unlock_notify",      "update_hook",       "version",
  1861      "wal_hook",
  1862      0
  1863    };
  1864    enum DB_enum {
  1865      DB_AUTHORIZER,        DB_BACKUP,           DB_BUSY,
  1866      DB_CACHE,             DB_CHANGES,          DB_CLOSE,
  1867      DB_COLLATE,           DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
  1868      DB_COMPLETE,          DB_COPY,             DB_ENABLE_LOAD_EXTENSION,
  1869      DB_ERRORCODE,         DB_EVAL,             DB_EXISTS,
  1870      DB_FUNCTION,          DB_INCRBLOB,         DB_INTERRUPT,
  1871      DB_LAST_INSERT_ROWID, DB_NULLVALUE,        DB_ONECOLUMN,
  1872      DB_PREUPDATE,         DB_PROFILE,          DB_PROGRESS,
  1873      DB_REKEY,             DB_RESTORE,          DB_ROLLBACK_HOOK,
  1874      DB_STATUS,            DB_TIMEOUT,          DB_TOTAL_CHANGES,
  1875      DB_TRACE,             DB_TRACE_V2,         DB_TRANSACTION,
  1876      DB_UNLOCK_NOTIFY,     DB_UPDATE_HOOK,      DB_VERSION,
  1877      DB_WAL_HOOK,
  1878    };
  1879    /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
  1880  
  1881    if( objc<2 ){
  1882      Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
  1883      return TCL_ERROR;
  1884    }
  1885    if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
  1886      return TCL_ERROR;
  1887    }
  1888  
  1889    switch( (enum DB_enum)choice ){
  1890  
  1891    /*    $db authorizer ?CALLBACK?
  1892    **
  1893    ** Invoke the given callback to authorize each SQL operation as it is
  1894    ** compiled.  5 arguments are appended to the callback before it is
  1895    ** invoked:
  1896    **
  1897    **   (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
  1898    **   (2) First descriptive name (depends on authorization type)
  1899    **   (3) Second descriptive name
  1900    **   (4) Name of the database (ex: "main", "temp")
  1901    **   (5) Name of trigger that is doing the access
  1902    **
  1903    ** The callback should return on of the following strings: SQLITE_OK,
  1904    ** SQLITE_IGNORE, or SQLITE_DENY.  Any other return value is an error.
  1905    **
  1906    ** If this method is invoked with no arguments, the current authorization
  1907    ** callback string is returned.
  1908    */
  1909    case DB_AUTHORIZER: {
  1910  #ifdef SQLITE_OMIT_AUTHORIZATION
  1911      Tcl_AppendResult(interp, "authorization not available in this build",
  1912                       (char*)0);
  1913      return TCL_ERROR;
  1914  #else
  1915      if( objc>3 ){
  1916        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
  1917        return TCL_ERROR;
  1918      }else if( objc==2 ){
  1919        if( pDb->zAuth ){
  1920          Tcl_AppendResult(interp, pDb->zAuth, (char*)0);
  1921        }
  1922      }else{
  1923        char *zAuth;
  1924        int len;
  1925        if( pDb->zAuth ){
  1926          Tcl_Free(pDb->zAuth);
  1927        }
  1928        zAuth = Tcl_GetStringFromObj(objv[2], &len);
  1929        if( zAuth && len>0 ){
  1930          pDb->zAuth = Tcl_Alloc( len + 1 );
  1931          memcpy(pDb->zAuth, zAuth, len+1);
  1932        }else{
  1933          pDb->zAuth = 0;
  1934        }
  1935        if( pDb->zAuth ){
  1936          typedef int (*sqlite3_auth_cb)(
  1937             void*,int,const char*,const char*,
  1938             const char*,const char*);
  1939          pDb->interp = interp;
  1940          sqlite3_set_authorizer(pDb->db,(sqlite3_auth_cb)auth_callback,pDb);
  1941        }else{
  1942          sqlite3_set_authorizer(pDb->db, 0, 0);
  1943        }
  1944      }
  1945  #endif
  1946      break;
  1947    }
  1948  
  1949    /*    $db backup ?DATABASE? FILENAME
  1950    **
  1951    ** Open or create a database file named FILENAME.  Transfer the
  1952    ** content of local database DATABASE (default: "main") into the
  1953    ** FILENAME database.
  1954    */
  1955    case DB_BACKUP: {
  1956      const char *zDestFile;
  1957      const char *zSrcDb;
  1958      sqlite3 *pDest;
  1959      sqlite3_backup *pBackup;
  1960  
  1961      if( objc==3 ){
  1962        zSrcDb = "main";
  1963        zDestFile = Tcl_GetString(objv[2]);
  1964      }else if( objc==4 ){
  1965        zSrcDb = Tcl_GetString(objv[2]);
  1966        zDestFile = Tcl_GetString(objv[3]);
  1967      }else{
  1968        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
  1969        return TCL_ERROR;
  1970      }
  1971      rc = sqlite3_open_v2(zDestFile, &pDest,
  1972                 SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE| pDb->openFlags, 0);
  1973      if( rc!=SQLITE_OK ){
  1974        Tcl_AppendResult(interp, "cannot open target database: ",
  1975             sqlite3_errmsg(pDest), (char*)0);
  1976        sqlite3_close(pDest);
  1977        return TCL_ERROR;
  1978      }
  1979      pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
  1980      if( pBackup==0 ){
  1981        Tcl_AppendResult(interp, "backup failed: ",
  1982             sqlite3_errmsg(pDest), (char*)0);
  1983        sqlite3_close(pDest);
  1984        return TCL_ERROR;
  1985      }
  1986      while(  (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
  1987      sqlite3_backup_finish(pBackup);
  1988      if( rc==SQLITE_DONE ){
  1989        rc = TCL_OK;
  1990      }else{
  1991        Tcl_AppendResult(interp, "backup failed: ",
  1992             sqlite3_errmsg(pDest), (char*)0);
  1993        rc = TCL_ERROR;
  1994      }
  1995      sqlite3_close(pDest);
  1996      break;
  1997    }
  1998  
  1999    /*    $db busy ?CALLBACK?
  2000    **
  2001    ** Invoke the given callback if an SQL statement attempts to open
  2002    ** a locked database file.
  2003    */
  2004    case DB_BUSY: {
  2005      if( objc>3 ){
  2006        Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
  2007        return TCL_ERROR;
  2008      }else if( objc==2 ){
  2009        if( pDb->zBusy ){
  2010          Tcl_AppendResult(interp, pDb->zBusy, (char*)0);
  2011        }
  2012      }else{
  2013        char *zBusy;
  2014        int len;
  2015        if( pDb->zBusy ){
  2016          Tcl_Free(pDb->zBusy);
  2017        }
  2018        zBusy = Tcl_GetStringFromObj(objv[2], &len);
  2019        if( zBusy && len>0 ){
  2020          pDb->zBusy = Tcl_Alloc( len + 1 );
  2021          memcpy(pDb->zBusy, zBusy, len+1);
  2022        }else{
  2023          pDb->zBusy = 0;
  2024        }
  2025        if( pDb->zBusy ){
  2026          pDb->interp = interp;
  2027          sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
  2028        }else{
  2029          sqlite3_busy_handler(pDb->db, 0, 0);
  2030        }
  2031      }
  2032      break;
  2033    }
  2034  
  2035    /*     $db cache flush
  2036    **     $db cache size n
  2037    **
  2038    ** Flush the prepared statement cache, or set the maximum number of
  2039    ** cached statements.
  2040    */
  2041    case DB_CACHE: {
  2042      char *subCmd;
  2043      int n;
  2044  
  2045      if( objc<=2 ){
  2046        Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
  2047        return TCL_ERROR;
  2048      }
  2049      subCmd = Tcl_GetStringFromObj( objv[2], 0 );
  2050      if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
  2051        if( objc!=3 ){
  2052          Tcl_WrongNumArgs(interp, 2, objv, "flush");
  2053          return TCL_ERROR;
  2054        }else{
  2055          flushStmtCache( pDb );
  2056        }
  2057      }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
  2058        if( objc!=4 ){
  2059          Tcl_WrongNumArgs(interp, 2, objv, "size n");
  2060          return TCL_ERROR;
  2061        }else{
  2062          if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
  2063            Tcl_AppendResult( interp, "cannot convert \"",
  2064                 Tcl_GetStringFromObj(objv[3],0), "\" to integer", (char*)0);
  2065            return TCL_ERROR;
  2066          }else{
  2067            if( n<0 ){
  2068              flushStmtCache( pDb );
  2069              n = 0;
  2070            }else if( n>MAX_PREPARED_STMTS ){
  2071              n = MAX_PREPARED_STMTS;
  2072            }
  2073            pDb->maxStmt = n;
  2074          }
  2075        }
  2076      }else{
  2077        Tcl_AppendResult( interp, "bad option \"",
  2078            Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size",
  2079            (char*)0);
  2080        return TCL_ERROR;
  2081      }
  2082      break;
  2083    }
  2084  
  2085    /*     $db changes
  2086    **
  2087    ** Return the number of rows that were modified, inserted, or deleted by
  2088    ** the most recent INSERT, UPDATE or DELETE statement, not including
  2089    ** any changes made by trigger programs.
  2090    */
  2091    case DB_CHANGES: {
  2092      Tcl_Obj *pResult;
  2093      if( objc!=2 ){
  2094        Tcl_WrongNumArgs(interp, 2, objv, "");
  2095        return TCL_ERROR;
  2096      }
  2097      pResult = Tcl_GetObjResult(interp);
  2098      Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
  2099      break;
  2100    }
  2101  
  2102    /*    $db close
  2103    **
  2104    ** Shutdown the database
  2105    */
  2106    case DB_CLOSE: {
  2107      Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
  2108      break;
  2109    }
  2110  
  2111    /*
  2112    **     $db collate NAME SCRIPT
  2113    **
  2114    ** Create a new SQL collation function called NAME.  Whenever
  2115    ** that function is called, invoke SCRIPT to evaluate the function.
  2116    */
  2117    case DB_COLLATE: {
  2118      SqlCollate *pCollate;
  2119      char *zName;
  2120      char *zScript;
  2121      int nScript;
  2122      if( objc!=4 ){
  2123        Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
  2124        return TCL_ERROR;
  2125      }
  2126      zName = Tcl_GetStringFromObj(objv[2], 0);
  2127      zScript = Tcl_GetStringFromObj(objv[3], &nScript);
  2128      pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
  2129      if( pCollate==0 ) return TCL_ERROR;
  2130      pCollate->interp = interp;
  2131      pCollate->pNext = pDb->pCollate;
  2132      pCollate->zScript = (char*)&pCollate[1];
  2133      pDb->pCollate = pCollate;
  2134      memcpy(pCollate->zScript, zScript, nScript+1);
  2135      if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
  2136          pCollate, tclSqlCollate) ){
  2137        Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
  2138        return TCL_ERROR;
  2139      }
  2140      break;
  2141    }
  2142  
  2143    /*
  2144    **     $db collation_needed SCRIPT
  2145    **
  2146    ** Create a new SQL collation function called NAME.  Whenever
  2147    ** that function is called, invoke SCRIPT to evaluate the function.
  2148    */
  2149    case DB_COLLATION_NEEDED: {
  2150      if( objc!=3 ){
  2151        Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
  2152        return TCL_ERROR;
  2153      }
  2154      if( pDb->pCollateNeeded ){
  2155        Tcl_DecrRefCount(pDb->pCollateNeeded);
  2156      }
  2157      pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
  2158      Tcl_IncrRefCount(pDb->pCollateNeeded);
  2159      sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
  2160      break;
  2161    }
  2162  
  2163    /*    $db commit_hook ?CALLBACK?
  2164    **
  2165    ** Invoke the given callback just before committing every SQL transaction.
  2166    ** If the callback throws an exception or returns non-zero, then the
  2167    ** transaction is aborted.  If CALLBACK is an empty string, the callback
  2168    ** is disabled.
  2169    */
  2170    case DB_COMMIT_HOOK: {
  2171      if( objc>3 ){
  2172        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
  2173        return TCL_ERROR;
  2174      }else if( objc==2 ){
  2175        if( pDb->zCommit ){
  2176          Tcl_AppendResult(interp, pDb->zCommit, (char*)0);
  2177        }
  2178      }else{
  2179        const char *zCommit;
  2180        int len;
  2181        if( pDb->zCommit ){
  2182          Tcl_Free(pDb->zCommit);
  2183        }
  2184        zCommit = Tcl_GetStringFromObj(objv[2], &len);
  2185        if( zCommit && len>0 ){
  2186          pDb->zCommit = Tcl_Alloc( len + 1 );
  2187          memcpy(pDb->zCommit, zCommit, len+1);
  2188        }else{
  2189          pDb->zCommit = 0;
  2190        }
  2191        if( pDb->zCommit ){
  2192          pDb->interp = interp;
  2193          sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
  2194        }else{
  2195          sqlite3_commit_hook(pDb->db, 0, 0);
  2196        }
  2197      }
  2198      break;
  2199    }
  2200  
  2201    /*    $db complete SQL
  2202    **
  2203    ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
  2204    ** additional lines of input are needed.  This is similar to the
  2205    ** built-in "info complete" command of Tcl.
  2206    */
  2207    case DB_COMPLETE: {
  2208  #ifndef SQLITE_OMIT_COMPLETE
  2209      Tcl_Obj *pResult;
  2210      int isComplete;
  2211      if( objc!=3 ){
  2212        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
  2213        return TCL_ERROR;
  2214      }
  2215      isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
  2216      pResult = Tcl_GetObjResult(interp);
  2217      Tcl_SetBooleanObj(pResult, isComplete);
  2218  #endif
  2219      break;
  2220    }
  2221  
  2222    /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
  2223    **
  2224    ** Copy data into table from filename, optionally using SEPARATOR
  2225    ** as column separators.  If a column contains a null string, or the
  2226    ** value of NULLINDICATOR, a NULL is inserted for the column.
  2227    ** conflict-algorithm is one of the sqlite conflict algorithms:
  2228    **    rollback, abort, fail, ignore, replace
  2229    ** On success, return the number of lines processed, not necessarily same
  2230    ** as 'db changes' due to conflict-algorithm selected.
  2231    **
  2232    ** This code is basically an implementation/enhancement of
  2233    ** the sqlite3 shell.c ".import" command.
  2234    **
  2235    ** This command usage is equivalent to the sqlite2.x COPY statement,
  2236    ** which imports file data into a table using the PostgreSQL COPY file format:
  2237    **   $db copy $conflit_algo $table_name $filename \t \\N
  2238    */
  2239    case DB_COPY: {
  2240      char *zTable;               /* Insert data into this table */
  2241      char *zFile;                /* The file from which to extract data */
  2242      char *zConflict;            /* The conflict algorithm to use */
  2243      sqlite3_stmt *pStmt;        /* A statement */
  2244      int nCol;                   /* Number of columns in the table */
  2245      int nByte;                  /* Number of bytes in an SQL string */
  2246      int i, j;                   /* Loop counters */
  2247      int nSep;                   /* Number of bytes in zSep[] */
  2248      int nNull;                  /* Number of bytes in zNull[] */
  2249      char *zSql;                 /* An SQL statement */
  2250      char *zLine;                /* A single line of input from the file */
  2251      char **azCol;               /* zLine[] broken up into columns */
  2252      const char *zCommit;        /* How to commit changes */
  2253      FILE *in;                   /* The input file */
  2254      int lineno = 0;             /* Line number of input file */
  2255      char zLineNum[80];          /* Line number print buffer */
  2256      Tcl_Obj *pResult;           /* interp result */
  2257  
  2258      const char *zSep;
  2259      const char *zNull;
  2260      if( objc<5 || objc>7 ){
  2261        Tcl_WrongNumArgs(interp, 2, objv,
  2262           "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
  2263        return TCL_ERROR;
  2264      }
  2265      if( objc>=6 ){
  2266        zSep = Tcl_GetStringFromObj(objv[5], 0);
  2267      }else{
  2268        zSep = "\t";
  2269      }
  2270      if( objc>=7 ){
  2271        zNull = Tcl_GetStringFromObj(objv[6], 0);
  2272      }else{
  2273        zNull = "";
  2274      }
  2275      zConflict = Tcl_GetStringFromObj(objv[2], 0);
  2276      zTable = Tcl_GetStringFromObj(objv[3], 0);
  2277      zFile = Tcl_GetStringFromObj(objv[4], 0);
  2278      nSep = strlen30(zSep);
  2279      nNull = strlen30(zNull);
  2280      if( nSep==0 ){
  2281        Tcl_AppendResult(interp,"Error: non-null separator required for copy",
  2282                         (char*)0);
  2283        return TCL_ERROR;
  2284      }
  2285      if(strcmp(zConflict, "rollback") != 0 &&
  2286         strcmp(zConflict, "abort"   ) != 0 &&
  2287         strcmp(zConflict, "fail"    ) != 0 &&
  2288         strcmp(zConflict, "ignore"  ) != 0 &&
  2289         strcmp(zConflict, "replace" ) != 0 ) {
  2290        Tcl_AppendResult(interp, "Error: \"", zConflict,
  2291              "\", conflict-algorithm must be one of: rollback, "
  2292              "abort, fail, ignore, or replace", (char*)0);
  2293        return TCL_ERROR;
  2294      }
  2295      zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
  2296      if( zSql==0 ){
  2297        Tcl_AppendResult(interp, "Error: no such table: ", zTable, (char*)0);
  2298        return TCL_ERROR;
  2299      }
  2300      nByte = strlen30(zSql);
  2301      rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
  2302      sqlite3_free(zSql);
  2303      if( rc ){
  2304        Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
  2305        nCol = 0;
  2306      }else{
  2307        nCol = sqlite3_column_count(pStmt);
  2308      }
  2309      sqlite3_finalize(pStmt);
  2310      if( nCol==0 ) {
  2311        return TCL_ERROR;
  2312      }
  2313      zSql = malloc( nByte + 50 + nCol*2 );
  2314      if( zSql==0 ) {
  2315        Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
  2316        return TCL_ERROR;
  2317      }
  2318      sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
  2319           zConflict, zTable);
  2320      j = strlen30(zSql);
  2321      for(i=1; i<nCol; i++){
  2322        zSql[j++] = ',';
  2323        zSql[j++] = '?';
  2324      }
  2325      zSql[j++] = ')';
  2326      zSql[j] = 0;
  2327      rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
  2328      free(zSql);
  2329      if( rc ){
  2330        Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
  2331        sqlite3_finalize(pStmt);
  2332        return TCL_ERROR;
  2333      }
  2334      in = fopen(zFile, "rb");
  2335      if( in==0 ){
  2336        Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0);
  2337        sqlite3_finalize(pStmt);
  2338        return TCL_ERROR;
  2339      }
  2340      azCol = malloc( sizeof(azCol[0])*(nCol+1) );
  2341      if( azCol==0 ) {
  2342        Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
  2343        fclose(in);
  2344        return TCL_ERROR;
  2345      }
  2346      (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
  2347      zCommit = "COMMIT";
  2348      while( (zLine = local_getline(0, in))!=0 ){
  2349        char *z;
  2350        lineno++;
  2351        azCol[0] = zLine;
  2352        for(i=0, z=zLine; *z; z++){
  2353          if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
  2354            *z = 0;
  2355            i++;
  2356            if( i<nCol ){
  2357              azCol[i] = &z[nSep];
  2358              z += nSep-1;
  2359            }
  2360          }
  2361        }
  2362        if( i+1!=nCol ){
  2363          char *zErr;
  2364          int nErr = strlen30(zFile) + 200;
  2365          zErr = malloc(nErr);
  2366          if( zErr ){
  2367            sqlite3_snprintf(nErr, zErr,
  2368               "Error: %s line %d: expected %d columns of data but found %d",
  2369               zFile, lineno, nCol, i+1);
  2370            Tcl_AppendResult(interp, zErr, (char*)0);
  2371            free(zErr);
  2372          }
  2373          zCommit = "ROLLBACK";
  2374          break;
  2375        }
  2376        for(i=0; i<nCol; i++){
  2377          /* check for null data, if so, bind as null */
  2378          if( (nNull>0 && strcmp(azCol[i], zNull)==0)
  2379            || strlen30(azCol[i])==0
  2380          ){
  2381            sqlite3_bind_null(pStmt, i+1);
  2382          }else{
  2383            sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
  2384          }
  2385        }
  2386        sqlite3_step(pStmt);
  2387        rc = sqlite3_reset(pStmt);
  2388        free(zLine);
  2389        if( rc!=SQLITE_OK ){
  2390          Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0);
  2391          zCommit = "ROLLBACK";
  2392          break;
  2393        }
  2394      }
  2395      free(azCol);
  2396      fclose(in);
  2397      sqlite3_finalize(pStmt);
  2398      (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
  2399  
  2400      if( zCommit[0] == 'C' ){
  2401        /* success, set result as number of lines processed */
  2402        pResult = Tcl_GetObjResult(interp);
  2403        Tcl_SetIntObj(pResult, lineno);
  2404        rc = TCL_OK;
  2405      }else{
  2406        /* failure, append lineno where failed */
  2407        sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
  2408        Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,
  2409                         (char*)0);
  2410        rc = TCL_ERROR;
  2411      }
  2412      break;
  2413    }
  2414  
  2415    /*
  2416    **    $db enable_load_extension BOOLEAN
  2417    **
  2418    ** Turn the extension loading feature on or off.  It if off by
  2419    ** default.
  2420    */
  2421    case DB_ENABLE_LOAD_EXTENSION: {
  2422  #ifndef SQLITE_OMIT_LOAD_EXTENSION
  2423      int onoff;
  2424      if( objc!=3 ){
  2425        Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
  2426        return TCL_ERROR;
  2427      }
  2428      if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
  2429        return TCL_ERROR;
  2430      }
  2431      sqlite3_enable_load_extension(pDb->db, onoff);
  2432      break;
  2433  #else
  2434      Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
  2435                       (char*)0);
  2436      return TCL_ERROR;
  2437  #endif
  2438    }
  2439  
  2440    /*
  2441    **    $db errorcode
  2442    **
  2443    ** Return the numeric error code that was returned by the most recent
  2444    ** call to sqlite3_exec().
  2445    */
  2446    case DB_ERRORCODE: {
  2447      Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
  2448      break;
  2449    }
  2450  
  2451    /*
  2452    **    $db exists $sql
  2453    **    $db onecolumn $sql
  2454    **
  2455    ** The onecolumn method is the equivalent of:
  2456    **     lindex [$db eval $sql] 0
  2457    */
  2458    case DB_EXISTS:
  2459    case DB_ONECOLUMN: {
  2460      Tcl_Obj *pResult = 0;
  2461      DbEvalContext sEval;
  2462      if( objc!=3 ){
  2463        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
  2464        return TCL_ERROR;
  2465      }
  2466  
  2467      dbEvalInit(&sEval, pDb, objv[2], 0, 0);
  2468      rc = dbEvalStep(&sEval);
  2469      if( choice==DB_ONECOLUMN ){
  2470        if( rc==TCL_OK ){
  2471          pResult = dbEvalColumnValue(&sEval, 0);
  2472        }else if( rc==TCL_BREAK ){
  2473          Tcl_ResetResult(interp);
  2474        }
  2475      }else if( rc==TCL_BREAK || rc==TCL_OK ){
  2476        pResult = Tcl_NewBooleanObj(rc==TCL_OK);
  2477      }
  2478      dbEvalFinalize(&sEval);
  2479      if( pResult ) Tcl_SetObjResult(interp, pResult);
  2480  
  2481      if( rc==TCL_BREAK ){
  2482        rc = TCL_OK;
  2483      }
  2484      break;
  2485    }
  2486  
  2487    /*
  2488    **    $db eval ?options? $sql ?array? ?{  ...code... }?
  2489    **
  2490    ** The SQL statement in $sql is evaluated.  For each row, the values are
  2491    ** placed in elements of the array named "array" and ...code... is executed.
  2492    ** If "array" and "code" are omitted, then no callback is every invoked.
  2493    ** If "array" is an empty string, then the values are placed in variables
  2494    ** that have the same name as the fields extracted by the query.
  2495    */
  2496    case DB_EVAL: {
  2497      int evalFlags = 0;
  2498      const char *zOpt;
  2499      while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
  2500        if( strcmp(zOpt, "-withoutnulls")==0 ){
  2501          evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
  2502        }
  2503        else{
  2504          Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
  2505          return TCL_ERROR;
  2506        }
  2507        objc--;
  2508        objv++;
  2509      }
  2510      if( objc<3 || objc>5 ){
  2511        Tcl_WrongNumArgs(interp, 2, objv, 
  2512            "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
  2513        return TCL_ERROR;
  2514      }
  2515  
  2516      if( objc==3 ){
  2517        DbEvalContext sEval;
  2518        Tcl_Obj *pRet = Tcl_NewObj();
  2519        Tcl_IncrRefCount(pRet);
  2520        dbEvalInit(&sEval, pDb, objv[2], 0, 0);
  2521        while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
  2522          int i;
  2523          int nCol;
  2524          dbEvalRowInfo(&sEval, &nCol, 0);
  2525          for(i=0; i<nCol; i++){
  2526            Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
  2527          }
  2528        }
  2529        dbEvalFinalize(&sEval);
  2530        if( rc==TCL_BREAK ){
  2531          Tcl_SetObjResult(interp, pRet);
  2532          rc = TCL_OK;
  2533        }
  2534        Tcl_DecrRefCount(pRet);
  2535      }else{
  2536        ClientData cd2[2];
  2537        DbEvalContext *p;
  2538        Tcl_Obj *pArray = 0;
  2539        Tcl_Obj *pScript;
  2540  
  2541        if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
  2542          pArray = objv[3];
  2543        }
  2544        pScript = objv[objc-1];
  2545        Tcl_IncrRefCount(pScript);
  2546  
  2547        p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
  2548        dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
  2549  
  2550        cd2[0] = (void *)p;
  2551        cd2[1] = (void *)pScript;
  2552        rc = DbEvalNextCmd(cd2, interp, TCL_OK);
  2553      }
  2554      break;
  2555    }
  2556  
  2557    /*
  2558    **     $db function NAME [-argcount N] [-deterministic] SCRIPT
  2559    **
  2560    ** Create a new SQL function called NAME.  Whenever that function is
  2561    ** called, invoke SCRIPT to evaluate the function.
  2562    */
  2563    case DB_FUNCTION: {
  2564      int flags = SQLITE_UTF8;
  2565      SqlFunc *pFunc;
  2566      Tcl_Obj *pScript;
  2567      char *zName;
  2568      int nArg = -1;
  2569      int i;
  2570      if( objc<4 ){
  2571        Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
  2572        return TCL_ERROR;
  2573      }
  2574      for(i=3; i<(objc-1); i++){
  2575        const char *z = Tcl_GetString(objv[i]);
  2576        int n = strlen30(z);
  2577        if( n>2 && strncmp(z, "-argcount",n)==0 ){
  2578          if( i==(objc-2) ){
  2579            Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
  2580            return TCL_ERROR;
  2581          }
  2582          if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
  2583          if( nArg<0 ){
  2584            Tcl_AppendResult(interp, "number of arguments must be non-negative",
  2585                             (char*)0);
  2586            return TCL_ERROR;
  2587          }
  2588          i++;
  2589        }else
  2590        if( n>2 && strncmp(z, "-deterministic",n)==0 ){
  2591          flags |= SQLITE_DETERMINISTIC;
  2592        }else{
  2593          Tcl_AppendResult(interp, "bad option \"", z,
  2594              "\": must be -argcount or -deterministic", (char*)0
  2595          );
  2596          return TCL_ERROR;
  2597        }
  2598      }
  2599  
  2600      pScript = objv[objc-1];
  2601      zName = Tcl_GetStringFromObj(objv[2], 0);
  2602      pFunc = findSqlFunc(pDb, zName);
  2603      if( pFunc==0 ) return TCL_ERROR;
  2604      if( pFunc->pScript ){
  2605        Tcl_DecrRefCount(pFunc->pScript);
  2606      }
  2607      pFunc->pScript = pScript;
  2608      Tcl_IncrRefCount(pScript);
  2609      pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
  2610      rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
  2611          pFunc, tclSqlFunc, 0, 0);
  2612      if( rc!=SQLITE_OK ){
  2613        rc = TCL_ERROR;
  2614        Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
  2615      }
  2616      break;
  2617    }
  2618  
  2619    /*
  2620    **     $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
  2621    */
  2622    case DB_INCRBLOB: {
  2623  #ifdef SQLITE_OMIT_INCRBLOB
  2624      Tcl_AppendResult(interp, "incrblob not available in this build", (char*)0);
  2625      return TCL_ERROR;
  2626  #else
  2627      int isReadonly = 0;
  2628      const char *zDb = "main";
  2629      const char *zTable;
  2630      const char *zColumn;
  2631      Tcl_WideInt iRow;
  2632  
  2633      /* Check for the -readonly option */
  2634      if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
  2635        isReadonly = 1;
  2636      }
  2637  
  2638      if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
  2639        Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
  2640        return TCL_ERROR;
  2641      }
  2642  
  2643      if( objc==(6+isReadonly) ){
  2644        zDb = Tcl_GetString(objv[2]);
  2645      }
  2646      zTable = Tcl_GetString(objv[objc-3]);
  2647      zColumn = Tcl_GetString(objv[objc-2]);
  2648      rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
  2649  
  2650      if( rc==TCL_OK ){
  2651        rc = createIncrblobChannel(
  2652            interp, pDb, zDb, zTable, zColumn, (sqlite3_int64)iRow, isReadonly
  2653        );
  2654      }
  2655  #endif
  2656      break;
  2657    }
  2658  
  2659    /*
  2660    **     $db interrupt
  2661    **
  2662    ** Interrupt the execution of the inner-most SQL interpreter.  This
  2663    ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
  2664    */
  2665    case DB_INTERRUPT: {
  2666      sqlite3_interrupt(pDb->db);
  2667      break;
  2668    }
  2669  
  2670    /*
  2671    **     $db nullvalue ?STRING?
  2672    **
  2673    ** Change text used when a NULL comes back from the database. If ?STRING?
  2674    ** is not present, then the current string used for NULL is returned.
  2675    ** If STRING is present, then STRING is returned.
  2676    **
  2677    */
  2678    case DB_NULLVALUE: {
  2679      if( objc!=2 && objc!=3 ){
  2680        Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
  2681        return TCL_ERROR;
  2682      }
  2683      if( objc==3 ){
  2684        int len;
  2685        char *zNull = Tcl_GetStringFromObj(objv[2], &len);
  2686        if( pDb->zNull ){
  2687          Tcl_Free(pDb->zNull);
  2688        }
  2689        if( zNull && len>0 ){
  2690          pDb->zNull = Tcl_Alloc( len + 1 );
  2691          memcpy(pDb->zNull, zNull, len);
  2692          pDb->zNull[len] = '\0';
  2693        }else{
  2694          pDb->zNull = 0;
  2695        }
  2696      }
  2697      Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
  2698      break;
  2699    }
  2700  
  2701    /*
  2702    **     $db last_insert_rowid
  2703    **
  2704    ** Return an integer which is the ROWID for the most recent insert.
  2705    */
  2706    case DB_LAST_INSERT_ROWID: {
  2707      Tcl_Obj *pResult;
  2708      Tcl_WideInt rowid;
  2709      if( objc!=2 ){
  2710        Tcl_WrongNumArgs(interp, 2, objv, "");
  2711        return TCL_ERROR;
  2712      }
  2713      rowid = sqlite3_last_insert_rowid(pDb->db);
  2714      pResult = Tcl_GetObjResult(interp);
  2715      Tcl_SetWideIntObj(pResult, rowid);
  2716      break;
  2717    }
  2718  
  2719    /*
  2720    ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
  2721    */
  2722  
  2723    /*    $db progress ?N CALLBACK?
  2724    **
  2725    ** Invoke the given callback every N virtual machine opcodes while executing
  2726    ** queries.
  2727    */
  2728    case DB_PROGRESS: {
  2729      if( objc==2 ){
  2730        if( pDb->zProgress ){
  2731          Tcl_AppendResult(interp, pDb->zProgress, (char*)0);
  2732        }
  2733      }else if( objc==4 ){
  2734        char *zProgress;
  2735        int len;
  2736        int N;
  2737        if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
  2738          return TCL_ERROR;
  2739        };
  2740        if( pDb->zProgress ){
  2741          Tcl_Free(pDb->zProgress);
  2742        }
  2743        zProgress = Tcl_GetStringFromObj(objv[3], &len);
  2744        if( zProgress && len>0 ){
  2745          pDb->zProgress = Tcl_Alloc( len + 1 );
  2746          memcpy(pDb->zProgress, zProgress, len+1);
  2747        }else{
  2748          pDb->zProgress = 0;
  2749        }
  2750  #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
  2751        if( pDb->zProgress ){
  2752          pDb->interp = interp;
  2753          sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
  2754        }else{
  2755          sqlite3_progress_handler(pDb->db, 0, 0, 0);
  2756        }
  2757  #endif
  2758      }else{
  2759        Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
  2760        return TCL_ERROR;
  2761      }
  2762      break;
  2763    }
  2764  
  2765    /*    $db profile ?CALLBACK?
  2766    **
  2767    ** Make arrangements to invoke the CALLBACK routine after each SQL statement
  2768    ** that has run.  The text of the SQL and the amount of elapse time are
  2769    ** appended to CALLBACK before the script is run.
  2770    */
  2771    case DB_PROFILE: {
  2772      if( objc>3 ){
  2773        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
  2774        return TCL_ERROR;
  2775      }else if( objc==2 ){
  2776        if( pDb->zProfile ){
  2777          Tcl_AppendResult(interp, pDb->zProfile, (char*)0);
  2778        }
  2779      }else{
  2780        char *zProfile;
  2781        int len;
  2782        if( pDb->zProfile ){
  2783          Tcl_Free(pDb->zProfile);
  2784        }
  2785        zProfile = Tcl_GetStringFromObj(objv[2], &len);
  2786        if( zProfile && len>0 ){
  2787          pDb->zProfile = Tcl_Alloc( len + 1 );
  2788          memcpy(pDb->zProfile, zProfile, len+1);
  2789        }else{
  2790          pDb->zProfile = 0;
  2791        }
  2792  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
  2793      !defined(SQLITE_OMIT_DEPRECATED)
  2794        if( pDb->zProfile ){
  2795          pDb->interp = interp;
  2796          sqlite3_profile(pDb->db, DbProfileHandler, pDb);
  2797        }else{
  2798          sqlite3_profile(pDb->db, 0, 0);
  2799        }
  2800  #endif
  2801      }
  2802      break;
  2803    }
  2804  
  2805    /*
  2806    **     $db rekey KEY
  2807    **
  2808    ** Change the encryption key on the currently open database.
  2809    */
  2810    case DB_REKEY: {
  2811  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  2812      int nKey;
  2813      void *pKey;
  2814  #endif
  2815      if( objc!=3 ){
  2816        Tcl_WrongNumArgs(interp, 2, objv, "KEY");
  2817        return TCL_ERROR;
  2818      }
  2819  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  2820      pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
  2821      rc = sqlite3_rekey(pDb->db, pKey, nKey);
  2822      if( rc ){
  2823        Tcl_AppendResult(interp, sqlite3_errstr(rc), (char*)0);
  2824        rc = TCL_ERROR;
  2825      }
  2826  #endif
  2827      break;
  2828    }
  2829  
  2830    /*    $db restore ?DATABASE? FILENAME
  2831    **
  2832    ** Open a database file named FILENAME.  Transfer the content
  2833    ** of FILENAME into the local database DATABASE (default: "main").
  2834    */
  2835    case DB_RESTORE: {
  2836      const char *zSrcFile;
  2837      const char *zDestDb;
  2838      sqlite3 *pSrc;
  2839      sqlite3_backup *pBackup;
  2840      int nTimeout = 0;
  2841  
  2842      if( objc==3 ){
  2843        zDestDb = "main";
  2844        zSrcFile = Tcl_GetString(objv[2]);
  2845      }else if( objc==4 ){
  2846        zDestDb = Tcl_GetString(objv[2]);
  2847        zSrcFile = Tcl_GetString(objv[3]);
  2848      }else{
  2849        Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
  2850        return TCL_ERROR;
  2851      }
  2852      rc = sqlite3_open_v2(zSrcFile, &pSrc,
  2853                           SQLITE_OPEN_READONLY | pDb->openFlags, 0);
  2854      if( rc!=SQLITE_OK ){
  2855        Tcl_AppendResult(interp, "cannot open source database: ",
  2856             sqlite3_errmsg(pSrc), (char*)0);
  2857        sqlite3_close(pSrc);
  2858        return TCL_ERROR;
  2859      }
  2860      pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
  2861      if( pBackup==0 ){
  2862        Tcl_AppendResult(interp, "restore failed: ",
  2863             sqlite3_errmsg(pDb->db), (char*)0);
  2864        sqlite3_close(pSrc);
  2865        return TCL_ERROR;
  2866      }
  2867      while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
  2868                || rc==SQLITE_BUSY ){
  2869        if( rc==SQLITE_BUSY ){
  2870          if( nTimeout++ >= 3 ) break;
  2871          sqlite3_sleep(100);
  2872        }
  2873      }
  2874      sqlite3_backup_finish(pBackup);
  2875      if( rc==SQLITE_DONE ){
  2876        rc = TCL_OK;
  2877      }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
  2878        Tcl_AppendResult(interp, "restore failed: source database busy",
  2879                         (char*)0);
  2880        rc = TCL_ERROR;
  2881      }else{
  2882        Tcl_AppendResult(interp, "restore failed: ",
  2883             sqlite3_errmsg(pDb->db), (char*)0);
  2884        rc = TCL_ERROR;
  2885      }
  2886      sqlite3_close(pSrc);
  2887      break;
  2888    }
  2889  
  2890    /*
  2891    **     $db status (step|sort|autoindex|vmstep)
  2892    **
  2893    ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
  2894    ** SQLITE_STMTSTATUS_SORT for the most recent eval.
  2895    */
  2896    case DB_STATUS: {
  2897      int v;
  2898      const char *zOp;
  2899      if( objc!=3 ){
  2900        Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
  2901        return TCL_ERROR;
  2902      }
  2903      zOp = Tcl_GetString(objv[2]);
  2904      if( strcmp(zOp, "step")==0 ){
  2905        v = pDb->nStep;
  2906      }else if( strcmp(zOp, "sort")==0 ){
  2907        v = pDb->nSort;
  2908      }else if( strcmp(zOp, "autoindex")==0 ){
  2909        v = pDb->nIndex;
  2910      }else if( strcmp(zOp, "vmstep")==0 ){
  2911        v = pDb->nVMStep;
  2912      }else{
  2913        Tcl_AppendResult(interp,
  2914              "bad argument: should be autoindex, step, sort or vmstep",
  2915              (char*)0);
  2916        return TCL_ERROR;
  2917      }
  2918      Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
  2919      break;
  2920    }
  2921  
  2922    /*
  2923    **     $db timeout MILLESECONDS
  2924    **
  2925    ** Delay for the number of milliseconds specified when a file is locked.
  2926    */
  2927    case DB_TIMEOUT: {
  2928      int ms;
  2929      if( objc!=3 ){
  2930        Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
  2931        return TCL_ERROR;
  2932      }
  2933      if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
  2934      sqlite3_busy_timeout(pDb->db, ms);
  2935      break;
  2936    }
  2937  
  2938    /*
  2939    **     $db total_changes
  2940    **
  2941    ** Return the number of rows that were modified, inserted, or deleted
  2942    ** since the database handle was created.
  2943    */
  2944    case DB_TOTAL_CHANGES: {
  2945      Tcl_Obj *pResult;
  2946      if( objc!=2 ){
  2947        Tcl_WrongNumArgs(interp, 2, objv, "");
  2948        return TCL_ERROR;
  2949      }
  2950      pResult = Tcl_GetObjResult(interp);
  2951      Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
  2952      break;
  2953    }
  2954  
  2955    /*    $db trace ?CALLBACK?
  2956    **
  2957    ** Make arrangements to invoke the CALLBACK routine for each SQL statement
  2958    ** that is executed.  The text of the SQL is appended to CALLBACK before
  2959    ** it is executed.
  2960    */
  2961    case DB_TRACE: {
  2962      if( objc>3 ){
  2963        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
  2964        return TCL_ERROR;
  2965      }else if( objc==2 ){
  2966        if( pDb->zTrace ){
  2967          Tcl_AppendResult(interp, pDb->zTrace, (char*)0);
  2968        }
  2969      }else{
  2970        char *zTrace;
  2971        int len;
  2972        if( pDb->zTrace ){
  2973          Tcl_Free(pDb->zTrace);
  2974        }
  2975        zTrace = Tcl_GetStringFromObj(objv[2], &len);
  2976        if( zTrace && len>0 ){
  2977          pDb->zTrace = Tcl_Alloc( len + 1 );
  2978          memcpy(pDb->zTrace, zTrace, len+1);
  2979        }else{
  2980          pDb->zTrace = 0;
  2981        }
  2982  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
  2983      !defined(SQLITE_OMIT_DEPRECATED)
  2984        if( pDb->zTrace ){
  2985          pDb->interp = interp;
  2986          sqlite3_trace(pDb->db, DbTraceHandler, pDb);
  2987        }else{
  2988          sqlite3_trace(pDb->db, 0, 0);
  2989        }
  2990  #endif
  2991      }
  2992      break;
  2993    }
  2994  
  2995    /*    $db trace_v2 ?CALLBACK? ?MASK?
  2996    **
  2997    ** Make arrangements to invoke the CALLBACK routine for each trace event
  2998    ** matching the mask that is generated.  The parameters are appended to
  2999    ** CALLBACK before it is executed.
  3000    */
  3001    case DB_TRACE_V2: {
  3002      if( objc>4 ){
  3003        Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK? ?MASK?");
  3004        return TCL_ERROR;
  3005      }else if( objc==2 ){
  3006        if( pDb->zTraceV2 ){
  3007          Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
  3008        }
  3009      }else{
  3010        char *zTraceV2;
  3011        int len;
  3012        Tcl_WideInt wMask = 0;
  3013        if( objc==4 ){
  3014          static const char *TTYPE_strs[] = {
  3015            "statement", "profile", "row", "close", 0
  3016          };
  3017          enum TTYPE_enum {
  3018            TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
  3019          };
  3020          int i;
  3021          if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
  3022            return TCL_ERROR;
  3023          }
  3024          for(i=0; i<len; i++){
  3025            Tcl_Obj *pObj;
  3026            int ttype;
  3027            if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
  3028              return TCL_ERROR;
  3029            }
  3030            if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
  3031                                    0, &ttype)!=TCL_OK ){
  3032              Tcl_WideInt wType;
  3033              Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
  3034              Tcl_IncrRefCount(pError);
  3035              if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
  3036                Tcl_DecrRefCount(pError);
  3037                wMask |= wType;
  3038              }else{
  3039                Tcl_SetObjResult(interp, pError);
  3040                Tcl_DecrRefCount(pError);
  3041                return TCL_ERROR;
  3042              }
  3043            }else{
  3044              switch( (enum TTYPE_enum)ttype ){
  3045                case TTYPE_STMT:    wMask |= SQLITE_TRACE_STMT;    break;
  3046                case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
  3047                case TTYPE_ROW:     wMask |= SQLITE_TRACE_ROW;     break;
  3048                case TTYPE_CLOSE:   wMask |= SQLITE_TRACE_CLOSE;   break;
  3049              }
  3050            }
  3051          }
  3052        }else{
  3053          wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
  3054        }
  3055        if( pDb->zTraceV2 ){
  3056          Tcl_Free(pDb->zTraceV2);
  3057        }
  3058        zTraceV2 = Tcl_GetStringFromObj(objv[2], &len);
  3059        if( zTraceV2 && len>0 ){
  3060          pDb->zTraceV2 = Tcl_Alloc( len + 1 );
  3061          memcpy(pDb->zTraceV2, zTraceV2, len+1);
  3062        }else{
  3063          pDb->zTraceV2 = 0;
  3064        }
  3065  #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
  3066        if( pDb->zTraceV2 ){
  3067          pDb->interp = interp;
  3068          sqlite3_trace_v2(pDb->db, (unsigned)wMask, DbTraceV2Handler, pDb);
  3069        }else{
  3070          sqlite3_trace_v2(pDb->db, 0, 0, 0);
  3071        }
  3072  #endif
  3073      }
  3074      break;
  3075    }
  3076  
  3077    /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
  3078    **
  3079    ** Start a new transaction (if we are not already in the midst of a
  3080    ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
  3081    ** completes, either commit the transaction or roll it back if SCRIPT
  3082    ** throws an exception.  Or if no new transation was started, do nothing.
  3083    ** pass the exception on up the stack.
  3084    **
  3085    ** This command was inspired by Dave Thomas's talk on Ruby at the
  3086    ** 2005 O'Reilly Open Source Convention (OSCON).
  3087    */
  3088    case DB_TRANSACTION: {
  3089      Tcl_Obj *pScript;
  3090      const char *zBegin = "SAVEPOINT _tcl_transaction";
  3091      if( objc!=3 && objc!=4 ){
  3092        Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
  3093        return TCL_ERROR;
  3094      }
  3095  
  3096      if( pDb->nTransaction==0 && objc==4 ){
  3097        static const char *TTYPE_strs[] = {
  3098          "deferred",   "exclusive",  "immediate", 0
  3099        };
  3100        enum TTYPE_enum {
  3101          TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
  3102        };
  3103        int ttype;
  3104        if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
  3105                                0, &ttype) ){
  3106          return TCL_ERROR;
  3107        }
  3108        switch( (enum TTYPE_enum)ttype ){
  3109          case TTYPE_DEFERRED:    /* no-op */;                 break;
  3110          case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
  3111          case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
  3112        }
  3113      }
  3114      pScript = objv[objc-1];
  3115  
  3116      /* Run the SQLite BEGIN command to open a transaction or savepoint. */
  3117      pDb->disableAuth++;
  3118      rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
  3119      pDb->disableAuth--;
  3120      if( rc!=SQLITE_OK ){
  3121        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
  3122        return TCL_ERROR;
  3123      }
  3124      pDb->nTransaction++;
  3125  
  3126      /* If using NRE, schedule a callback to invoke the script pScript, then
  3127      ** a second callback to commit (or rollback) the transaction or savepoint
  3128      ** opened above. If not using NRE, evaluate the script directly, then
  3129      ** call function DbTransPostCmd() to commit (or rollback) the transaction
  3130      ** or savepoint.  */
  3131      if( DbUseNre() ){
  3132        Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
  3133        (void)Tcl_NREvalObj(interp, pScript, 0);
  3134      }else{
  3135        rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
  3136      }
  3137      break;
  3138    }
  3139  
  3140    /*
  3141    **    $db unlock_notify ?script?
  3142    */
  3143    case DB_UNLOCK_NOTIFY: {
  3144  #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
  3145      Tcl_AppendResult(interp, "unlock_notify not available in this build",
  3146                       (char*)0);
  3147      rc = TCL_ERROR;
  3148  #else
  3149      if( objc!=2 && objc!=3 ){
  3150        Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
  3151        rc = TCL_ERROR;
  3152      }else{
  3153        void (*xNotify)(void **, int) = 0;
  3154        void *pNotifyArg = 0;
  3155  
  3156        if( pDb->pUnlockNotify ){
  3157          Tcl_DecrRefCount(pDb->pUnlockNotify);
  3158          pDb->pUnlockNotify = 0;
  3159        }
  3160  
  3161        if( objc==3 ){
  3162          xNotify = DbUnlockNotify;
  3163          pNotifyArg = (void *)pDb;
  3164          pDb->pUnlockNotify = objv[2];
  3165          Tcl_IncrRefCount(pDb->pUnlockNotify);
  3166        }
  3167  
  3168        if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
  3169          Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
  3170          rc = TCL_ERROR;
  3171        }
  3172      }
  3173  #endif
  3174      break;
  3175    }
  3176  
  3177    /*
  3178    **    $db preupdate_hook count
  3179    **    $db preupdate_hook hook ?SCRIPT?
  3180    **    $db preupdate_hook new INDEX
  3181    **    $db preupdate_hook old INDEX
  3182    */
  3183    case DB_PREUPDATE: {
  3184  #ifndef SQLITE_ENABLE_PREUPDATE_HOOK
  3185      Tcl_AppendResult(interp, "preupdate_hook was omitted at compile-time", 
  3186                       (char*)0);
  3187      rc = TCL_ERROR;
  3188  #else
  3189      static const char *azSub[] = {"count", "depth", "hook", "new", "old", 0};
  3190      enum DbPreupdateSubCmd {
  3191        PRE_COUNT, PRE_DEPTH, PRE_HOOK, PRE_NEW, PRE_OLD
  3192      };
  3193      int iSub;
  3194  
  3195      if( objc<3 ){
  3196        Tcl_WrongNumArgs(interp, 2, objv, "SUB-COMMAND ?ARGS?");
  3197      }
  3198      if( Tcl_GetIndexFromObj(interp, objv[2], azSub, "sub-command", 0, &iSub) ){
  3199        return TCL_ERROR;
  3200      }
  3201  
  3202      switch( (enum DbPreupdateSubCmd)iSub ){
  3203        case PRE_COUNT: {
  3204          int nCol = sqlite3_preupdate_count(pDb->db);
  3205          Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
  3206          break;
  3207        }
  3208  
  3209        case PRE_HOOK: {
  3210          if( objc>4 ){
  3211            Tcl_WrongNumArgs(interp, 2, objv, "hook ?SCRIPT?");
  3212            return TCL_ERROR;
  3213          }
  3214          DbHookCmd(interp, pDb, (objc==4 ? objv[3] : 0), &pDb->pPreUpdateHook);
  3215          break;
  3216        }
  3217  
  3218        case PRE_DEPTH: {
  3219          Tcl_Obj *pRet;
  3220          if( objc!=3 ){
  3221            Tcl_WrongNumArgs(interp, 3, objv, "");
  3222            return TCL_ERROR;
  3223          }
  3224          pRet = Tcl_NewIntObj(sqlite3_preupdate_depth(pDb->db));
  3225          Tcl_SetObjResult(interp, pRet);
  3226          break;
  3227        }
  3228  
  3229        case PRE_NEW:
  3230        case PRE_OLD: {
  3231          int iIdx;
  3232          sqlite3_value *pValue;
  3233          if( objc!=4 ){
  3234            Tcl_WrongNumArgs(interp, 3, objv, "INDEX");
  3235            return TCL_ERROR;
  3236          }
  3237          if( Tcl_GetIntFromObj(interp, objv[3], &iIdx) ){
  3238            return TCL_ERROR;
  3239          }
  3240  
  3241          if( iSub==PRE_OLD ){
  3242            rc = sqlite3_preupdate_old(pDb->db, iIdx, &pValue);
  3243          }else{
  3244            assert( iSub==PRE_NEW );
  3245            rc = sqlite3_preupdate_new(pDb->db, iIdx, &pValue);
  3246          }
  3247  
  3248          if( rc==SQLITE_OK ){
  3249            Tcl_Obj *pObj;
  3250            pObj = Tcl_NewStringObj((char*)sqlite3_value_text(pValue), -1);
  3251            Tcl_SetObjResult(interp, pObj);
  3252          }else{
  3253            Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
  3254            return TCL_ERROR;
  3255          }
  3256        }
  3257      }
  3258  #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
  3259      break;
  3260    }
  3261  
  3262    /*
  3263    **    $db wal_hook ?script?
  3264    **    $db update_hook ?script?
  3265    **    $db rollback_hook ?script?
  3266    */
  3267    case DB_WAL_HOOK:
  3268    case DB_UPDATE_HOOK:
  3269    case DB_ROLLBACK_HOOK: {
  3270      /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
  3271      ** whether [$db update_hook] or [$db rollback_hook] was invoked.
  3272      */
  3273      Tcl_Obj **ppHook = 0;
  3274      if( choice==DB_WAL_HOOK ) ppHook = &pDb->pWalHook;
  3275      if( choice==DB_UPDATE_HOOK ) ppHook = &pDb->pUpdateHook;
  3276      if( choice==DB_ROLLBACK_HOOK ) ppHook = &pDb->pRollbackHook;
  3277      if( objc>3 ){
  3278         Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
  3279         return TCL_ERROR;
  3280      }
  3281  
  3282      DbHookCmd(interp, pDb, (objc==3 ? objv[2] : 0), ppHook);
  3283      break;
  3284    }
  3285  
  3286    /*    $db version
  3287    **
  3288    ** Return the version string for this database.
  3289    */
  3290    case DB_VERSION: {
  3291      int i;
  3292      for(i=2; i<objc; i++){
  3293        const char *zArg = Tcl_GetString(objv[i]);
  3294        /* Optional arguments to $db version are used for testing purpose */
  3295  #ifdef SQLITE_TEST
  3296        /* $db version -use-legacy-prepare BOOLEAN
  3297        **
  3298        ** Turn the use of legacy sqlite3_prepare() on or off.
  3299        */
  3300        if( strcmp(zArg, "-use-legacy-prepare")==0 && i+1<objc ){
  3301          i++;
  3302          if( Tcl_GetBooleanFromObj(interp, objv[i], &pDb->bLegacyPrepare) ){
  3303            return TCL_ERROR;
  3304          }
  3305        }else
  3306  
  3307        /* $db version -last-stmt-ptr
  3308        **
  3309        ** Return a string which is a hex encoding of the pointer to the
  3310        ** most recent sqlite3_stmt in the statement cache.
  3311        */
  3312        if( strcmp(zArg, "-last-stmt-ptr")==0 ){
  3313          char zBuf[100];
  3314          sqlite3_snprintf(sizeof(zBuf), zBuf, "%p",
  3315                           pDb->stmtList ? pDb->stmtList->pStmt: 0);
  3316          Tcl_SetResult(interp, zBuf, TCL_VOLATILE);
  3317        }else
  3318  #endif /* SQLITE_TEST */
  3319        {
  3320          Tcl_AppendResult(interp, "unknown argument: ", zArg, (char*)0);
  3321          return TCL_ERROR;
  3322        }
  3323      }
  3324      if( i==2 ){   
  3325        Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
  3326      }
  3327      break;
  3328    }
  3329  
  3330  
  3331    } /* End of the SWITCH statement */
  3332    return rc;
  3333  }
  3334  
  3335  #if SQLITE_TCL_NRE
  3336  /*
  3337  ** Adaptor that provides an objCmd interface to the NRE-enabled
  3338  ** interface implementation.
  3339  */
  3340  static int SQLITE_TCLAPI DbObjCmdAdaptor(
  3341    void *cd,
  3342    Tcl_Interp *interp,
  3343    int objc,
  3344    Tcl_Obj *const*objv
  3345  ){
  3346    return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
  3347  }
  3348  #endif /* SQLITE_TCL_NRE */
  3349  
  3350  /*
  3351  **   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
  3352  **                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
  3353  **
  3354  ** This is the main Tcl command.  When the "sqlite" Tcl command is
  3355  ** invoked, this routine runs to process that command.
  3356  **
  3357  ** The first argument, DBNAME, is an arbitrary name for a new
  3358  ** database connection.  This command creates a new command named
  3359  ** DBNAME that is used to control that connection.  The database
  3360  ** connection is deleted when the DBNAME command is deleted.
  3361  **
  3362  ** The second argument is the name of the database file.
  3363  **
  3364  */
  3365  static int SQLITE_TCLAPI DbMain(
  3366    void *cd,
  3367    Tcl_Interp *interp,
  3368    int objc,
  3369    Tcl_Obj *const*objv
  3370  ){
  3371    SqliteDb *p;
  3372    const char *zArg;
  3373    char *zErrMsg;
  3374    int i;
  3375    const char *zFile;
  3376    const char *zVfs = 0;
  3377    int flags;
  3378    Tcl_DString translatedFilename;
  3379  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  3380    void *pKey = 0;
  3381    int nKey = 0;
  3382  #endif
  3383    int rc;
  3384  
  3385    /* In normal use, each TCL interpreter runs in a single thread.  So
  3386    ** by default, we can turn of mutexing on SQLite database connections.
  3387    ** However, for testing purposes it is useful to have mutexes turned
  3388    ** on.  So, by default, mutexes default off.  But if compiled with
  3389    ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
  3390    */
  3391  #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
  3392    flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
  3393  #else
  3394    flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
  3395  #endif
  3396  
  3397    if( objc==2 ){
  3398      zArg = Tcl_GetStringFromObj(objv[1], 0);
  3399      if( strcmp(zArg,"-version")==0 ){
  3400        Tcl_AppendResult(interp,sqlite3_libversion(), (char*)0);
  3401        return TCL_OK;
  3402      }
  3403      if( strcmp(zArg,"-sourceid")==0 ){
  3404        Tcl_AppendResult(interp,sqlite3_sourceid(), (char*)0);
  3405        return TCL_OK;
  3406      }
  3407      if( strcmp(zArg,"-has-codec")==0 ){
  3408  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  3409        Tcl_AppendResult(interp,"1",(char*)0);
  3410  #else
  3411        Tcl_AppendResult(interp,"0",(char*)0);
  3412  #endif
  3413        return TCL_OK;
  3414      }
  3415    }
  3416    for(i=3; i+1<objc; i+=2){
  3417      zArg = Tcl_GetString(objv[i]);
  3418      if( strcmp(zArg,"-key")==0 ){
  3419  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  3420        pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey);
  3421  #endif
  3422      }else if( strcmp(zArg, "-vfs")==0 ){
  3423        zVfs = Tcl_GetString(objv[i+1]);
  3424      }else if( strcmp(zArg, "-readonly")==0 ){
  3425        int b;
  3426        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
  3427        if( b ){
  3428          flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
  3429          flags |= SQLITE_OPEN_READONLY;
  3430        }else{
  3431          flags &= ~SQLITE_OPEN_READONLY;
  3432          flags |= SQLITE_OPEN_READWRITE;
  3433        }
  3434      }else if( strcmp(zArg, "-create")==0 ){
  3435        int b;
  3436        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
  3437        if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
  3438          flags |= SQLITE_OPEN_CREATE;
  3439        }else{
  3440          flags &= ~SQLITE_OPEN_CREATE;
  3441        }
  3442      }else if( strcmp(zArg, "-nomutex")==0 ){
  3443        int b;
  3444        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
  3445        if( b ){
  3446          flags |= SQLITE_OPEN_NOMUTEX;
  3447          flags &= ~SQLITE_OPEN_FULLMUTEX;
  3448        }else{
  3449          flags &= ~SQLITE_OPEN_NOMUTEX;
  3450        }
  3451      }else if( strcmp(zArg, "-fullmutex")==0 ){
  3452        int b;
  3453        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
  3454        if( b ){
  3455          flags |= SQLITE_OPEN_FULLMUTEX;
  3456          flags &= ~SQLITE_OPEN_NOMUTEX;
  3457        }else{
  3458          flags &= ~SQLITE_OPEN_FULLMUTEX;
  3459        }
  3460      }else if( strcmp(zArg, "-uri")==0 ){
  3461        int b;
  3462        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
  3463        if( b ){
  3464          flags |= SQLITE_OPEN_URI;
  3465        }else{
  3466          flags &= ~SQLITE_OPEN_URI;
  3467        }
  3468      }else{
  3469        Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
  3470        return TCL_ERROR;
  3471      }
  3472    }
  3473    if( objc<3 || (objc&1)!=1 ){
  3474      Tcl_WrongNumArgs(interp, 1, objv,
  3475        "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
  3476        " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
  3477  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  3478        " ?-key CODECKEY?"
  3479  #endif
  3480      );
  3481      return TCL_ERROR;
  3482    }
  3483    zErrMsg = 0;
  3484    p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
  3485    memset(p, 0, sizeof(*p));
  3486    zFile = Tcl_GetStringFromObj(objv[2], 0);
  3487    zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
  3488    rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
  3489    Tcl_DStringFree(&translatedFilename);
  3490    if( p->db ){
  3491      if( SQLITE_OK!=sqlite3_errcode(p->db) ){
  3492        zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
  3493        sqlite3_close(p->db);
  3494        p->db = 0;
  3495      }
  3496    }else{
  3497      zErrMsg = sqlite3_mprintf("%s", sqlite3_errstr(rc));
  3498    }
  3499  #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  3500    if( p->db ){
  3501      sqlite3_key(p->db, pKey, nKey);
  3502    }
  3503  #endif
  3504    if( p->db==0 ){
  3505      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
  3506      Tcl_Free((char*)p);
  3507      sqlite3_free(zErrMsg);
  3508      return TCL_ERROR;
  3509    }
  3510    p->maxStmt = NUM_PREPARED_STMTS;
  3511    p->openFlags = flags & SQLITE_OPEN_URI;
  3512    p->interp = interp;
  3513    zArg = Tcl_GetStringFromObj(objv[1], 0);
  3514    if( DbUseNre() ){
  3515      Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
  3516                          (char*)p, DbDeleteCmd);
  3517    }else{
  3518      Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
  3519    }
  3520    return TCL_OK;
  3521  }
  3522  
  3523  /*
  3524  ** Provide a dummy Tcl_InitStubs if we are using this as a static
  3525  ** library.
  3526  */
  3527  #ifndef USE_TCL_STUBS
  3528  # undef  Tcl_InitStubs
  3529  # define Tcl_InitStubs(a,b,c) TCL_VERSION
  3530  #endif
  3531  
  3532  /*
  3533  ** Make sure we have a PACKAGE_VERSION macro defined.  This will be
  3534  ** defined automatically by the TEA makefile.  But other makefiles
  3535  ** do not define it.
  3536  */
  3537  #ifndef PACKAGE_VERSION
  3538  # define PACKAGE_VERSION SQLITE_VERSION
  3539  #endif
  3540  
  3541  /*
  3542  ** Initialize this module.
  3543  **
  3544  ** This Tcl module contains only a single new Tcl command named "sqlite".
  3545  ** (Hence there is no namespace.  There is no point in using a namespace
  3546  ** if the extension only supplies one new name!)  The "sqlite" command is
  3547  ** used to open a new SQLite database.  See the DbMain() routine above
  3548  ** for additional information.
  3549  **
  3550  ** The EXTERN macros are required by TCL in order to work on windows.
  3551  */
  3552  EXTERN int Sqlite3_Init(Tcl_Interp *interp){
  3553    int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR;
  3554    if( rc==TCL_OK ){
  3555      Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
  3556  #ifndef SQLITE_3_SUFFIX_ONLY
  3557      /* The "sqlite" alias is undocumented.  It is here only to support
  3558      ** legacy scripts.  All new scripts should use only the "sqlite3"
  3559      ** command. */
  3560      Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
  3561  #endif
  3562      rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
  3563    }
  3564    return rc;
  3565  }
  3566  EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
  3567  EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
  3568  EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
  3569  
  3570  /* Because it accesses the file-system and uses persistent state, SQLite
  3571  ** is not considered appropriate for safe interpreters.  Hence, we cause
  3572  ** the _SafeInit() interfaces return TCL_ERROR.
  3573  */
  3574  EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; }
  3575  EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;}
  3576  
  3577  
  3578  
  3579  #ifndef SQLITE_3_SUFFIX_ONLY
  3580  int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
  3581  int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
  3582  int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
  3583  int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
  3584  #endif
  3585  
  3586  /*
  3587  ** If the TCLSH macro is defined, add code to make a stand-alone program.
  3588  */
  3589  #if defined(TCLSH)
  3590  
  3591  /* This is the main routine for an ordinary TCL shell.  If there are
  3592  ** are arguments, run the first argument as a script.  Otherwise,
  3593  ** read TCL commands from standard input
  3594  */
  3595  static const char *tclsh_main_loop(void){
  3596    static const char zMainloop[] =
  3597      "if {[llength $argv]>=1} {\n"
  3598        "set argv0 [lindex $argv 0]\n"
  3599        "set argv [lrange $argv 1 end]\n"
  3600        "source $argv0\n"
  3601      "} else {\n"
  3602        "set line {}\n"
  3603        "while {![eof stdin]} {\n"
  3604          "if {$line!=\"\"} {\n"
  3605            "puts -nonewline \"> \"\n"
  3606          "} else {\n"
  3607            "puts -nonewline \"% \"\n"
  3608          "}\n"
  3609          "flush stdout\n"
  3610          "append line [gets stdin]\n"
  3611          "if {[info complete $line]} {\n"
  3612            "if {[catch {uplevel #0 $line} result]} {\n"
  3613              "puts stderr \"Error: $result\"\n"
  3614            "} elseif {$result!=\"\"} {\n"
  3615              "puts $result\n"
  3616            "}\n"
  3617            "set line {}\n"
  3618          "} else {\n"
  3619            "append line \\n\n"
  3620          "}\n"
  3621        "}\n"
  3622      "}\n"
  3623    ;
  3624    return zMainloop;
  3625  }
  3626  
  3627  #define TCLSH_MAIN main   /* Needed to fake out mktclapp */
  3628  int SQLITE_CDECL TCLSH_MAIN(int argc, char **argv){
  3629    Tcl_Interp *interp;
  3630    int i;
  3631    const char *zScript = 0;
  3632    char zArgc[32];
  3633  #if defined(TCLSH_INIT_PROC)
  3634    extern const char *TCLSH_INIT_PROC(Tcl_Interp*);
  3635  #endif
  3636  
  3637  #if !defined(_WIN32_WCE)
  3638    if( getenv("BREAK") ){
  3639      fprintf(stderr,
  3640          "attach debugger to process %d and press any key to continue.\n",
  3641          GETPID());
  3642      fgetc(stdin);
  3643    }
  3644  #endif
  3645  
  3646    /* Call sqlite3_shutdown() once before doing anything else. This is to
  3647    ** test that sqlite3_shutdown() can be safely called by a process before
  3648    ** sqlite3_initialize() is. */
  3649    sqlite3_shutdown();
  3650  
  3651    Tcl_FindExecutable(argv[0]);
  3652    Tcl_SetSystemEncoding(NULL, "utf-8");
  3653    interp = Tcl_CreateInterp();
  3654    Sqlite3_Init(interp);
  3655  
  3656    sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-1);
  3657    Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
  3658    Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
  3659    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
  3660    for(i=1; i<argc; i++){
  3661      Tcl_SetVar(interp, "argv", argv[i],
  3662          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
  3663    }
  3664  #if defined(TCLSH_INIT_PROC)
  3665    zScript = TCLSH_INIT_PROC(interp);
  3666  #endif
  3667    if( zScript==0 ){
  3668      zScript = tclsh_main_loop();
  3669    }
  3670    if( Tcl_GlobalEval(interp, zScript)!=TCL_OK ){
  3671      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  3672      if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
  3673      fprintf(stderr,"%s: %s\n", *argv, zInfo);
  3674      return 1;
  3675    }
  3676    return 0;
  3677  }
  3678  #endif /* TCLSH */