xref: /sqlite-3.40.0/src/tclsqlite.c (revision 4dcbdbff)
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
13 **
14 ** $Id: tclsqlite.c,v 1.130 2005/08/02 17:15:15 drh Exp $
15 */
16 #ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */
17 
18 #include "sqliteInt.h"
19 #include "hash.h"
20 #include "tcl.h"
21 #include <stdlib.h>
22 #include <string.h>
23 #include <assert.h>
24 #include <ctype.h>
25 
26 #define NUM_PREPARED_STMTS 10
27 #define MAX_PREPARED_STMTS 100
28 
29 /*
30 ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
31 ** have to do a translation when going between the two.  Set the
32 ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
33 ** this translation.
34 */
35 #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
36 # define UTF_TRANSLATION_NEEDED 1
37 #endif
38 
39 /*
40 ** New SQL functions can be created as TCL scripts.  Each such function
41 ** is described by an instance of the following structure.
42 */
43 typedef struct SqlFunc SqlFunc;
44 struct SqlFunc {
45   Tcl_Interp *interp;   /* The TCL interpret to execute the function */
46   Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
47   int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
48   char *zName;          /* Name of this function */
49   SqlFunc *pNext;       /* Next function on the list of them all */
50 };
51 
52 /*
53 ** New collation sequences function can be created as TCL scripts.  Each such
54 ** function is described by an instance of the following structure.
55 */
56 typedef struct SqlCollate SqlCollate;
57 struct SqlCollate {
58   Tcl_Interp *interp;   /* The TCL interpret to execute the function */
59   char *zScript;        /* The script to be run */
60   SqlCollate *pNext;    /* Next function on the list of them all */
61 };
62 
63 /*
64 ** Prepared statements are cached for faster execution.  Each prepared
65 ** statement is described by an instance of the following structure.
66 */
67 typedef struct SqlPreparedStmt SqlPreparedStmt;
68 struct SqlPreparedStmt {
69   SqlPreparedStmt *pNext;  /* Next in linked list */
70   SqlPreparedStmt *pPrev;  /* Previous on the list */
71   sqlite3_stmt *pStmt;     /* The prepared statement */
72   int nSql;                /* chars in zSql[] */
73   char zSql[1];            /* Text of the SQL statement */
74 };
75 
76 /*
77 ** There is one instance of this structure for each SQLite database
78 ** that has been opened by the SQLite TCL interface.
79 */
80 typedef struct SqliteDb SqliteDb;
81 struct SqliteDb {
82   sqlite3 *db;               /* The "real" database structure */
83   Tcl_Interp *interp;        /* The interpreter used for this database */
84   char *zBusy;               /* The busy callback routine */
85   char *zCommit;             /* The commit hook callback routine */
86   char *zTrace;              /* The trace callback routine */
87   char *zProgress;           /* The progress callback routine */
88   char *zAuth;               /* The authorization callback routine */
89   char *zNull;               /* Text to substitute for an SQL NULL value */
90   SqlFunc *pFunc;            /* List of SQL functions */
91   SqlCollate *pCollate;      /* List of SQL collation functions */
92   int rc;                    /* Return code of most recent sqlite3_exec() */
93   Tcl_Obj *pCollateNeeded;   /* Collation needed script */
94   SqlPreparedStmt *stmtList; /* List of prepared statements*/
95   SqlPreparedStmt *stmtLast; /* Last statement in the list */
96   int maxStmt;               /* The next maximum number of stmtList */
97   int nStmt;                 /* Number of statements in stmtList */
98 };
99 
100 /*
101 ** Look at the script prefix in pCmd.  We will be executing this script
102 ** after first appending one or more arguments.  This routine analyzes
103 ** the script to see if it is safe to use Tcl_EvalObjv() on the script
104 ** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much
105 ** faster.
106 **
107 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
108 ** command name followed by zero or more arguments with no [...] or $
109 ** or {...} or ; to be seen anywhere.  Most callback scripts consist
110 ** of just a single procedure name and they meet this requirement.
111 */
112 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
113   /* We could try to do something with Tcl_Parse().  But we will instead
114   ** just do a search for forbidden characters.  If any of the forbidden
115   ** characters appear in pCmd, we will report the string as unsafe.
116   */
117   const char *z;
118   int n;
119   z = Tcl_GetStringFromObj(pCmd, &n);
120   while( n-- > 0 ){
121     int c = *(z++);
122     if( c=='$' || c=='[' || c==';' ) return 0;
123   }
124   return 1;
125 }
126 
127 /*
128 ** Find an SqlFunc structure with the given name.  Or create a new
129 ** one if an existing one cannot be found.  Return a pointer to the
130 ** structure.
131 */
132 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
133   SqlFunc *p, *pNew;
134   int i;
135   pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );
136   pNew->zName = (char*)&pNew[1];
137   for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
138   pNew->zName[i] = 0;
139   for(p=pDb->pFunc; p; p=p->pNext){
140     if( strcmp(p->zName, pNew->zName)==0 ){
141       Tcl_Free((char*)pNew);
142       return p;
143     }
144   }
145   pNew->interp = pDb->interp;
146   pNew->pScript = 0;
147   pNew->pNext = pDb->pFunc;
148   pDb->pFunc = pNew;
149   return pNew;
150 }
151 
152 /*
153 ** Finalize and free a list of prepared statements
154 */
155 static void flushStmtCache( SqliteDb *pDb ){
156   SqlPreparedStmt *pPreStmt;
157 
158   while(  pDb->stmtList ){
159     sqlite3_finalize( pDb->stmtList->pStmt );
160     pPreStmt = pDb->stmtList;
161     pDb->stmtList = pDb->stmtList->pNext;
162     Tcl_Free( (char*)pPreStmt );
163   }
164   pDb->nStmt = 0;
165   pDb->stmtLast = 0;
166 }
167 
168 /*
169 ** TCL calls this procedure when an sqlite3 database command is
170 ** deleted.
171 */
172 static void DbDeleteCmd(void *db){
173   SqliteDb *pDb = (SqliteDb*)db;
174   flushStmtCache(pDb);
175   sqlite3_close(pDb->db);
176   while( pDb->pFunc ){
177     SqlFunc *pFunc = pDb->pFunc;
178     pDb->pFunc = pFunc->pNext;
179     Tcl_DecrRefCount(pFunc->pScript);
180     Tcl_Free((char*)pFunc);
181   }
182   while( pDb->pCollate ){
183     SqlCollate *pCollate = pDb->pCollate;
184     pDb->pCollate = pCollate->pNext;
185     Tcl_Free((char*)pCollate);
186   }
187   if( pDb->zBusy ){
188     Tcl_Free(pDb->zBusy);
189   }
190   if( pDb->zTrace ){
191     Tcl_Free(pDb->zTrace);
192   }
193   if( pDb->zAuth ){
194     Tcl_Free(pDb->zAuth);
195   }
196   if( pDb->zNull ){
197     Tcl_Free(pDb->zNull);
198   }
199   Tcl_Free((char*)pDb);
200 }
201 
202 /*
203 ** This routine is called when a database file is locked while trying
204 ** to execute SQL.
205 */
206 static int DbBusyHandler(void *cd, int nTries){
207   SqliteDb *pDb = (SqliteDb*)cd;
208   int rc;
209   char zVal[30];
210 
211   sprintf(zVal, "%d", nTries);
212   rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
213   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
214     return 0;
215   }
216   return 1;
217 }
218 
219 /*
220 ** This routine is invoked as the 'progress callback' for the database.
221 */
222 static int DbProgressHandler(void *cd){
223   SqliteDb *pDb = (SqliteDb*)cd;
224   int rc;
225 
226   assert( pDb->zProgress );
227   rc = Tcl_Eval(pDb->interp, pDb->zProgress);
228   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
229     return 1;
230   }
231   return 0;
232 }
233 
234 /*
235 ** This routine is called by the SQLite trace handler whenever a new
236 ** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
237 */
238 static void DbTraceHandler(void *cd, const char *zSql){
239   SqliteDb *pDb = (SqliteDb*)cd;
240   Tcl_DString str;
241 
242   Tcl_DStringInit(&str);
243   Tcl_DStringAppend(&str, pDb->zTrace, -1);
244   Tcl_DStringAppendElement(&str, zSql);
245   Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
246   Tcl_DStringFree(&str);
247   Tcl_ResetResult(pDb->interp);
248 }
249 
250 /*
251 ** This routine is called when a transaction is committed.  The
252 ** TCL script in pDb->zCommit is executed.  If it returns non-zero or
253 ** if it throws an exception, the transaction is rolled back instead
254 ** of being committed.
255 */
256 static int DbCommitHandler(void *cd){
257   SqliteDb *pDb = (SqliteDb*)cd;
258   int rc;
259 
260   rc = Tcl_Eval(pDb->interp, pDb->zCommit);
261   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
262     return 1;
263   }
264   return 0;
265 }
266 
267 static void tclCollateNeeded(
268   void *pCtx,
269   sqlite3 *db,
270   int enc,
271   const char *zName
272 ){
273   SqliteDb *pDb = (SqliteDb *)pCtx;
274   Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
275   Tcl_IncrRefCount(pScript);
276   Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
277   Tcl_EvalObjEx(pDb->interp, pScript, 0);
278   Tcl_DecrRefCount(pScript);
279 }
280 
281 /*
282 ** This routine is called to evaluate an SQL collation function implemented
283 ** using TCL script.
284 */
285 static int tclSqlCollate(
286   void *pCtx,
287   int nA,
288   const void *zA,
289   int nB,
290   const void *zB
291 ){
292   SqlCollate *p = (SqlCollate *)pCtx;
293   Tcl_Obj *pCmd;
294 
295   pCmd = Tcl_NewStringObj(p->zScript, -1);
296   Tcl_IncrRefCount(pCmd);
297   Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
298   Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
299   Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
300   Tcl_DecrRefCount(pCmd);
301   return (atoi(Tcl_GetStringResult(p->interp)));
302 }
303 
304 /*
305 ** This routine is called to evaluate an SQL function implemented
306 ** using TCL script.
307 */
308 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
309   SqlFunc *p = sqlite3_user_data(context);
310   Tcl_Obj *pCmd;
311   int i;
312   int rc;
313 
314   if( argc==0 ){
315     /* If there are no arguments to the function, call Tcl_EvalObjEx on the
316     ** script object directly.  This allows the TCL compiler to generate
317     ** bytecode for the command on the first invocation and thus make
318     ** subsequent invocations much faster. */
319     pCmd = p->pScript;
320     Tcl_IncrRefCount(pCmd);
321     rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
322     Tcl_DecrRefCount(pCmd);
323   }else{
324     /* If there are arguments to the function, make a shallow copy of the
325     ** script object, lappend the arguments, then evaluate the copy.
326     **
327     ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
328     ** The new Tcl_Obj contains pointers to the original list elements.
329     ** That way, when Tcl_EvalObjv() is run and shimmers the first element
330     ** of the list to tclCmdNameType, that alternate representation will
331     ** be preserved and reused on the next invocation.
332     */
333     Tcl_Obj **aArg;
334     int nArg;
335     if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
336       sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
337       return;
338     }
339     pCmd = Tcl_NewListObj(nArg, aArg);
340     Tcl_IncrRefCount(pCmd);
341     for(i=0; i<argc; i++){
342       sqlite3_value *pIn = argv[i];
343       Tcl_Obj *pVal;
344 
345       /* Set pVal to contain the i'th column of this row. */
346       switch( sqlite3_value_type(pIn) ){
347         case SQLITE_BLOB: {
348           int bytes = sqlite3_value_bytes(pIn);
349           pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
350           break;
351         }
352         case SQLITE_INTEGER: {
353           sqlite_int64 v = sqlite3_value_int64(pIn);
354           if( v>=-2147483647 && v<=2147483647 ){
355             pVal = Tcl_NewIntObj(v);
356           }else{
357             pVal = Tcl_NewWideIntObj(v);
358           }
359           break;
360         }
361         case SQLITE_FLOAT: {
362           double r = sqlite3_value_double(pIn);
363           pVal = Tcl_NewDoubleObj(r);
364           break;
365         }
366         case SQLITE_NULL: {
367           pVal = Tcl_NewStringObj("", 0);
368           break;
369         }
370         default: {
371           int bytes = sqlite3_value_bytes(pIn);
372           pVal = Tcl_NewStringObj(sqlite3_value_text(pIn), bytes);
373           break;
374         }
375       }
376       rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
377       if( rc ){
378         Tcl_DecrRefCount(pCmd);
379         sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
380         return;
381       }
382     }
383     if( !p->useEvalObjv ){
384       /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
385       ** is a list without a string representation.  To prevent this from
386       ** happening, make sure pCmd has a valid string representation */
387       Tcl_GetString(pCmd);
388     }
389     rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
390     Tcl_DecrRefCount(pCmd);
391   }
392 
393   if( rc && rc!=TCL_RETURN ){
394     sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
395   }else{
396     Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
397     int n;
398     u8 *data;
399     char *zType = pVar->typePtr ? pVar->typePtr->name : "";
400     char c = zType[0];
401     if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
402       /* Only return a BLOB type if the Tcl variable is a bytearray and
403       ** has no string representation. */
404       data = Tcl_GetByteArrayFromObj(pVar, &n);
405       sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
406     }else if( (c=='b' && strcmp(zType,"boolean")==0) ||
407           (c=='i' && strcmp(zType,"int")==0) ){
408       Tcl_GetIntFromObj(0, pVar, &n);
409       sqlite3_result_int(context, n);
410     }else if( c=='d' && strcmp(zType,"double")==0 ){
411       double r;
412       Tcl_GetDoubleFromObj(0, pVar, &r);
413       sqlite3_result_double(context, r);
414     }else if( c=='w' && strcmp(zType,"wideInt")==0 ){
415       Tcl_WideInt v;
416       Tcl_GetWideIntFromObj(0, pVar, &v);
417       sqlite3_result_int64(context, v);
418     }else{
419       data = Tcl_GetStringFromObj(pVar, &n);
420       sqlite3_result_text(context, data, n, SQLITE_TRANSIENT);
421     }
422   }
423 }
424 
425 #ifndef SQLITE_OMIT_AUTHORIZATION
426 /*
427 ** This is the authentication function.  It appends the authentication
428 ** type code and the two arguments to zCmd[] then invokes the result
429 ** on the interpreter.  The reply is examined to determine if the
430 ** authentication fails or succeeds.
431 */
432 static int auth_callback(
433   void *pArg,
434   int code,
435   const char *zArg1,
436   const char *zArg2,
437   const char *zArg3,
438   const char *zArg4
439 ){
440   char *zCode;
441   Tcl_DString str;
442   int rc;
443   const char *zReply;
444   SqliteDb *pDb = (SqliteDb*)pArg;
445 
446   switch( code ){
447     case SQLITE_COPY              : zCode="SQLITE_COPY"; break;
448     case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;
449     case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;
450     case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
451     case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
452     case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
453     case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
454     case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;
455     case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;
456     case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;
457     case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;
458     case SQLITE_DROP_TABLE        : zCode="SQLITE_DROP_TABLE"; break;
459     case SQLITE_DROP_TEMP_INDEX   : zCode="SQLITE_DROP_TEMP_INDEX"; break;
460     case SQLITE_DROP_TEMP_TABLE   : zCode="SQLITE_DROP_TEMP_TABLE"; break;
461     case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
462     case SQLITE_DROP_TEMP_VIEW    : zCode="SQLITE_DROP_TEMP_VIEW"; break;
463     case SQLITE_DROP_TRIGGER      : zCode="SQLITE_DROP_TRIGGER"; break;
464     case SQLITE_DROP_VIEW         : zCode="SQLITE_DROP_VIEW"; break;
465     case SQLITE_INSERT            : zCode="SQLITE_INSERT"; break;
466     case SQLITE_PRAGMA            : zCode="SQLITE_PRAGMA"; break;
467     case SQLITE_READ              : zCode="SQLITE_READ"; break;
468     case SQLITE_SELECT            : zCode="SQLITE_SELECT"; break;
469     case SQLITE_TRANSACTION       : zCode="SQLITE_TRANSACTION"; break;
470     case SQLITE_UPDATE            : zCode="SQLITE_UPDATE"; break;
471     case SQLITE_ATTACH            : zCode="SQLITE_ATTACH"; break;
472     case SQLITE_DETACH            : zCode="SQLITE_DETACH"; break;
473     case SQLITE_ALTER_TABLE       : zCode="SQLITE_ALTER_TABLE"; break;
474     case SQLITE_REINDEX           : zCode="SQLITE_REINDEX"; break;
475     case SQLITE_ANALYZE           : zCode="SQLITE_ANALYZE"; break;
476     default                       : zCode="????"; break;
477   }
478   Tcl_DStringInit(&str);
479   Tcl_DStringAppend(&str, pDb->zAuth, -1);
480   Tcl_DStringAppendElement(&str, zCode);
481   Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
482   Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
483   Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
484   Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
485   rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
486   Tcl_DStringFree(&str);
487   zReply = Tcl_GetStringResult(pDb->interp);
488   if( strcmp(zReply,"SQLITE_OK")==0 ){
489     rc = SQLITE_OK;
490   }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
491     rc = SQLITE_DENY;
492   }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
493     rc = SQLITE_IGNORE;
494   }else{
495     rc = 999;
496   }
497   return rc;
498 }
499 #endif /* SQLITE_OMIT_AUTHORIZATION */
500 
501 /*
502 ** zText is a pointer to text obtained via an sqlite3_result_text()
503 ** or similar interface. This routine returns a Tcl string object,
504 ** reference count set to 0, containing the text. If a translation
505 ** between iso8859 and UTF-8 is required, it is preformed.
506 */
507 static Tcl_Obj *dbTextToObj(char const *zText){
508   Tcl_Obj *pVal;
509 #ifdef UTF_TRANSLATION_NEEDED
510   Tcl_DString dCol;
511   Tcl_DStringInit(&dCol);
512   Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol);
513   pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
514   Tcl_DStringFree(&dCol);
515 #else
516   pVal = Tcl_NewStringObj(zText, -1);
517 #endif
518   return pVal;
519 }
520 
521 /*
522 ** This routine reads a line of text from FILE in, stores
523 ** the text in memory obtained from malloc() and returns a pointer
524 ** to the text.  NULL is returned at end of file, or if malloc()
525 ** fails.
526 **
527 ** The interface is like "readline" but no command-line editing
528 ** is done.
529 **
530 ** copied from shell.c from '.import' command
531 */
532 static char *local_getline(char *zPrompt, FILE *in){
533   char *zLine;
534   int nLine;
535   int n;
536   int eol;
537 
538   nLine = 100;
539   zLine = malloc( nLine );
540   if( zLine==0 ) return 0;
541   n = 0;
542   eol = 0;
543   while( !eol ){
544     if( n+100>nLine ){
545       nLine = nLine*2 + 100;
546       zLine = realloc(zLine, nLine);
547       if( zLine==0 ) return 0;
548     }
549     if( fgets(&zLine[n], nLine - n, in)==0 ){
550       if( n==0 ){
551         free(zLine);
552         return 0;
553       }
554       zLine[n] = 0;
555       eol = 1;
556       break;
557     }
558     while( zLine[n] ){ n++; }
559     if( n>0 && zLine[n-1]=='\n' ){
560       n--;
561       zLine[n] = 0;
562       eol = 1;
563     }
564   }
565   zLine = realloc( zLine, n+1 );
566   return zLine;
567 }
568 
569 /*
570 ** The "sqlite" command below creates a new Tcl command for each
571 ** connection it opens to an SQLite database.  This routine is invoked
572 ** whenever one of those connection-specific commands is executed
573 ** in Tcl.  For example, if you run Tcl code like this:
574 **
575 **       sqlite3 db1  "my_database"
576 **       db1 close
577 **
578 ** The first command opens a connection to the "my_database" database
579 ** and calls that connection "db1".  The second command causes this
580 ** subroutine to be invoked.
581 */
582 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
583   SqliteDb *pDb = (SqliteDb*)cd;
584   int choice;
585   int rc = TCL_OK;
586   static const char *DB_strs[] = {
587     "authorizer",         "busy",              "cache",
588     "changes",            "close",             "collate",
589     "collation_needed",   "commit_hook",       "complete",
590     "copy",               "errorcode",         "eval",
591     "function",           "last_insert_rowid", "nullvalue",
592     "onecolumn",          "progress",          "rekey",
593     "timeout",            "total_changes",     "trace",
594     "transaction",        "version",           0
595   };
596   enum DB_enum {
597     DB_AUTHORIZER,        DB_BUSY,             DB_CACHE,
598     DB_CHANGES,           DB_CLOSE,            DB_COLLATE,
599     DB_COLLATION_NEEDED,  DB_COMMIT_HOOK,      DB_COMPLETE,
600     DB_COPY,              DB_ERRORCODE,        DB_EVAL,
601     DB_FUNCTION,          DB_LAST_INSERT_ROWID,DB_NULLVALUE,
602     DB_ONECOLUMN,         DB_PROGRESS,         DB_REKEY,
603     DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
604     DB_TRANSACTION,       DB_VERSION,
605   };
606   /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
607 
608   if( objc<2 ){
609     Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
610     return TCL_ERROR;
611   }
612   if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
613     return TCL_ERROR;
614   }
615 
616   switch( (enum DB_enum)choice ){
617 
618   /*    $db authorizer ?CALLBACK?
619   **
620   ** Invoke the given callback to authorize each SQL operation as it is
621   ** compiled.  5 arguments are appended to the callback before it is
622   ** invoked:
623   **
624   **   (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
625   **   (2) First descriptive name (depends on authorization type)
626   **   (3) Second descriptive name
627   **   (4) Name of the database (ex: "main", "temp")
628   **   (5) Name of trigger that is doing the access
629   **
630   ** The callback should return on of the following strings: SQLITE_OK,
631   ** SQLITE_IGNORE, or SQLITE_DENY.  Any other return value is an error.
632   **
633   ** If this method is invoked with no arguments, the current authorization
634   ** callback string is returned.
635   */
636   case DB_AUTHORIZER: {
637 #ifdef SQLITE_OMIT_AUTHORIZATION
638     Tcl_AppendResult(interp, "authorization not available in this build", 0);
639     return TCL_ERROR;
640 #else
641     if( objc>3 ){
642       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
643       return TCL_ERROR;
644     }else if( objc==2 ){
645       if( pDb->zAuth ){
646         Tcl_AppendResult(interp, pDb->zAuth, 0);
647       }
648     }else{
649       char *zAuth;
650       int len;
651       if( pDb->zAuth ){
652         Tcl_Free(pDb->zAuth);
653       }
654       zAuth = Tcl_GetStringFromObj(objv[2], &len);
655       if( zAuth && len>0 ){
656         pDb->zAuth = Tcl_Alloc( len + 1 );
657         strcpy(pDb->zAuth, zAuth);
658       }else{
659         pDb->zAuth = 0;
660       }
661       if( pDb->zAuth ){
662         pDb->interp = interp;
663         sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
664       }else{
665         sqlite3_set_authorizer(pDb->db, 0, 0);
666       }
667     }
668 #endif
669     break;
670   }
671 
672   /*    $db busy ?CALLBACK?
673   **
674   ** Invoke the given callback if an SQL statement attempts to open
675   ** a locked database file.
676   */
677   case DB_BUSY: {
678     if( objc>3 ){
679       Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
680       return TCL_ERROR;
681     }else if( objc==2 ){
682       if( pDb->zBusy ){
683         Tcl_AppendResult(interp, pDb->zBusy, 0);
684       }
685     }else{
686       char *zBusy;
687       int len;
688       if( pDb->zBusy ){
689         Tcl_Free(pDb->zBusy);
690       }
691       zBusy = Tcl_GetStringFromObj(objv[2], &len);
692       if( zBusy && len>0 ){
693         pDb->zBusy = Tcl_Alloc( len + 1 );
694         strcpy(pDb->zBusy, zBusy);
695       }else{
696         pDb->zBusy = 0;
697       }
698       if( pDb->zBusy ){
699         pDb->interp = interp;
700         sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
701       }else{
702         sqlite3_busy_handler(pDb->db, 0, 0);
703       }
704     }
705     break;
706   }
707 
708   /*     $db cache flush
709   **     $db cache size n
710   **
711   ** Flush the prepared statement cache, or set the maximum number of
712   ** cached statements.
713   */
714   case DB_CACHE: {
715     char *subCmd;
716     int n;
717 
718     if( objc<=2 ){
719       Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
720       return TCL_ERROR;
721     }
722     subCmd = Tcl_GetStringFromObj( objv[2], 0 );
723     if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
724       if( objc!=3 ){
725         Tcl_WrongNumArgs(interp, 2, objv, "flush");
726         return TCL_ERROR;
727       }else{
728         flushStmtCache( pDb );
729       }
730     }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
731       if( objc!=4 ){
732         Tcl_WrongNumArgs(interp, 2, objv, "size n");
733         return TCL_ERROR;
734       }else{
735         if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
736           Tcl_AppendResult( interp, "cannot convert \"",
737                Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0);
738           return TCL_ERROR;
739         }else{
740           if( n<0 ){
741             flushStmtCache( pDb );
742             n = 0;
743           }else if( n>MAX_PREPARED_STMTS ){
744             n = MAX_PREPARED_STMTS;
745           }
746           pDb->maxStmt = n;
747         }
748       }
749     }else{
750       Tcl_AppendResult( interp, "bad option \"",
751           Tcl_GetStringFromObj(objv[0],0), "\": must be flush or size", 0);
752       return TCL_ERROR;
753     }
754     break;
755   }
756 
757   /*     $db changes
758   **
759   ** Return the number of rows that were modified, inserted, or deleted by
760   ** the most recent INSERT, UPDATE or DELETE statement, not including
761   ** any changes made by trigger programs.
762   */
763   case DB_CHANGES: {
764     Tcl_Obj *pResult;
765     if( objc!=2 ){
766       Tcl_WrongNumArgs(interp, 2, objv, "");
767       return TCL_ERROR;
768     }
769     pResult = Tcl_GetObjResult(interp);
770     Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
771     break;
772   }
773 
774   /*    $db close
775   **
776   ** Shutdown the database
777   */
778   case DB_CLOSE: {
779     Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
780     break;
781   }
782 
783   /*    $db commit_hook ?CALLBACK?
784   **
785   ** Invoke the given callback just before committing every SQL transaction.
786   ** If the callback throws an exception or returns non-zero, then the
787   ** transaction is aborted.  If CALLBACK is an empty string, the callback
788   ** is disabled.
789   */
790   case DB_COMMIT_HOOK: {
791     if( objc>3 ){
792       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
793       return TCL_ERROR;
794     }else if( objc==2 ){
795       if( pDb->zCommit ){
796         Tcl_AppendResult(interp, pDb->zCommit, 0);
797       }
798     }else{
799       char *zCommit;
800       int len;
801       if( pDb->zCommit ){
802         Tcl_Free(pDb->zCommit);
803       }
804       zCommit = Tcl_GetStringFromObj(objv[2], &len);
805       if( zCommit && len>0 ){
806         pDb->zCommit = Tcl_Alloc( len + 1 );
807         strcpy(pDb->zCommit, zCommit);
808       }else{
809         pDb->zCommit = 0;
810       }
811       if( pDb->zCommit ){
812         pDb->interp = interp;
813         sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
814       }else{
815         sqlite3_commit_hook(pDb->db, 0, 0);
816       }
817     }
818     break;
819   }
820 
821   /*
822   **     $db collate NAME SCRIPT
823   **
824   ** Create a new SQL collation function called NAME.  Whenever
825   ** that function is called, invoke SCRIPT to evaluate the function.
826   */
827   case DB_COLLATE: {
828     SqlCollate *pCollate;
829     char *zName;
830     char *zScript;
831     int nScript;
832     if( objc!=4 ){
833       Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
834       return TCL_ERROR;
835     }
836     zName = Tcl_GetStringFromObj(objv[2], 0);
837     zScript = Tcl_GetStringFromObj(objv[3], &nScript);
838     pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
839     if( pCollate==0 ) return TCL_ERROR;
840     pCollate->interp = interp;
841     pCollate->pNext = pDb->pCollate;
842     pCollate->zScript = (char*)&pCollate[1];
843     pDb->pCollate = pCollate;
844     strcpy(pCollate->zScript, zScript);
845     if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
846         pCollate, tclSqlCollate) ){
847       Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
848       return TCL_ERROR;
849     }
850     break;
851   }
852 
853   /*
854   **     $db collation_needed SCRIPT
855   **
856   ** Create a new SQL collation function called NAME.  Whenever
857   ** that function is called, invoke SCRIPT to evaluate the function.
858   */
859   case DB_COLLATION_NEEDED: {
860     if( objc!=3 ){
861       Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
862       return TCL_ERROR;
863     }
864     if( pDb->pCollateNeeded ){
865       Tcl_DecrRefCount(pDb->pCollateNeeded);
866     }
867     pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
868     Tcl_IncrRefCount(pDb->pCollateNeeded);
869     sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
870     break;
871   }
872 
873   /*    $db complete SQL
874   **
875   ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
876   ** additional lines of input are needed.  This is similar to the
877   ** built-in "info complete" command of Tcl.
878   */
879   case DB_COMPLETE: {
880 #ifndef SQLITE_OMIT_COMPLETE
881     Tcl_Obj *pResult;
882     int isComplete;
883     if( objc!=3 ){
884       Tcl_WrongNumArgs(interp, 2, objv, "SQL");
885       return TCL_ERROR;
886     }
887     isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
888     pResult = Tcl_GetObjResult(interp);
889     Tcl_SetBooleanObj(pResult, isComplete);
890 #endif
891     break;
892   }
893 
894   /*
895   **    $db errorcode
896   **
897   ** Return the numeric error code that was returned by the most recent
898   ** call to sqlite3_exec().
899   */
900   case DB_ERRORCODE: {
901     Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
902     break;
903   }
904 
905   /*
906   **    $db eval $sql ?array? ?{  ...code... }?
907   **    $db onecolumn $sql
908   **
909   ** The SQL statement in $sql is evaluated.  For each row, the values are
910   ** placed in elements of the array named "array" and ...code... is executed.
911   ** If "array" and "code" are omitted, then no callback is every invoked.
912   ** If "array" is an empty string, then the values are placed in variables
913   ** that have the same name as the fields extracted by the query.
914   **
915   ** The onecolumn method is the equivalent of:
916   **     lindex [$db eval $sql] 0
917   */
918   case DB_ONECOLUMN:
919   case DB_EVAL: {
920     char const *zSql;      /* Next SQL statement to execute */
921     char const *zLeft;     /* What is left after first stmt in zSql */
922     sqlite3_stmt *pStmt;   /* Compiled SQL statment */
923     Tcl_Obj *pArray;       /* Name of array into which results are written */
924     Tcl_Obj *pScript;      /* Script to run for each result set */
925     Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
926     int nParm;             /* Number of entries used in apParm[] */
927     Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */
928     Tcl_Obj *pRet;         /* Value to be returned */
929     SqlPreparedStmt *pPreStmt;  /* Pointer to a prepared statement */
930     int rc2;
931 
932     if( choice==DB_ONECOLUMN ){
933       if( objc!=3 ){
934         Tcl_WrongNumArgs(interp, 2, objv, "SQL");
935         return TCL_ERROR;
936       }
937       pRet = 0;
938     }else{
939       if( objc<3 || objc>5 ){
940         Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
941         return TCL_ERROR;
942       }
943       pRet = Tcl_NewObj();
944       Tcl_IncrRefCount(pRet);
945     }
946     if( objc==3 ){
947       pArray = pScript = 0;
948     }else if( objc==4 ){
949       pArray = 0;
950       pScript = objv[3];
951     }else{
952       pArray = objv[3];
953       if( Tcl_GetString(pArray)[0]==0 ) pArray = 0;
954       pScript = objv[4];
955     }
956 
957     Tcl_IncrRefCount(objv[2]);
958     zSql = Tcl_GetStringFromObj(objv[2], 0);
959     while( rc==TCL_OK && zSql[0] ){
960       int i;                     /* Loop counter */
961       int nVar;                  /* Number of bind parameters in the pStmt */
962       int nCol;                  /* Number of columns in the result set */
963       Tcl_Obj **apColName = 0;   /* Array of column names */
964       int len;                   /* String length of zSql */
965 
966       /* Try to find a SQL statement that has already been compiled and
967       ** which matches the next sequence of SQL.
968       */
969       pStmt = 0;
970       pPreStmt = pDb->stmtList;
971       len = strlen(zSql);
972       if( pPreStmt && sqlite3_expired(pPreStmt->pStmt) ){
973         flushStmtCache(pDb);
974         pPreStmt = 0;
975       }
976       for(; pPreStmt; pPreStmt=pPreStmt->pNext){
977         int n = pPreStmt->nSql;
978         if( len>=n
979             && memcmp(pPreStmt->zSql, zSql, n)==0
980             && (zSql[n]==0 || zSql[n-1]==';')
981         ){
982           pStmt = pPreStmt->pStmt;
983           zLeft = &zSql[pPreStmt->nSql];
984 
985           /* When a prepared statement is found, unlink it from the
986           ** cache list.  It will later be added back to the beginning
987           ** of the cache list in order to implement LRU replacement.
988           */
989           if( pPreStmt->pPrev ){
990             pPreStmt->pPrev->pNext = pPreStmt->pNext;
991           }else{
992             pDb->stmtList = pPreStmt->pNext;
993           }
994           if( pPreStmt->pNext ){
995             pPreStmt->pNext->pPrev = pPreStmt->pPrev;
996           }else{
997             pDb->stmtLast = pPreStmt->pPrev;
998           }
999           pDb->nStmt--;
1000           break;
1001         }
1002       }
1003 
1004       /* If no prepared statement was found.  Compile the SQL text
1005       */
1006       if( pStmt==0 ){
1007         if( SQLITE_OK!=sqlite3_prepare(pDb->db, zSql, -1, &pStmt, &zLeft) ){
1008           Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
1009           rc = TCL_ERROR;
1010           break;
1011         }
1012         if( pStmt==0 ){
1013           if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
1014             /* A compile-time error in the statement
1015             */
1016             Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
1017             rc = TCL_ERROR;
1018             break;
1019           }else{
1020             /* The statement was a no-op.  Continue to the next statement
1021             ** in the SQL string.
1022             */
1023             zSql = zLeft;
1024             continue;
1025           }
1026         }
1027         assert( pPreStmt==0 );
1028       }
1029 
1030       /* Bind values to parameters that begin with $ or :
1031       */
1032       nVar = sqlite3_bind_parameter_count(pStmt);
1033       nParm = 0;
1034       if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){
1035         apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0]));
1036       }else{
1037         apParm = aParm;
1038       }
1039       for(i=1; i<=nVar; i++){
1040         const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
1041         if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':') ){
1042           Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
1043           if( pVar ){
1044             int n;
1045             u8 *data;
1046             char *zType = pVar->typePtr ? pVar->typePtr->name : "";
1047             char c = zType[0];
1048             if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
1049               /* Only load a BLOB type if the Tcl variable is a bytearray and
1050               ** has no string representation. */
1051               data = Tcl_GetByteArrayFromObj(pVar, &n);
1052               sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
1053               Tcl_IncrRefCount(pVar);
1054               apParm[nParm++] = pVar;
1055             }else if( (c=='b' && strcmp(zType,"boolean")==0) ||
1056                   (c=='i' && strcmp(zType,"int")==0) ){
1057               Tcl_GetIntFromObj(interp, pVar, &n);
1058               sqlite3_bind_int(pStmt, i, n);
1059             }else if( c=='d' && strcmp(zType,"double")==0 ){
1060               double r;
1061               Tcl_GetDoubleFromObj(interp, pVar, &r);
1062               sqlite3_bind_double(pStmt, i, r);
1063             }else if( c=='w' && strcmp(zType,"wideInt")==0 ){
1064               Tcl_WideInt v;
1065               Tcl_GetWideIntFromObj(interp, pVar, &v);
1066               sqlite3_bind_int64(pStmt, i, v);
1067             }else{
1068               data = Tcl_GetStringFromObj(pVar, &n);
1069               sqlite3_bind_text(pStmt, i, data, n, SQLITE_STATIC);
1070               Tcl_IncrRefCount(pVar);
1071               apParm[nParm++] = pVar;
1072             }
1073           }else{
1074             sqlite3_bind_null( pStmt, i );
1075           }
1076         }
1077       }
1078 
1079       /* Compute column names */
1080       nCol = sqlite3_column_count(pStmt);
1081       if( pScript ){
1082         apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
1083         if( apColName==0 ) break;
1084         for(i=0; i<nCol; i++){
1085           apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i));
1086           Tcl_IncrRefCount(apColName[i]);
1087         }
1088       }
1089 
1090       /* If results are being stored in an array variable, then create
1091       ** the array(*) entry for that array
1092       */
1093       if( pArray ){
1094         Tcl_Obj *pColList = Tcl_NewObj();
1095         Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
1096         Tcl_IncrRefCount(pColList);
1097         for(i=0; i<nCol; i++){
1098           Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
1099         }
1100         Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0);
1101         Tcl_DecrRefCount(pColList);
1102         Tcl_DecrRefCount(pStar);
1103       }
1104 
1105       /* Execute the SQL
1106       */
1107       while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){
1108         for(i=0; i<nCol; i++){
1109           Tcl_Obj *pVal;
1110 
1111           /* Set pVal to contain the i'th column of this row. */
1112           switch( sqlite3_column_type(pStmt, i) ){
1113             case SQLITE_BLOB: {
1114               int bytes = sqlite3_column_bytes(pStmt, i);
1115               pVal = Tcl_NewByteArrayObj(sqlite3_column_blob(pStmt, i), bytes);
1116               break;
1117             }
1118             case SQLITE_INTEGER: {
1119               sqlite_int64 v = sqlite3_column_int64(pStmt, i);
1120               if( v>=-2147483647 && v<=2147483647 ){
1121                 pVal = Tcl_NewIntObj(v);
1122               }else{
1123                 pVal = Tcl_NewWideIntObj(v);
1124               }
1125               break;
1126             }
1127             case SQLITE_FLOAT: {
1128               double r = sqlite3_column_double(pStmt, i);
1129               pVal = Tcl_NewDoubleObj(r);
1130               break;
1131             }
1132             case SQLITE_NULL: {
1133               pVal = dbTextToObj(pDb->zNull);
1134               break;
1135             }
1136             default: {
1137               pVal = dbTextToObj(sqlite3_column_text(pStmt, i));
1138               break;
1139             }
1140           }
1141 
1142           if( pScript ){
1143             if( pArray==0 ){
1144               Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
1145             }else{
1146               Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
1147             }
1148           }else if( choice==DB_ONECOLUMN ){
1149             if( pRet==0 ){
1150               pRet = pVal;
1151               Tcl_IncrRefCount(pRet);
1152             }
1153             rc = TCL_BREAK;
1154           }else{
1155             Tcl_ListObjAppendElement(interp, pRet, pVal);
1156           }
1157         }
1158 
1159         if( pScript ){
1160           rc = Tcl_EvalObjEx(interp, pScript, 0);
1161           if( rc==TCL_CONTINUE ){
1162             rc = TCL_OK;
1163           }
1164         }
1165       }
1166       if( rc==TCL_BREAK ){
1167         rc = TCL_OK;
1168       }
1169 
1170       /* Free the column name objects */
1171       if( pScript ){
1172         for(i=0; i<nCol; i++){
1173           Tcl_DecrRefCount(apColName[i]);
1174         }
1175         Tcl_Free((char*)apColName);
1176       }
1177 
1178       /* Free the bound string and blob parameters */
1179       for(i=0; i<nParm; i++){
1180         Tcl_DecrRefCount(apParm[i]);
1181       }
1182       if( apParm!=aParm ){
1183         Tcl_Free((char*)apParm);
1184       }
1185 
1186       /* Reset the statement.  If the result code is SQLITE_SCHEMA, then
1187       ** flush the statement cache and try the statement again.
1188       */
1189       rc2 = sqlite3_reset(pStmt);
1190       if( SQLITE_SCHEMA==rc2 ){
1191         /* After a schema change, flush the cache and try to run the
1192         ** statement again
1193         */
1194         flushStmtCache( pDb );
1195         sqlite3_finalize(pStmt);
1196         if( pPreStmt ) Tcl_Free((char*)pPreStmt);
1197         continue;
1198       }else if( SQLITE_OK!=rc2 ){
1199         /* If a run-time error occurs, report the error and stop reading
1200         ** the SQL
1201         */
1202         Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
1203         sqlite3_finalize(pStmt);
1204         rc = TCL_ERROR;
1205         if( pPreStmt ) Tcl_Free((char*)pPreStmt);
1206         break;
1207       }else if( pDb->maxStmt<=0 ){
1208         /* If the cache is turned off, deallocated the statement */
1209         if( pPreStmt ) Tcl_Free((char*)pPreStmt);
1210         sqlite3_finalize(pStmt);
1211       }else{
1212         /* Everything worked and the cache is operational.
1213         ** Create a new SqlPreparedStmt structure if we need one.
1214         ** (If we already have one we can just reuse it.)
1215         */
1216         if( pPreStmt==0 ){
1217           len = zLeft - zSql;
1218           pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) + len );
1219           if( pPreStmt==0 ) return TCL_ERROR;
1220           pPreStmt->pStmt = pStmt;
1221           pPreStmt->nSql = len;
1222           memcpy(pPreStmt->zSql, zSql, len);
1223           pPreStmt->zSql[len] = 0;
1224         }
1225 
1226         /* Add the prepared statement to the beginning of the cache list
1227         */
1228         pPreStmt->pNext = pDb->stmtList;
1229         pPreStmt->pPrev = 0;
1230         if( pDb->stmtList ){
1231          pDb->stmtList->pPrev = pPreStmt;
1232         }
1233         pDb->stmtList = pPreStmt;
1234         if( pDb->stmtLast==0 ){
1235           assert( pDb->nStmt==0 );
1236           pDb->stmtLast = pPreStmt;
1237         }else{
1238           assert( pDb->nStmt>0 );
1239         }
1240         pDb->nStmt++;
1241 
1242         /* If we have too many statement in cache, remove the surplus from the
1243         ** end of the cache list.
1244         */
1245         while( pDb->nStmt>pDb->maxStmt ){
1246           sqlite3_finalize(pDb->stmtLast->pStmt);
1247           pDb->stmtLast = pDb->stmtLast->pPrev;
1248           Tcl_Free((char*)pDb->stmtLast->pNext);
1249           pDb->stmtLast->pNext = 0;
1250           pDb->nStmt--;
1251         }
1252       }
1253 
1254       /* Proceed to the next statement */
1255       zSql = zLeft;
1256     }
1257     Tcl_DecrRefCount(objv[2]);
1258 
1259     if( pRet ){
1260       if( rc==TCL_OK ){
1261         Tcl_SetObjResult(interp, pRet);
1262       }
1263       Tcl_DecrRefCount(pRet);
1264     }
1265     break;
1266   }
1267 
1268   /*
1269   **     $db function NAME SCRIPT
1270   **
1271   ** Create a new SQL function called NAME.  Whenever that function is
1272   ** called, invoke SCRIPT to evaluate the function.
1273   */
1274   case DB_FUNCTION: {
1275     SqlFunc *pFunc;
1276     Tcl_Obj *pScript;
1277     char *zName;
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     pScript = objv[3];
1284     pFunc = findSqlFunc(pDb, zName);
1285     if( pFunc==0 ) return TCL_ERROR;
1286     if( pFunc->pScript ){
1287       Tcl_DecrRefCount(pFunc->pScript);
1288     }
1289     pFunc->pScript = pScript;
1290     Tcl_IncrRefCount(pScript);
1291     pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
1292     rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
1293         pFunc, tclSqlFunc, 0, 0);
1294     if( rc!=SQLITE_OK ){
1295       rc = TCL_ERROR;
1296       Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
1297     }else{
1298       /* Must flush any cached statements */
1299       flushStmtCache( pDb );
1300     }
1301     break;
1302   }
1303 
1304   /*
1305   **     $db last_insert_rowid
1306   **
1307   ** Return an integer which is the ROWID for the most recent insert.
1308   */
1309   case DB_LAST_INSERT_ROWID: {
1310     Tcl_Obj *pResult;
1311     int rowid;
1312     if( objc!=2 ){
1313       Tcl_WrongNumArgs(interp, 2, objv, "");
1314       return TCL_ERROR;
1315     }
1316     rowid = sqlite3_last_insert_rowid(pDb->db);
1317     pResult = Tcl_GetObjResult(interp);
1318     Tcl_SetIntObj(pResult, rowid);
1319     break;
1320   }
1321 
1322   /*
1323   ** The DB_ONECOLUMN method is implemented together with DB_EVAL.
1324   */
1325 
1326   /*    $db progress ?N CALLBACK?
1327   **
1328   ** Invoke the given callback every N virtual machine opcodes while executing
1329   ** queries.
1330   */
1331   case DB_PROGRESS: {
1332     if( objc==2 ){
1333       if( pDb->zProgress ){
1334         Tcl_AppendResult(interp, pDb->zProgress, 0);
1335       }
1336     }else if( objc==4 ){
1337       char *zProgress;
1338       int len;
1339       int N;
1340       if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
1341 	return TCL_ERROR;
1342       };
1343       if( pDb->zProgress ){
1344         Tcl_Free(pDb->zProgress);
1345       }
1346       zProgress = Tcl_GetStringFromObj(objv[3], &len);
1347       if( zProgress && len>0 ){
1348         pDb->zProgress = Tcl_Alloc( len + 1 );
1349         strcpy(pDb->zProgress, zProgress);
1350       }else{
1351         pDb->zProgress = 0;
1352       }
1353 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
1354       if( pDb->zProgress ){
1355         pDb->interp = interp;
1356         sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
1357       }else{
1358         sqlite3_progress_handler(pDb->db, 0, 0, 0);
1359       }
1360 #endif
1361     }else{
1362       Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
1363       return TCL_ERROR;
1364     }
1365     break;
1366   }
1367 
1368   /*
1369   **     $db rekey KEY
1370   **
1371   ** Change the encryption key on the currently open database.
1372   */
1373   case DB_REKEY: {
1374     int nKey;
1375     void *pKey;
1376     if( objc!=3 ){
1377       Tcl_WrongNumArgs(interp, 2, objv, "KEY");
1378       return TCL_ERROR;
1379     }
1380     pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
1381 #ifdef SQLITE_HAS_CODEC
1382     rc = sqlite3_rekey(pDb->db, pKey, nKey);
1383     if( rc ){
1384       Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
1385       rc = TCL_ERROR;
1386     }
1387 #endif
1388     break;
1389   }
1390 
1391   /*
1392   **     $db timeout MILLESECONDS
1393   **
1394   ** Delay for the number of milliseconds specified when a file is locked.
1395   */
1396   case DB_TIMEOUT: {
1397     int ms;
1398     if( objc!=3 ){
1399       Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
1400       return TCL_ERROR;
1401     }
1402     if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
1403     sqlite3_busy_timeout(pDb->db, ms);
1404     break;
1405   }
1406 
1407   /*
1408   **     $db nullvalue ?STRING?
1409   **
1410   ** Change text used when a NULL comes back from the database. If ?STRING?
1411   ** is not present, then the current string used for NULL is returned.
1412   ** If STRING is present, then STRING is returned.
1413   **
1414   */
1415   case DB_NULLVALUE: {
1416     if( objc!=2 && objc!=3 ){
1417       Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
1418       return TCL_ERROR;
1419     }
1420     if( objc==3 ){
1421       int len;
1422       char *zNull = Tcl_GetStringFromObj(objv[2], &len);
1423       if( pDb->zNull ){
1424         Tcl_Free(pDb->zNull);
1425       }
1426       if( zNull && len>0 ){
1427         pDb->zNull = Tcl_Alloc( len + 1 );
1428         strncpy(pDb->zNull, zNull, len);
1429         pDb->zNull[len] = '\0';
1430       }else{
1431         pDb->zNull = 0;
1432       }
1433     }
1434     Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
1435     break;
1436   }
1437 
1438   /*
1439   **     $db total_changes
1440   **
1441   ** Return the number of rows that were modified, inserted, or deleted
1442   ** since the database handle was created.
1443   */
1444   case DB_TOTAL_CHANGES: {
1445     Tcl_Obj *pResult;
1446     if( objc!=2 ){
1447       Tcl_WrongNumArgs(interp, 2, objv, "");
1448       return TCL_ERROR;
1449     }
1450     pResult = Tcl_GetObjResult(interp);
1451     Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
1452     break;
1453   }
1454 
1455   /*    $db trace ?CALLBACK?
1456   **
1457   ** Make arrangements to invoke the CALLBACK routine for each SQL statement
1458   ** that is executed.  The text of the SQL is appended to CALLBACK before
1459   ** it is executed.
1460   */
1461   case DB_TRACE: {
1462     if( objc>3 ){
1463       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1464       return TCL_ERROR;
1465     }else if( objc==2 ){
1466       if( pDb->zTrace ){
1467         Tcl_AppendResult(interp, pDb->zTrace, 0);
1468       }
1469     }else{
1470       char *zTrace;
1471       int len;
1472       if( pDb->zTrace ){
1473         Tcl_Free(pDb->zTrace);
1474       }
1475       zTrace = Tcl_GetStringFromObj(objv[2], &len);
1476       if( zTrace && len>0 ){
1477         pDb->zTrace = Tcl_Alloc( len + 1 );
1478         strcpy(pDb->zTrace, zTrace);
1479       }else{
1480         pDb->zTrace = 0;
1481       }
1482       if( pDb->zTrace ){
1483         pDb->interp = interp;
1484         sqlite3_trace(pDb->db, DbTraceHandler, pDb);
1485       }else{
1486         sqlite3_trace(pDb->db, 0, 0);
1487       }
1488     }
1489     break;
1490   }
1491 
1492   /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
1493   **
1494   ** Start a new transaction (if we are not already in the midst of a
1495   ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
1496   ** completes, either commit the transaction or roll it back if SCRIPT
1497   ** throws an exception.  Or if no new transation was started, do nothing.
1498   ** pass the exception on up the stack.
1499   **
1500   ** This command was inspired by Dave Thomas's talk on Ruby at the
1501   ** 2005 O'Reilly Open Source Convention (OSCON).
1502   */
1503   case DB_TRANSACTION: {
1504     int inTrans;
1505     Tcl_Obj *pScript;
1506     const char *zBegin = "BEGIN";
1507     if( objc!=3 && objc!=4 ){
1508       Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
1509       return TCL_ERROR;
1510     }
1511     if( objc==3 ){
1512       pScript = objv[2];
1513     } else {
1514       static const char *TTYPE_strs[] = {
1515         "deferred",   "exclusive",  "immediate"
1516       };
1517       enum TTYPE_enum {
1518         TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
1519       };
1520       int ttype;
1521       if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
1522                               0, &ttype) ){
1523         return TCL_ERROR;
1524       }
1525       switch( (enum TTYPE_enum)ttype ){
1526         case TTYPE_DEFERRED:    /* no-op */;                 break;
1527         case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
1528         case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
1529       }
1530       pScript = objv[3];
1531     }
1532     inTrans = !sqlite3_get_autocommit(pDb->db);
1533     if( !inTrans ){
1534       sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
1535     }
1536     rc = Tcl_EvalObjEx(interp, pScript, 0);
1537     if( !inTrans ){
1538       const char *zEnd;
1539       if( rc==TCL_ERROR ){
1540         zEnd = "ROLLBACK";
1541       } else {
1542         zEnd = "COMMIT";
1543       }
1544       sqlite3_exec(pDb->db, zEnd, 0, 0, 0);
1545     }
1546     break;
1547   }
1548 
1549   /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
1550   **
1551   ** Copy data into table from filename, optionally using SEPARATOR
1552   ** as column separators.  If a column contains a null string, or the
1553   ** value of NULLINDICATOR, a NULL is inserted for the column.
1554   ** conflict-algorithm is one of the sqlite conflict algorithms:
1555   **    rollback, abort, fail, ignore, replace
1556   ** On success, return the number of lines processed, not necessarily same
1557   ** as 'db changes' due to conflict-algorithm selected.
1558   **
1559   ** This code is basically an implementation/enhancement of
1560   ** the sqlite3 shell.c ".import" command.
1561   **
1562   ** This command usage is equivalent to the sqlite2.x COPY statement,
1563   ** which imports file data into a table using the PostgreSQL COPY file format:
1564   **   $db copy $conflit_algo $table_name $filename \t \\N
1565   */
1566   case DB_COPY: {
1567     char *zTable;               /* Insert data into this table */
1568     char *zFile;                /* The file from which to extract data */
1569     char *zConflict;            /* The conflict algorithm to use */
1570     sqlite3_stmt *pStmt;        /* A statement */
1571     int rc;                     /* Result code */
1572     int nCol;                   /* Number of columns in the table */
1573     int nByte;                  /* Number of bytes in an SQL string */
1574     int i, j;                   /* Loop counters */
1575     int nSep;                   /* Number of bytes in zSep[] */
1576     int nNull;                  /* Number of bytes in zNull[] */
1577     char *zSql;                 /* An SQL statement */
1578     char *zLine;                /* A single line of input from the file */
1579     char **azCol;               /* zLine[] broken up into columns */
1580     char *zCommit;              /* How to commit changes */
1581     FILE *in;                   /* The input file */
1582     int lineno = 0;             /* Line number of input file */
1583     char zLineNum[80];          /* Line number print buffer */
1584     Tcl_Obj *pResult;           /* interp result */
1585 
1586     char *zSep;
1587     char *zNull;
1588     if( objc<5 || objc>7 ){
1589       Tcl_WrongNumArgs(interp, 2, objv,
1590          "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
1591       return TCL_ERROR;
1592     }
1593     if( objc>=6 ){
1594       zSep = Tcl_GetStringFromObj(objv[5], 0);
1595     }else{
1596       zSep = "\t";
1597     }
1598     if( objc>=7 ){
1599       zNull = Tcl_GetStringFromObj(objv[6], 0);
1600     }else{
1601       zNull = "";
1602     }
1603     zConflict = Tcl_GetStringFromObj(objv[2], 0);
1604     zTable = Tcl_GetStringFromObj(objv[3], 0);
1605     zFile = Tcl_GetStringFromObj(objv[4], 0);
1606     nSep = strlen(zSep);
1607     nNull = strlen(zNull);
1608     if( nSep==0 ){
1609       Tcl_AppendResult(interp, "Error: non-null separator required for copy", 0);
1610       return TCL_ERROR;
1611     }
1612     if(sqlite3StrICmp(zConflict, "rollback") != 0 &&
1613        sqlite3StrICmp(zConflict, "abort"   ) != 0 &&
1614        sqlite3StrICmp(zConflict, "fail"    ) != 0 &&
1615        sqlite3StrICmp(zConflict, "ignore"  ) != 0 &&
1616        sqlite3StrICmp(zConflict, "replace" ) != 0 ) {
1617       Tcl_AppendResult(interp, "Error: \"", zConflict,
1618             "\", conflict-algorithm must be one of: rollback, "
1619             "abort, fail, ignore, or replace", 0);
1620       return TCL_ERROR;
1621     }
1622     zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
1623     if( zSql==0 ){
1624       Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0);
1625       return TCL_ERROR;
1626     }
1627     nByte = strlen(zSql);
1628     rc = sqlite3_prepare(pDb->db, zSql, 0, &pStmt, 0);
1629     sqlite3_free(zSql);
1630     if( rc ){
1631       Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
1632       nCol = 0;
1633     }else{
1634       nCol = sqlite3_column_count(pStmt);
1635     }
1636     sqlite3_finalize(pStmt);
1637     if( nCol==0 ) {
1638       return TCL_ERROR;
1639     }
1640     zSql = malloc( nByte + 50 + nCol*2 );
1641     if( zSql==0 ) {
1642       Tcl_AppendResult(interp, "Error: can't malloc()", 0);
1643       return TCL_ERROR;
1644     }
1645     sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
1646          zConflict, zTable);
1647     j = strlen(zSql);
1648     for(i=1; i<nCol; i++){
1649       zSql[j++] = ',';
1650       zSql[j++] = '?';
1651     }
1652     zSql[j++] = ')';
1653     zSql[j] = 0;
1654     rc = sqlite3_prepare(pDb->db, zSql, 0, &pStmt, 0);
1655     free(zSql);
1656     if( rc ){
1657       Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
1658       sqlite3_finalize(pStmt);
1659       return TCL_ERROR;
1660     }
1661     in = fopen(zFile, "rb");
1662     if( in==0 ){
1663       Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL);
1664       sqlite3_finalize(pStmt);
1665       return TCL_ERROR;
1666     }
1667     azCol = malloc( sizeof(azCol[0])*(nCol+1) );
1668     if( azCol==0 ) {
1669       Tcl_AppendResult(interp, "Error: can't malloc()", 0);
1670       return TCL_ERROR;
1671     }
1672     sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
1673     zCommit = "COMMIT";
1674     while( (zLine = local_getline(0, in))!=0 ){
1675       char *z;
1676       i = 0;
1677       lineno++;
1678       azCol[0] = zLine;
1679       for(i=0, z=zLine; *z; z++){
1680         if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
1681           *z = 0;
1682           i++;
1683           if( i<nCol ){
1684             azCol[i] = &z[nSep];
1685             z += nSep-1;
1686           }
1687         }
1688       }
1689       if( i+1!=nCol ){
1690         char *zErr;
1691         zErr = malloc(200 + strlen(zFile));
1692         sprintf(zErr,"Error: %s line %d: expected %d columns of data but found %d",
1693            zFile, lineno, nCol, i+1);
1694         Tcl_AppendResult(interp, zErr, 0);
1695         free(zErr);
1696         zCommit = "ROLLBACK";
1697         break;
1698       }
1699       for(i=0; i<nCol; i++){
1700         /* check for null data, if so, bind as null */
1701         if ((nNull>0 && strcmp(azCol[i], zNull)==0) || strlen(azCol[i])==0) {
1702           sqlite3_bind_null(pStmt, i+1);
1703         }else{
1704           sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
1705         }
1706       }
1707       sqlite3_step(pStmt);
1708       rc = sqlite3_reset(pStmt);
1709       free(zLine);
1710       if( rc!=SQLITE_OK ){
1711         Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0);
1712         zCommit = "ROLLBACK";
1713         break;
1714       }
1715     }
1716     free(azCol);
1717     fclose(in);
1718     sqlite3_finalize(pStmt);
1719     sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
1720 
1721     if( zCommit[0] == 'C' ){
1722       /* success, set result as number of lines processed */
1723       pResult = Tcl_GetObjResult(interp);
1724       Tcl_SetIntObj(pResult, lineno);
1725       rc = TCL_OK;
1726     }else{
1727       /* failure, append lineno where failed */
1728       sprintf(zLineNum,"%d",lineno);
1729       Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0);
1730       rc = TCL_ERROR;
1731     }
1732     break;
1733   }
1734 
1735   /*    $db version
1736   **
1737   ** Return the version string for this database.
1738   */
1739   case DB_VERSION: {
1740     Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
1741     break;
1742   }
1743 
1744 
1745   } /* End of the SWITCH statement */
1746   return rc;
1747 }
1748 
1749 /*
1750 **   sqlite3 DBNAME FILENAME ?MODE? ?-key KEY?
1751 **
1752 ** This is the main Tcl command.  When the "sqlite" Tcl command is
1753 ** invoked, this routine runs to process that command.
1754 **
1755 ** The first argument, DBNAME, is an arbitrary name for a new
1756 ** database connection.  This command creates a new command named
1757 ** DBNAME that is used to control that connection.  The database
1758 ** connection is deleted when the DBNAME command is deleted.
1759 **
1760 ** The second argument is the name of the directory that contains
1761 ** the sqlite database that is to be accessed.
1762 **
1763 ** For testing purposes, we also support the following:
1764 **
1765 **  sqlite3 -encoding
1766 **
1767 **       Return the encoding used by LIKE and GLOB operators.  Choices
1768 **       are UTF-8 and iso8859.
1769 **
1770 **  sqlite3 -version
1771 **
1772 **       Return the version number of the SQLite library.
1773 **
1774 **  sqlite3 -tcl-uses-utf
1775 **
1776 **       Return "1" if compiled with a Tcl uses UTF-8.  Return "0" if
1777 **       not.  Used by tests to make sure the library was compiled
1778 **       correctly.
1779 */
1780 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
1781   SqliteDb *p;
1782   void *pKey = 0;
1783   int nKey = 0;
1784   const char *zArg;
1785   char *zErrMsg;
1786   const char *zFile;
1787   char zBuf[80];
1788   if( objc==2 ){
1789     zArg = Tcl_GetStringFromObj(objv[1], 0);
1790     if( strcmp(zArg,"-version")==0 ){
1791       Tcl_AppendResult(interp,sqlite3_version,0);
1792       return TCL_OK;
1793     }
1794     if( strcmp(zArg,"-has-codec")==0 ){
1795 #ifdef SQLITE_HAS_CODEC
1796       Tcl_AppendResult(interp,"1",0);
1797 #else
1798       Tcl_AppendResult(interp,"0",0);
1799 #endif
1800       return TCL_OK;
1801     }
1802     if( strcmp(zArg,"-tcl-uses-utf")==0 ){
1803 #ifdef TCL_UTF_MAX
1804       Tcl_AppendResult(interp,"1",0);
1805 #else
1806       Tcl_AppendResult(interp,"0",0);
1807 #endif
1808       return TCL_OK;
1809     }
1810   }
1811   if( objc==5 || objc==6 ){
1812     zArg = Tcl_GetStringFromObj(objv[objc-2], 0);
1813     if( strcmp(zArg,"-key")==0 ){
1814       pKey = Tcl_GetByteArrayFromObj(objv[objc-1], &nKey);
1815       objc -= 2;
1816     }
1817   }
1818   if( objc!=3 && objc!=4 ){
1819     Tcl_WrongNumArgs(interp, 1, objv,
1820 #ifdef SQLITE_HAS_CODEC
1821       "HANDLE FILENAME ?-key CODEC-KEY?"
1822 #else
1823       "HANDLE FILENAME ?MODE?"
1824 #endif
1825     );
1826     return TCL_ERROR;
1827   }
1828   zErrMsg = 0;
1829   p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
1830   if( p==0 ){
1831     Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
1832     return TCL_ERROR;
1833   }
1834   memset(p, 0, sizeof(*p));
1835   zFile = Tcl_GetStringFromObj(objv[2], 0);
1836   sqlite3_open(zFile, &p->db);
1837   if( SQLITE_OK!=sqlite3_errcode(p->db) ){
1838     zErrMsg = strdup(sqlite3_errmsg(p->db));
1839     sqlite3_close(p->db);
1840     p->db = 0;
1841   }
1842 #ifdef SQLITE_HAS_CODEC
1843   sqlite3_key(p->db, pKey, nKey);
1844 #endif
1845   if( p->db==0 ){
1846     Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
1847     Tcl_Free((char*)p);
1848     free(zErrMsg);
1849     return TCL_ERROR;
1850   }
1851   p->maxStmt = NUM_PREPARED_STMTS;
1852   zArg = Tcl_GetStringFromObj(objv[1], 0);
1853   Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
1854 
1855   /* The return value is the value of the sqlite* pointer
1856   */
1857   sprintf(zBuf, "%p", p->db);
1858   if( strncmp(zBuf,"0x",2) ){
1859     sprintf(zBuf, "0x%p", p->db);
1860   }
1861   Tcl_AppendResult(interp, zBuf, 0);
1862 
1863   /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
1864   ** SQL function.
1865   */
1866 #ifdef SQLITE_TEST
1867   {
1868     extern void Md5_Register(sqlite3*);
1869 #ifdef SQLITE_MEMDEBUG
1870     int mallocfail = sqlite3_iMallocFail;
1871     sqlite3_iMallocFail = 0;
1872 #endif
1873     Md5_Register(p->db);
1874 #ifdef SQLITE_MEMDEBUG
1875     sqlite3_iMallocFail = mallocfail;
1876 #endif
1877    }
1878 #endif
1879   p->interp = interp;
1880   return TCL_OK;
1881 }
1882 
1883 /*
1884 ** Provide a dummy Tcl_InitStubs if we are using this as a static
1885 ** library.
1886 */
1887 #ifndef USE_TCL_STUBS
1888 # undef  Tcl_InitStubs
1889 # define Tcl_InitStubs(a,b,c)
1890 #endif
1891 
1892 /*
1893 ** Initialize this module.
1894 **
1895 ** This Tcl module contains only a single new Tcl command named "sqlite".
1896 ** (Hence there is no namespace.  There is no point in using a namespace
1897 ** if the extension only supplies one new name!)  The "sqlite" command is
1898 ** used to open a new SQLite database.  See the DbMain() routine above
1899 ** for additional information.
1900 */
1901 int Sqlite3_Init(Tcl_Interp *interp){
1902   Tcl_InitStubs(interp, "8.4", 0);
1903   Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
1904   Tcl_PkgProvide(interp, "sqlite3", "3.0");
1905   Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
1906   Tcl_PkgProvide(interp, "sqlite", "3.0");
1907   return TCL_OK;
1908 }
1909 int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
1910 int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
1911 int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
1912 
1913 #ifndef SQLITE_3_SUFFIX_ONLY
1914 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
1915 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
1916 int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
1917 int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
1918 #endif
1919 
1920 #ifdef TCLSH
1921 /*****************************************************************************
1922 ** The code that follows is used to build standalone TCL interpreters
1923 */
1924 
1925 /*
1926 ** If the macro TCLSH is one, then put in code this for the
1927 ** "main" routine that will initialize Tcl and take input from
1928 ** standard input.
1929 */
1930 #if TCLSH==1
1931 static char zMainloop[] =
1932   "set line {}\n"
1933   "while {![eof stdin]} {\n"
1934     "if {$line!=\"\"} {\n"
1935       "puts -nonewline \"> \"\n"
1936     "} else {\n"
1937       "puts -nonewline \"% \"\n"
1938     "}\n"
1939     "flush stdout\n"
1940     "append line [gets stdin]\n"
1941     "if {[info complete $line]} {\n"
1942       "if {[catch {uplevel #0 $line} result]} {\n"
1943         "puts stderr \"Error: $result\"\n"
1944       "} elseif {$result!=\"\"} {\n"
1945         "puts $result\n"
1946       "}\n"
1947       "set line {}\n"
1948     "} else {\n"
1949       "append line \\n\n"
1950     "}\n"
1951   "}\n"
1952 ;
1953 #endif
1954 
1955 /*
1956 ** If the macro TCLSH is two, then get the main loop code out of
1957 ** the separate file "spaceanal_tcl.h".
1958 */
1959 #if TCLSH==2
1960 static char zMainloop[] =
1961 #include "spaceanal_tcl.h"
1962 ;
1963 #endif
1964 
1965 #define TCLSH_MAIN main   /* Needed to fake out mktclapp */
1966 int TCLSH_MAIN(int argc, char **argv){
1967   Tcl_Interp *interp;
1968   Tcl_FindExecutable(argv[0]);
1969   interp = Tcl_CreateInterp();
1970   Sqlite3_Init(interp);
1971 #ifdef SQLITE_TEST
1972   {
1973     extern int Sqlitetest1_Init(Tcl_Interp*);
1974     extern int Sqlitetest2_Init(Tcl_Interp*);
1975     extern int Sqlitetest3_Init(Tcl_Interp*);
1976     extern int Sqlitetest4_Init(Tcl_Interp*);
1977     extern int Sqlitetest5_Init(Tcl_Interp*);
1978     extern int Md5_Init(Tcl_Interp*);
1979     extern int Sqlitetestsse_Init(Tcl_Interp*);
1980 
1981     Sqlitetest1_Init(interp);
1982     Sqlitetest2_Init(interp);
1983     Sqlitetest3_Init(interp);
1984     Sqlitetest4_Init(interp);
1985     Sqlitetest5_Init(interp);
1986     Md5_Init(interp);
1987 #ifdef SQLITE_SSE
1988     Sqlitetestsse_Init(interp);
1989 #endif
1990   }
1991 #endif
1992   if( argc>=2 || TCLSH==2 ){
1993     int i;
1994     Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
1995     Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
1996     for(i=3-TCLSH; i<argc; i++){
1997       Tcl_SetVar(interp, "argv", argv[i],
1998           TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
1999     }
2000     if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
2001       const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
2002       if( zInfo==0 ) zInfo = interp->result;
2003       fprintf(stderr,"%s: %s\n", *argv, zInfo);
2004       return 1;
2005     }
2006   }
2007   if( argc<=1 || TCLSH==2 ){
2008     Tcl_GlobalEval(interp, zMainloop);
2009   }
2010   return 0;
2011 }
2012 #endif /* TCLSH */
2013 
2014 #endif /* !defined(NO_TCL) */
2015