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