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