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