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