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