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