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