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