contrib/sqlite3/tea/generic/tclsqlite3.c

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