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