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